program p182665;
// Ковров, lamed,
2011
// RFPRO.Ru
{
+Записи содержат данные работниках:
+ фамилия и инициалы,
+ табельный номер,
+ номер подразделения,
+ должность,
+ стаж работы,
+ величина зарплаты.
+Получить списки работников, заданного подразделения, стаж которых не менее 10,20,25 лет

Задание 1.
+Создать файл, содержащий записи заданного типа.
+Получить результаты обработки записей файла.

Задание 2.
Описать процедуры работы с файлом, состоящим 
 из записей типа, указанного в задании 1:
+1. Добавление записи в файл
+2. Просмотр файла(выдача на экран всех записей файла)
+3. поиск записей по заданному значению поля
+4. Корректировка записи файла:
+b. по заданному значению поля найти запись и произвести соответствующую замену
+5. Удаление записи из файла по ее номеру
+b. без использования временного файла
+6. Обработка записей файла(подсчет суммы, среднего или выбор записей, удовлетворяющих условию задания 1)
+7. Сортировка записей
файла по заданному полю
+8. Инициализация файла(задание имени файла вначале работы с файлом или для перехода к работе с другим файлом)
}
uses
  crt;
type
  TFio = string[30];
  TTabn = integer;
  TPodr = integer;
  TDolg = string[30];
  TStag = integer;
  TZarp = integer;
  TRec = record
    fio  : TFio;   // фамилия и инициалы,
    tabn : TTabn;  // табельный номер,
    podr : TPodr;  // номер подразделения,
    dolg 
 : TDolg;  // должность,
    stag : TStag;  // стаж работы,
    zarp : TZarp;  // величина зарплаты.
  end;

type
  TFileName   = string[30];
  TFunc       = function(rec1,rec2: TRec):boolean;
  TFilterFunc = function(rec, etalon: TRec): boolean;
  TTable      = file of TRec;
var
  i              : integer;
  iChoice        : integer;
  IsFiltered     : boolean;
  f, f2          : TTable;
  flt            : TFilterFunc;
  fname, fname2  : TFileName;
  lt   
         : TFunc;
  rec, etalon    : TRec;
  NewRec         : TRec;
  sortfield      : integer;
  symbol         : char;
  RecNo          : integer;

procedure last(var f: TTable);
begin
  seek(f, filesize(f));
end; { last }

procedure insert(var f: TTable; rec: TRec);
begin
  last(f);
  write(f, rec);
end; { insert }

procedure create(fname: TFileName);
var
  f: TTable;
begin
  assign(f, fname);
  rewrit
 e(f);
  close(f);
end; { create }

procedure display(rec: TRec);
begin
  clrscr;
  with rec do
    begin
      writeln('ФИО          : ',fio);
      writeln('Табельный №  : ',tabn);
      writeln('Подразделение: ',podr);
      writeln('Должность    : ',dolg);
      writeln('Стаж         : ',stag);
      writeln('Зарплата     : ',zarp);
    end; { with }
  readln;
end; { display }

procedure first(var f:
TTable);
begin
  seek(f,0);
end; { first }

procedure GetNewRec(var rec: TRec);
begin
  clrscr;
  with rec do
    begin
      write('ФИО          : ');
      readln(fio);

      write('Табельный №  : ');
      readln(tabn);

      write('Подразделение: ');
      readln(podr);

      write('Должность    : ');
      readln(dolg);

      write('Стаж         : ');
     
  readln(rec.stag);

      write('Зарплата     : ');
      readln(zarp);
    end; { with }

end; { GetNewRec }

procedure open(fName: TFileName; var f: TTable);
begin
  assign(f, fName);
  reset(f);
end; { open }

procedure init(fname: TFileName);
const
  asize = 5;
  recs : array[1..asize] of TRec =
  ((fio: 'Бывалый'; tabn: 1; podr: 1; dolg: 'начальник'; stag: 27; zarp: 500),
   (fio: 'Балбес';  tabn: 2; podr: 1; dolg: 'зам';       stag: 12; zarp: 400),
   (fio: 'Трус';    tabn: 3; podr: 1; dolg: 'сотрудник'; stag: 5;  zarp: 350),

  (fio: 'Бабушка'; tabn: 4; podr: 2; dolg: 'сторож';    stag: 30; zarp: 150),
   (fio: 'Шурик';   tabn: 5; podr: 2; dolg: 'студент';   stag: 0;  zarp: 50));

var
  i: integer;
  f: TTable;

begin
  open(fName, f);
  for i:= 1 to asize do
    insert(f, recs[i]);
  close(f);
end; { init }

