uses
  crt;
const
  nm = 100;

type
  oneinfo = record
    name: string[20];
    nomerd: real;
    nomerkv:integer;
    floor:integer;//этаж
  end;
  tkey = (kname, knomerd, knomerkv, kfloor);
  base = file of oneinfo;

var
  b: base; // массив, фильтрованный по названию улицы
  a: base;
  y, m, k, n: integer;
  nb: integer; // число записей в массиве b
  key: tkey;
  ssmax: oneinfo ;
  StreetName: string[20];

procedure enter(var n: integer; var f: base);
//Процедура ввода
var
  i, nomerd, nomerkv: integer;
  name: string;
  rec: oneinfo;

begin
  seek(f, filesize(f)); // GoTop()
  writeln('Ввод базы данных');
  writeln('№', 1);
  write('Название улицы ');
  readln(rec.name);
  while (rec.name <> '*') do
    begin
      write('номер дома ');
      readln(rec.nomerd);

      write('этаж ');
      readln(rec.floor);

      write('номер квартиры ');
      readln(rec.nomerkv);
      writeln;
      write(f, rec);

      writeln('Название улицы ');
      readln(rec.name);
    end;
  writeln('Ввод закончен, мест больше нет');
  readln;
end;

procedure print(const z: oneinfo);
var
  i: integer;
begin
  write(z.name);
  for i := length(z.name) + 1 to 20 do
    write(' ');
  with z do
    writeln('Название - ', z.name, ';', 'номер дома - ', z.nomerd, ';','Этаж - ',
      z.floor, ';', 'номер квартиры - ', z.nomerkv);
end;

procedure print1(var f: base);
//Процедура вывода всех записей
var
  i: integer;
  rec: oneinfo;
begin
  seek(a,0); // GoTop()
  while not eof(f) do
    begin
      read(f, rec);
      print(rec);
    end;
end;

procedure samax(var f: base; var k: integer; var smax: oneinfo);
//процедура, определяет запись с наибольшим номером квартиры
var
  i: integer;
  rec: oneinfo;
begin
  smax.nomerkv := -MaxInt-1;
  seek(f,0); // GoTop();
  while not eof(f) do
    begin
      read(f,rec);
      if rec.nomerkv > smax.nomerkv then
        smax := rec;
    end;
end; { samax }

procedure StreetFilter(
  var a: base;
  var b: base;
  const StreetName: string[20]);
var
  i: integer;
  rec: oneinfo;
begin
  seek(a,0); // a.GoTop();
  while not eof(a) do
    begin
      read(a,rec);
      if rec.name = StreetName then
        write(b,rec);
    end;
end; { StreetFilter }

function firstfloor(var f: base): integer;
// функцию, определяющую количество жителей первого этажа
/// Функция FirstFloor отвечает на вопрос: "Сколько?"
/// В ответ она должна возвращать результат
/// Печатать что-то типа "нет жильцов" - прерогатива той процедуры или
/// главной программы, которой это действие поручена
/// На мой взгляд, FirstFloor не должна уметь печатать
var
  k: integer;
  rec: oneinfo;
begin
  k := 0;
  seek(f,0); // GoTop()
  while not eof(f) do
    begin
      read(f,rec);
      if rec.floor =1 then
        inc(k);
    end;
  FirstFloor:=k;
end; { FirstFloor }

(*
procedure sort(var a: base; n: integer; key: tkey);
//Процедура сортироки массива записей по каждому полю
var
  i, j: integer;
  t: boolean;
  x: oneinfo;
begin
  for i := n downto 2 do
    for j := 1 to i - 1 do
      begin
        case key of
          kname   : t := a[j].name > a[j + 1].name;
          knomerd : t := a[j].nomerd > a[j + 1].nomerd;
          knomerkv: t := a[j].nomerkv > a[j + 1].nomerkv;
          kfloor  : t:=a[j].floor>a[j+1].floor;
        end;
        if t then
           begin
             x := a[j];
             a[j] := a[j + 1];
             a[j + 1] := x;
           end;
      end;
end; // sort
*)

procedure sort(var f: base; key: tkey);
//// procedure sort(fName: TFileName; SortExpr: TFunc); ////
var
//  f: TTable;
  i,j,n : integer;
//  curr: integer;
  rec1, rec2: oneinfo;
  t: boolean;
begin
//  open(fname, f);
  n:= filesize(f);
  seek(f,0);
  for i:= 0 to n-2 do
    for j:= n-1 downto i+1 do begin
      seek(f,j-1);
      read(f,rec1);
      read(f,rec2);
      
        case key of
          kname   : t := rec1.name > rec2.name;
          knomerd : t := rec1.nomerd > rec2.nomerd;
          knomerkv: t := rec1.nomerkv > rec2.nomerkv;
          kfloor  : t := rec1.floor > rec2.floor;
        end;

      if t then begin
