База Данных, pascal Опции

[Анна]

Создать компонентный файл реализующий базу данных "записная книжка", которая состоит из след. полей: имя, фамилия, отчество, дата рождения, город, улица, дом, квартира, телефон.
Программа должна обеспечивать вввод записи с клавиатуры, а также сортировки записи по полю (отсортированную базу сохранить в другом файле)
Сортировка по фамилии.

Вот что получилось:

Program Lab11;
uses	crt;
type
	base = record
		name, family, otchestvo, DofBr, city, street: string;
		dom, kvartira, telefon: integer;
	end;
var
	mas:array[1..20] of string;
	temp: string;
	mass: array[1..20] of base;
	filename: string;
	f: file of base;
	rf: file of base;
	i, j, k, g:integer;
	key: char;
	proverka:boolean;
begin
clrscr;
write('Введите имя исх файла: ');
readln(filename);
assign(f, filename);
write('Введите имя рез файла: ');
readln(filename);
assign(rf, filename);
rewrite(f);
g := 0;
repeat
g := g + 1;
write('Имя:');
readln(mass[g].name);
write('Фамилия:');
readln(mass[g].family);
write('Отчество:');
readln(mass[g].otchestvo);
write('Дата рождения:');
readln(mass[g].DofBr);
write('Город:');
readln(mass[g].city);
write('Улица:');
readln(mass[g].street);
write('Дом:');
readln(mass[g].dom);
write('Квартира:');
readln(mass[g].kvartira);
write('Телефон:');
readln(mass[g].telefon);
write(f, mass[g]);
writeln('Выход ESC');
writeln('Для продолжения нажмите любую клавишу');
key:=readkey;
if key=#27 then break;
until false;
close(f);

reset(f);
i:=0;
while not eof(f) do
begin
i:=i+1;
read(f, mass[i]);
mas[g]:=mass[i].family;
end;


{сортировка ...}


reset(rf);
g:=0;
clrscr;
while not eof(rf) do
begin
g:=g+1;
read(rf, mass[g]);
writeln(g,' элемент списка: ');
writeln('Имя:' ,mass[g].name);
writeln('Фамилия: ',mass[g].family);
writeln('Отчество: ',mass[g].otchestvo);
writeln('Дата рождения: ', mass[g].DofBr);
writeln('Город: ',mass[g].city);
writeln('Улица: ',mass[g].street);
writeln('Дом: ',mass[g].dom);
writeln('Квартира: ',mass[g].kvartira);
writeln('Телефон: ',mass[g].telefon);
writeln('Нажмите любую кнопку!');
readln;

end;
close(f);
end.

Не получается отсортировать, да и мне кажется, что моя программа слишком громоздкая .

[Анна]

Небольшие изменения:
Немного запуталась в программе...

Код

Program Lab11;
uses    crt;

const
  max = 30;
type
  base = record
    name, family, otchestvo, data, city, street: string[50];
    dom, kv, tel: integer;
  end;
  List = array[1 .. max] of base;


procedure ReadInfo(var r: base);
begin

    write('Имя:');           readln(r.name);
    write('Фамилия:');       readln(r.family);
    write('Отчество:');      readln(r.otchestvo);
    write('Дата рождения:'); readln(r.data);
    write('Город:');         readln(r.city);
    write('Улица:');         readln(r.street);
    write('Дом:');           readln(r.dom);
    write('Квартира:');      readln(r.kv);
    write('Телефон:');       readln(r.tel);
end;

procedure WriteInfo(r: base);
begin
    writeln('Имя: ' ,           r.name);
    writeln('Фамилия: ',       r.family);
    writeln('Отчество: ',      r.otchestvo);
    writeln('Дата рождения: ', r.data);
    writeln('Город: ',         r.city);
    writeln('Улица: ',         r.street);
    writeln('Дом: ',           r.dom);
    writeln('Квартира: ',      r.kv);
    writeln('Телефон: ',       r.tel);
end;



{Если длина строки 1 больше длины 2 строки, то сдвигаем 1 строку вперёд на 1 ? и т.п.}
function Compare (T1, T2: base): integer;
begin
    if length (T1.family) > length (T2.family) then Compare := 1
    else if length (T1.family) = length (T2.family) then Compare := 0
    else Compare := -1
end;


{А дальше я совсем запуталась ...}
procedure QuickSort (var A: List; Lo, Hi: Integer);
var
i,j: integer;
x, y: base;

procedure Sort (l, r: Integer);
begin
  repeat
    x := A[(l+r) shr 1];
    i := l; j := r;
    repeat
      while Compare( A[i], x ) < 0 do inc(i);
      while Compare( A[j], x ) > 0 do dec(j);
      if i <= j then begin

        y := A[i]; A[i] := A[j]; A[j] := y;
        inc(i); dec(j);

      end;
    until i > j;

    if l < j then Sort (l, j);
    l := i;
  until l >= r;
end;

begin
  Sort (Lo,Hi);
end;


var
  mass: List;
  filename: string;
  f, rf: file of base;
  i, j, k, g:integer;
  key: char;
  proverka:boolean;

begin
  clrscr;
  write('Введите имя исх файла: '); readln(filename);
  assign(f, filename); rewrite(f);
  write('Введите имя рез файла: '); readln(filename);
  assign(rf, filename); rewrite(rf);

  g := 0;
  repeat

    inc(g);
    ReadInfo(mass[g]);
    write(f, mass[g]);

    writeln('Выход ESC');
    writeln('Для продолжения нажмите любую клавишу');
    writeln;
    key := readkey;

  until key = #27;

  reset(f);
  i := 0;
  while not eof(f) do begin
    inc(i);
    read(f, mass[i]);
  end;


  {сортировка ...}
  QuickSort(mass, 1, i);


{  clrscr;}
writeln('Отcортированные данные: ');
  for g := 1 to i do begin

    writeln;
    WriteInfo(mass[g]);
    write(rf, mass[g]);

  end;
  writeln;
  writeln('Нажмите любую кнопку!');
  readln;

  close(rf);
  close(f);
end.

Сообщение отредактировано: Анна - 11.12.2005 15:45