{$F+}
function less1(rec1,rec2: TRec): boolean;
begin
  less1:= rec1.fio < rec2.fio;
end; { 
 less1 }
{$F-}

{$F+}
function less2(rec1,rec2: TRec): boolean;
begin
  less2:= rec1.tabn < rec2.tabn;
end; { less2 }
{$F-}

{$F+}
function less3(rec1,rec2: TRec): boolean;
begin
  less3:= rec1.podr < rec2.podr;
end; { less3 }
{$F-}

{$F+}
function less4(rec1,rec2: TRec): boolean;
begin
  less4:= rec1.dolg < rec2.dolg;
end; { less4 }
{$F-}

{$F+}
function less5(rec1,rec2: TRec): boolean;
begin
  less5:= rec1.stag < rec2.stag;
end;
{ less5 }
{$F-}

{$F+}
function less6(rec1,rec2: TRec): boolean;
begin
  less6:= rec1.zarp < rec2.zarp;
end; { less6 }
{$F-}

{$F+}
function flt1(rec, etalon: TRec): boolean;
begin
  flt1 := rec.tabn = etalon.tabn;
end; { flt1 }
{$F-}

{$F+}
function flt2(rec, etalon: TRec): boolean;
begin
  flt2 := rec.stag > etalon.stag;
end; { flt2 }
{$F-}