////****      if SortExpr(rec2,rec1) then begin ****////
        seek(f,j-1);
        write(f,rec2);
        write(f,rec1);
      end;
    end;
//  close(f);
end; { sort }

begin //основная программа
  Clrscr;
  assign(a, 'data.dat');
  assign(b, 'filtered.dat');

  if FileExists('data.dat') then
    reset(a)
  else
    rewrite(a);
    
  rewrite(b);

  enter(n, a);
  writeln('Информация об адресах:');
  print1(a);
///
  write('Наша улица ');
  readln(StreetName);
  StreetFilter(a, b, StreetName);
(****************)
  writeln;
  writeln('По улице ', StreetName);
  print1(b);
(****************)

///
  writeln;
  writeln('Наибольший номер квартиры');
  writeln;
  samax(a, k, ssmax);
  print(ssmax);
  writeln('----------------------------------------------------------');
  writeln;
  writeln('Cортировка массива записей по каждому полю записей');
  writeln;
  for key := kname to kfloor do
    begin
      sort(a, key);
      write('Сортировка по - ');
      case key of
        kname   : writeln('kname');
        knomerd : writeln('knomerd');
        knomerkv: writeln('knomerkv');
        kfloor  : writeln('kfloor');
      end; { case }
      print1(a);
    end;
  writeln;
  writeln('Количество жителей первого этажа = ', firstfloor(a));
  close(a);
  close(b);
end.

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

const ARRAY_SIZE = 100;
type
  Books = record
    NameBook: string[20];
    PageCount: integer;
    YearEdition: integer;
  end;
var 
  PersonFile: file of Books;
  NewFile: file of Books;
  NewFile1: file of Books;
  Book: Books;
  a: integer;
procedure Fill;
var
  i: integer;
  BookCount: integer;
begin
  write('Введите кол-во книг: ');
  readln(BookCount);    
  assign(PersonFile, 'PersonFile.txt');
  Rewrite(PersonFile);
  for i := 1 to BookCount do
  begin
    with Book do
    begin
      write('Введите имя книги: ');
      readln(NameBook);
      write('Введите кол-во страниц: ');
      readln(PageCount);
      write('Введите дату выпуска: ');
      readln(YearEdition);
    end;
    write(PersonFile, Book);
  end;    
  close(PersonFile);
  writeln;
end;
procedure Print;
var
  i: integer;
  book: books;
begin  
  write('Введите номер книги: ');
  readln(i);
  assign(PersonFile, 'PersonFile.txt');
  reset(PersonFile);
  seek(PersonFile, i-1);
  read(PersonFile, book);
  with Book do
  begin
    writeln('Имя книги: ',NameBook);
    writeln('Кол-во страниц: ',PageCount);
    writeln('Дата выпуска: ',YearEdition);
    writeln;
  end;
  close(PersonFile);
end;
procedure FullPrint;
var
  i: integer;
  Book: books;
begin
  assign(PersonFile, 'PersonFile.txt');
  reset(PersonFile);
  for i := FileSize(PersonFile)-1 downto 0 do
  begin
    seek(PersonFile, i);
    read(PersonFile, Book);
    with Book do
    begin
      writeln('Имя книги: ',NameBook);
      writeln('Кол-во страниц: ',PageCount);
      writeln('Дата выпуска: ',YearEdition);
    end;
  end;
  close(PersonFile);
  writeln;
end;
procedure MaxPage;
var
  i: integer;
  Book: books;
  BookMaxPage: books;
  MaxPage: integer;
begin
  i := 0;
  MaxPage := 0;
  assign(PersonFile, 'PersonFile.txt');
  reset(PersonFile);
  for i := FileSize(PersonFile)-1 downto 0 do
  begin
    seek(PersonFile, i);
    read(PersonFile, Book);
    if Book.PageCount > MaxPage then
    begin
      with book do
      begin
        BookMaxPage.NameBook := NameBook;
        BookMaxPage.PageCount := PageCount;
        BookMaxPage.YearEdition := YearEdition;
      end;
      MaxPage := Book.PageCount;
    end;
  end;
  with BookMaxPage do
  begin
    writeln('Книга с максимальным кол-вом страниц: ');
    writeln('Имя книги: ', NameBook);
    writeln('Кол-во страниц: ', PageCount);
    writeln('Дата выпуска: ', YearEdition);
  end;
  close(PersonFile);
  writeln;
end;
function AverageValue: real;
var
  i: integer;
  a: integer;
  book: books;
begin
  assign(PersonFile, 'PersonFile.txt');
  reset(PersonFile);
  for i := FileSize(PersonFile)-1 downto 0 do
  begin
    seek(PersonFile, i);
    read(PersonFile, book);
    a := a + Book.PageCount;
  end;
  result := a / FileSize(PersonFile);
