Program Lab11;
uses	crt;

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


procedure ReadInfo(var r: base);
begin
  with r do begin
    write('Имя:');           readln(name);
    write('Фамилия:');       readln(family);
    write('Отчество:');      readln(otchestvo);
    write('Дата рождения:'); readln(DofBr);
    write('Город:');         readln(city);
    write('Улица:');         readln(street);
    write('Дом:');           readln(dom);
    write('Квартира:');      readln(kvartira);
    write('Телефон:');       readln(telefon);
  end;
end;

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

function Compare (T1, T2: base): integer;
begin
    if T1.family > T2.family then Compare := 1
    else if T1.family = 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(f);

  g := 0;
  repeat

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

    writeln('Выход ESC');
    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;
  for g := 1 to i do begin

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

  end;

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

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