procedure menu;
begin
  clrsc
 r;
  Writeln( ' 0.Выход' );
  Writeln( ' 1.Проверка существования' );
  Writeln( ' 2.Создание' );
  Writeln( ' 3.Добавление' );
  if IsFiltered then
    Writeln( ' 4.Убрать фильтр' )
  else
    Writeln( ' 4.Установить фильтр' );
  Writeln( ' 5.Выгрузка данных' );
  Writeln( ' 6.Сортировка' );
  Writeln( ' 7.Показ' );
  Writeln( ' 8.Расчет среднего заработка' );
  Writeln( ' 9.Корректировка
зарплаты' );
  Writeln( ' 10.Удаление записи по номеру' );
  Write( ' Выбран пункт:');

end; { Menu }

procedure next(var f: TTable);
begin
  seek(f,filepos(f));
end; { next }

procedure SetFilter(var f: TTable);
begin
end; { SetFilter }

procedure Show(fName: TFileName; FilterExpr: TFilterFunc);
var
  rec: TRec;
begin
  open( fname, f );
  first(f);
  for i:= 0 to filesize(f)-1 do
  
   begin
      read(f, rec);
      if not(IsFiltered) or FilterExpr(rec, etalon) then
        display(rec);
      next(f);
    end;
  close(f);
end; { show }

procedure Change( fName: TFileName; FilterExpr: TFilterFunc; NewRec: TRec);
var
  rec: TRec;
  
begin
  open( fname, f );
  first(f);
  for i:= 0 to filesize(f)-1 do
    begin
      read(f, rec);
      if not(IsFiltered) or FilterExpr(rec, etalon) then
        begin
          seek( f, filepos(
f )-1); { skip-1}
          rec.zarp := NewRec.zarp;
          write( f, rec );
        end;
      next(f);
    end;
  close(f);

end; { Change }

function SrZarp(fName: TFileName; FilterExpr: TFilterFunc): real;
var
  rec: TRec;
  SumZarp: real;
  n: integer;
begin
  open( fname, f );
  first(f);
  n := 0;
  SumZarp := 0.0;
  for i:= 0 to filesize(f)-1 do
    begin
      read(f, rec);
      if not(Is
 Filtered) or FilterExpr(rec, etalon) then
        begin
          inc(n);
          SumZarp := SumZarp + rec.zarp;
        end
;
      next(f);
    end;
  close(f);
  SrZarp := SumZarp / n;
end; { show }

procedure DelRec(fName: TFileName; RecNo: integer);
// Удаление записи по номеру
var
  rec: TRec;
  fSize : integer;
begin
  open(fName,f);
  fSize := FileSize(f);
  if (recno >= 0) and (recno < fSize) then
    begin
      seek(f, FileSize(f)-1);
      read(f, rec);
      seek(f, recno);
      write(f, rec);
      seek(f, fSize-1);
      Truncate(f);
      writeln('Запись
удалена');
    end
  else
    writeln('Неверный номер. Удаление невозможно');
end; { DelRec }

procedure sort(fName: TFileName; SortExpr: TFunc);
var
  f: TTable;
  i,j,n : integer;
  curr: integer;
  rec1, rec2: TRec;
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,r
 ec2);
      if SortExpr(rec2,rec1) then begin
        seek(f,j-1);
        write(f,rec2);
        write(f,rec1);
      end;
    end;
  close(f);
end; { sort }

procedure UnLoad(ffrom, fto: TFileName; FilterExpr: TFilterFunc);
var
  i: integer;
  rec: TRec;
begin
  create(fto);
  open(ffrom, f);
  open(fto, f2);
  first(f);
  for i:= 0 to filesize(f)-1 do
    begin
      read(f,rec);
      if not IsFiltered or FilterExpr(rec, etalon) then

       insert(f2,rec)
    end;
  close(f2);
  close(f);
end; { UnLoad }

begin { main }

  iChoice    := 0;
  IsFiltered := false;
  fName      := '';
  fname2     := '';
  while true do begin
    menu;
    readln( iChoice );

    case iChoice of
      0: { выход }
      begin
        readln;
        exit;
      end;

      1: { проверка существования }
      begin
        write('
 ;Полный путь к файлу ');
        readln(fName);
        if FileExists(fname) then
          writeln('Файл ', fname, ' существует ')
        else
          writeln('Файл ', fname, ' не существует ');
        readln;
      end;

      2: { создание }
      begin
        write('Полный путь к файлу ');
        readln(fName);
        create(fName);
        init(fName);
      end;

      3: { добавление записи }
   
  begin
        GetNewRec(rec);
        open(fname, f);
        insert(f,rec);
        close(f);
      end;

      4: { ввод / снятие фильтра }
      begin
        if IsFiltered then
          IsFiltered := false
        else
          begin
            IsFiltered := true;
            clrscr;
            writeln('Выбор поля');
            writeln('1.ФИО          : ');
            writeln('2.Табельный № 
  : ');
            writeln('3.Подразделение: ');
            writeln('4.Должность    : ');
            writeln('5.Стаж         : ');
            writeln('6.Зарплата     : ');
            readln(sortfield);

            write('Знак ');
            readln(symbol);

            if not (sortfield in [1..6]) or
               not (symbol in ['>', '<', '=']) then
              begin
                write('Ошибка');

               readln;
              end
            else
              begin
                case sortfield of
                  1: begin write('ФИО : '); readln(etalon.fio); end;
                  2: begin write('Табельный № : '); readln(etalon.tabn); end;
                  3: begin write('Подразделение : '); readln(etalon.podr); end;
                  4: begin write('Должность : '); readln
 (etalon.dolg); end;
                  5: begin write('Стаж : '); readln(etalon.stag); end;
                  6: begin write(
'Зарплата : '); readln(etalon.zarp); end;
                end;
                if (sortfield = 2) and (symbol = '=') then
                else if (sortfield = 5) and (symbol = '>') then
                  flt := flt2
                else
                  isFiltered := false;
              end;
          end;
        readln;
      end;

      5: { выгрузка данных }
      begin
///        clrscr;
///        write('Откуда ');
///
       readln(fName);
///        write('Куда   ');
///        readln(fName2);
///        flt := flt1;
///        UnLoad(fname, fname2, Xflt);
        readln;
      end;

      6: { сортировка }
      begin
        clrscr;
        writeln('Выбор поля');
        writeln('1.ФИО          : ');
        writeln('2.Табельный №  : ');
        writeln('3.Подразделение: ');
        writeln('4.Д
 олжность    : ');
        writeln('5.Стаж         : ');
        writeln('6.Зарплата     : ');
        readln(sortfield);
        if not sortfield in [1..6] then
          begin
            write('Нет такого поля');
            readln;
          end
        else
          begin
            case sortfield of
              1: lt := less1; (*'fio'*)
              2: lt := less2; (*'tabn'*)
              3: lt := less3; (*'podr'*)

             4: lt := less4; (*'dolg'*)
              5: lt := less5; (*'stag'*)
              6: lt := less6; (*'zarp'*)
            end; { case }
           sort(fname,lt);
          end;
      end;

      7: { показ }
      begin
        show(fname, flt);
        readln;
      end;

      8: { Расчет среднего заработка }
      begin
        clrscr;
        write('Средний зараб
 оток равен ', SrZarp(fname, flt): 7:2);
        readln;
      end;

      9: { Корректировка зараплаты }
      begin
        clrscr;
        write('Новый заработок равен ');
        readln(NewRec.zarp);
        Change(fname, flt, NewRec);
        readln;
      end;

      10: { Удаление записи по номеру }
      begin
        clrscr;
        write('Номер записи ');
        readln(RecNo);
        DelRec(fName, RecNo);
        readln;

     end;
    end; { case }
  end;

end.