end;
procedure BooksNewFile;
var
  year: integer;
  i: integer;
  book: books;
begin
  write('Введите год: ');
  readln(year);
  assign(PersonFile, 'PersonFile.txt');
  reset(PersonFile);
  assign(NewFile, 'NewFile.txt');
  rewrite(NewFile);
  for i := FileSize(PersonFile)-1 downto 0 do
  begin
    seek(PersonFile, i);
    read(PersonFile, book);
    if book.YearEdition > year then
      write(NewFile, book);
  end;
end;
procedure PrintNewFile;
var
  i: integer;
  Book: books;
begin
  assign(NewFile, 'NewFile.txt');
  reset(NewFile);
  for i := FileSize(NewFile)-1 downto 0 do
  begin
    seek(NewFile, i);
    read(NewFile, Book);
    with Book do
    begin
      writeln('Имя книги: ',NameBook);
      writeln('Кол-во страниц: ',PageCount);
      writeln('Дата выпуска: ',YearEdition);
    end;
  end;
  close(NewFile);
  writeln;
end;
procedure Del;
var
  a: integer;
  book: books;
  name: string;
  page: integer;
  year: integer;
begin
  write('Введите номер записи которую нужно удалить: ');
  readln(a);
  assign(PersonFile, 'PersonFile.txt');
  reset(PersonFile);
  seek(PersonFile, FileSize(PersonFile)-1);
  read(PersonFile, Book);
  with Book do
  begin
    name:=NameBook;
    Page:=PageCount;
    year:=YearEdition;
  end;
  seek(PersonFile, a);
  with Book do
  begin
    NameBook:=name;
    PageCount:=page;
    YearEdition:=year;
  end;
  read(PersonFile,book);
  seek(Personfile,FileSize(PersonFile)-1);
  Truncate(PersonFile);
end;
begin
  writeln('1. Добавить запись');
  writeln('2. Вывести на печать 1 запись');
  writeln('3. Вывести на печать все записи');
  writeln('4. Найти книгу с максимальным кол-вом страниц');
  writeln('5. Среднее кол-во страниц');
  writeln('6. Удалить запись');
  writeln('0. Выход');
  write('Введите номер пункта: ');
  readln(a);
  while a <> 0 do
  begin
    if a = 1 then
      Fill;
    if a = 2 then
      Print;
    if a = 3 then
      FullPrint;
    if a = 4 then
      MaxPage;
    if a = 5 then
    begin
      writeln('Среднее кол-во страниц: ',AverageValue);
      writeln;
      BooksNewFile;
      PrintNewFile;
    end;
    if a = 6 then
      Del;
    write('Введите пункт: ');
    readln(a);
  end;                                                                                                                                                                                                                                                                                                         
end.

uses
  Crt;
const
  MAX_RECORDS = 500; // максимальное число записей в файле
type
  TIndex = record
    arr: array[0..MAX_RECORDS-1] of integer;
    size: integer;
  end;

  TOneinfo = record
    name: string[20];
    House: real;
    Flat:integer;
    floor:integer;//этаж
  end;
  tkey = (kname, kHouse, kFlat, kfloor);
  TBase = file of TOneinfo;
  TGreater = function(rec1, rec: TOneInfo): boolean;

function gtName(const rec1, rec2: TOneInfo): boolean;
begin
  gtName := rec1.Name > rec2.Name;
end; { gtName }

function gtHouse(const rec1, rec2: TOneInfo): boolean;
begin
  gtHouse := rec1.House > rec2.House;
end; { gtHouse }

function gtFlat(const rec1, rec2: TOneInfo): boolean;
begin
  gtFlat := rec1.Flat > rec2.Flat;
end; { gtFlat }

function gtFloor(const rec1, rec2: TOneInfo): boolean;
begin
  gtFloor := rec1.floor > rec2.floor;
end; { gtFloor }

procedure CreateIdx(const f: TBase; var idx: TIndex);
// Создание индексного массива
var
  rec: TOneInfo;
  i  : integer;
begin
  idx.size := FileSize(f);
  for i:= 1 to idx.size do
    idx.arr[i] := i-1;
end; { CreateIdx }

procedure Sort(const f: TBase; var idx: TIndex; const gt: TGreater);
var
  i,j,n : integer;
  tmp: integer;
  rec1, rec2: TOneinfo;
begin

  n:= filesize(f);
  seek(f,0);
  for i:= 1 to idx.size-1 do
    for j:= idx.size downto i+1 do begin
      seek(f, idx.arr[j]-1);
      read(f, rec1);
      read(f, rec2);

      if gt(rec1, rec2) then begin
        tmp := idx.arr[j];
        idx.arr[j] := idx.arr[j-1];
        idx.arr[j-1] := tmp;
      end;
    end;
end; { Sort }

procedure CreateIdxAll(
  const f: TBase; var idx1, idx2, idx3: TIndex; const gt1, gt2, gt3: TGreater);
begin
  CreateIdx(f, idx1);
  Sort(f, idx1, gt1);

  CreateIdx(f, idx2);
  Sort(f, idx2, gt2);

  CreateIdx(f, idx3);
  Sort(f, idx3, gt3);
end; { CreateIdxAll }

procedure AddRec(var f: TBase);
//Процедура ввода
var
  i, House, Flat: integer;
  name: string;
  rec: TOneinfo;

begin
  writeln('Ввод базы данных');

  write('Название улицы ');
  readln(rec.name);

  write('номер дома ');
  readln(rec.House);

  write('этаж ');
  readln(rec.floor);

  write('номер квартиры ');
  readln(rec.Flat);

  seek(f, filesize(f));
  write(f, rec);

  readln;
end; { AddRec }

procedure PrintRec(const rec:TOneinfo);
var
  i: integer;
begin
  with rec do
    writeln('Название - ', name, ';', 'номер дома - ', House, ';','Этаж - ',
      floor, ';', 'номер квартиры - ', Flat);
end; { Print }

procedure PrintFile(const f: TBase; const idx: TIndex);
//Процедура вывода всех записей
var
  i: integer;
  rec: TOneinfo;
begin
  for i:= 1 to idx.size do begin
    seek(f, idx.arr[i]);
    read(f, rec);
    PrintRec(rec);
  end;
  readln;
end; { PrintAll }

procedure PrintAll(const f: TBase; const idx1, idx2, idx3: TIndex);
begin
  clrscr;
  writeln('Сортировка по номеру дома');
  PrintFile(f, idx1);
  writeln('Сортировка по номеру квартиры');
  PrintFile(f, idx2);
  writeln('Сортировка по номеру этажа');
  PrintFile(f, idx3);
end; { PrintAll }

function MaxFlat(const f: TBase): TOneInfo;
//процедура, определяет запись с наибольшим номером квартиры
var
  i: integer;
  rec, max: TOneinfo;
begin
  max.Flat := -MaxInt-1;
  seek(f,0);
  while not eof(f) do
    begin
      read(f,rec);
      if rec.Flat > max.Flat then
        max := rec;
    end;
  MaxFlat := rec;
end; { MaxFlat }

function FirstFloor(const f: TBase): integer;
// функцию, определяющую количество жителей первого этажа
var
  k: integer;
  rec: TOneinfo;
begin
  k := 0;
  seek(f,0);
  while not eof(f) do
    begin
      read(f,rec);
      if rec.floor =1 then
        inc(k);
    end;
  FirstFloor:=k;
end; { FirstFloor }

procedure DelRec(var f: TBase; const RecNo: integer);
begin
end; { DelRec }

procedure menu;
begin
  writeln('1. Добавить запись');
  writeln('2. Вывести на печать одну запись');
  writeln('3. Вывести на печать все записи');
  writeln('4. Наибольший номер квартиры');
  writeln('5. Количество жителей первого этажа');
  writeln('6. Удалить запись');
  writeln('0. Выход');
end; { menu }

var
  choice            : integer; // выбор пункта
  f                 : TBase;
  rec               : TOneInfo;
  idx1, idx2, idx3  : TIndex; // массив индексов
  recno             : integer;
  fName   : string;

  y, m, k, n: integer;
  key: tkey;
  StreetName: string[20];

var
  ii: integer;
  
begin { main }
  ClrScr;
  fName := 'city.dat';
  assign(f, fName);
  if not FileExists(fname) then
    begin
      rewrite(f);
      close(f);
    end;

  reset(f);
  
  CreateIdxAll(f, idx1, idx2, idx3, gtHouse, gtFlat, gtFloor);

  choice := 1;
  while choice <> 0 do
    begin
      clrscr;
      menu;
      write('Выбор ');
      readln(choice);
      case choice of
        1: begin
             AddRec(f);
             CreateIdxAll(f, idx1, idx2, idx3, gtHouse, gtFlat, gtFloor);
           end;
        2: begin
             writeln('sorry, under construction');
//             PrintRec(rec);
             readln;
           end;
        3: PrintAll(f, idx1, idx2, idx3);
        4: begin
             writeln('Наибольший номер квартиры ', MaxFlat(f).Flat);
             readln;
           end;
        5: begin
             writeln('Количество жителей первого этажа ', FirstFloor(f));
             readln;
           end;
        6: begin
             DelRec(f, RecNo);
             CreateIdxAll(f, idx1, idx2, idx3, gtHouse, gtFlat, gtFloor);
           end;
        0: writeln('Работа завершена')
      else
        writeln('Пункты 0..6');
      end;
    end;
  close(f);
end.