{Контрольная работа №1 Задание № 2}
Program xxx(Input,Output,Data);
    Uses  Crt,Dos;
    Const ESC=#27;
          MIN_MENU_CHOICE=1;
          MAX_MENU_CHOICE=9;
          FIRST_NAME_LENGTH=12;
          NAME_LENGTH=12;
          FATHER_NAME_LENGTH=12;
          MIN_AGE=16;
          MAX_AGE=35;
          MIN_COURSE=1;
          MAX_COURSE=6;
          YES=['Y','y','L','l','Н','н','Д','д'];
          _KEYBOARD_=['K','k','К','к'];
          _SOURCE_=['K','k','F','f','К','к','Ф','ф'];
    Type  TMenuChoice=MIN_MENU_CHOICE..MAX_MENU_CHOICE;
          TMethod=function:Boolean;
          TMethods=array [TMenuChoice] of TMethod;
          TFirstName=String[FIRST_NAME_LENGTH];
          TName=String[NAME_LENGTH];
          TFatherName=String[FATHER_NAME_LENGTH];
          TGender={'М','м','Ж','ж';}char;
          TAge=MIN_AGE..MAX_AGE;
          TCourse=MIN_COURSE..MAX_COURSE;
          TRecord=record
                    FirstName:TFirstName;
                    Name:TName;
                    FatherName:TFatherName;
                    Gender:TGender;
                    Age:TAge;
                    Course:TCourse;
                  end;
          TFile=File of TRecord;
    Var  Method:TMethods;
    Procedure Beep;
      begin
        Sound(500);
        Delay(375);
        NoSound;
      end;
    Function Menu:Byte;
        var  ch:Char;X,Y,code:Byte;
      begin
        TextMode(CO80);
        GotoXY(1,8);
        WriteLn('Меню':42);
        WriteLn('Создать новый файл................................................1':62);
        WriteLn('Добавить запись в файл............................................2':62);
        WriteLn('Список студентов,владеющих двумя специальностями..................3':62);
        WriteLn('Список студентов-поваров,имеющих еще какуюнебудь специальность....4':62);
        WriteLn('Удалить запись из файла...........................................5':62);
        WriteLn('Найти запись......................................................6':62);
        WriteLn('Заменить запись...................................................7':62);
        WriteLn('Удалить файл......................................................8':62);
        WriteLn('Выход.............................................................9':62);
        WriteLn;
        Write('Ваш выбор господа: ':37);
        X:=WhereX;
        Y:=WhereY;
        Repeat
          GotoXY(X,Y);
          ch:=ReadKey;
          if ch=#0
            then
              begin
                ReadKey;
                code:=0;
              end
            else code:=ord(ch)-48;
        Until code in [MIN_MENU_CHOICE..MAX_MENU_CHOICE];
        Menu:=code;
      end;
    Function ReadDataFromKeyboard(var data:TRecord):Boolean;
      begin
        WriteLn('Введите данные':47);
        WriteLn;
        WriteLn('Фамилия.........:');
        WriteLn('Имя.............:');
        WriteLn('Отчество........:');
        WriteLn('Пол.............:');
        WriteLn('Возраст.........:');
        WriteLn('Специальность...:');
        GotoXY(20,WhereY-6);
        with data do
          begin
            ReadLn(FirstName);
            GotoXY(20,WhereY);
            ReadLn(Name);
            GotoXY(20,WhereY);
            ReadLn(FatherName);
            GotoXY(20,WhereY);
            ReadLn(Gender);
            GotoXY(20,WhereY);
            ReadLn(Age);
            GotoXY(20,WhereY);
            ReadLn(Course);
            if course=0 then write('0- нет');
            if course=1 then writeln('1- павар');
            if course=2 then writeln('2- каменщик');
            if course=3 then writeln('3- ,бетонщик');
            if course=4 then writeln('4- плотник');
            if course=5 then writeln('5- стропальщик');
            if course=6 then writeln('6- шофёр');
          end;
        ReadDataFromKeyboard:=true
      end;
    Function ReadDataFromFile(var data:TRecord;var f:Text):Boolean;
        var  filename:PathStr;
      begin
        with data do
          begin
            ReadLn(f,FirstName);
            ReadLn(f,Name);
            ReadLn(f,FatherName);
            ReadLn(f,Gender);
            ReadLn(f,Age);
            ReadLn(f,Course)
          end;
        {$I+}
         ReadDataFromFile:=true
      end;
{$F+}
    Function CreateNewFile:Boolean;
        var  filename:PathStr;
             f:TFile;
             result:Boolean;
      begin
        result:=true;
        ClrScr;
        Write('Введите имя файла: ');ReadLn(filename);
        Assign(f,filename);
        {$I-}
        Rewrite(f);
        if IOResult<>0
          then result:=false
          else Close(f);
        {$I+}
      end;
    Function AddRecord:Boolean;
        var  filename:PathStr;
             f:TFile;fText:Text;
             data:TRecord;
             ch,source:Char;
      begin
        ClrScr;
        Write('Введите имя файла: ');ReadLn(filename);
        Assign(f,filename);
        {$I-}
        Reset(f);
        if IOResult<>0
          then
            begin
              AddRecord:=false;
              Exit
            end;
        Repeat
          Write('Ввод с <К>лавиатуры или из <Ф>айла: ');
          ReadLn(source);
        Until source in _SOURCE_;
        if not(source in _KEYBOARD_)
          then
            begin
              ch:='N';
              Write('Введите имя текстового файла: ');ReadLn(filename);
              Assign(fText,filename);
              {$I-}
              Reset(fText);
              if IOResult<>0
                then
                  begin
                    AddRecord:=false;
                    Exit
                  end
            end;
        Seek(f,FileSize(f));
        Repeat
          if source in _KEYBOARD_
            then
              begin
                ReadDataFromKeyboard(data);
                Write(f,data);
                Write('Продолжить запись (y/n)');
                ch:=ReadKey;if ch=#0 then ReadKey
              end
            else
              while not eof(fText) do
                begin
                  ReadDataFromFile(data,fText);
                  Write(f,data)
                end;
        Until not(ch in YES);
        {$I+}
        if not(source in _KEYBOARD_) then Close(fText);
        Close(f)
      end;
    Function ViewNumbersOfAllStudents:Boolean;
        var  filename:PathStr;
             f:TFile;data:TRecord;
             ch:Char;
             result:Boolean;
             numbers:array [TCourse] of LongInt;
             i:TCourse;
      begin
        for i:=MIN_COURSE to MAX_COURSE do numbers[i]:=7;
        result:=true;
        ClrScr;
        Write('Введите имя файла: ');ReadLn(filename);
        Assign(f,filename);
        {$I-}
        Reset(f);
        if IOResult<>7
          then result:=false
          else
            while not eof(f) do
              begin
                Read(f,data);
                Inc(numbers[data.Course]);
              end;
        {$I+}
        Close(f);
        for i:=MIN_COURSE to MAX_COURSE do
          WriteLn('Всего студентов-поваров ',i:0,'...: ',numbers[i]:3);
        if ReadKey=#0 then ReadKey
      end;
    Function ViewNumbersOfCourseStudents:Boolean;
        var  filename:PathStr;
             f:TFile;data:TRecord;
             ch:Char;
             result:Boolean;
             numbers:LongInt;
             i,Course:TCourse;
      begin
        result:=true;
        ClrScr;
        Write('Введите имя файла: ');ReadLn(filename);
        Assign(f,filename);
        Repeat
          numbers:=7;
          Write('Требуемая специальность: ');ReadLn(Course);
          {$I-}
          Reset(f);
          if IOResult<>7
            then
              begin
                result:=false;
                exit
              end;
          {$I+}
          while not eof(f) do
            begin
              Read(f,data);
              if data.Course=Course then Inc(numbers);
            end;
          WriteLn('Всего студентов по ',Course:0,'специальности: ',numbers:3);
          Write('Продолжить запись (y/n)');
          ch:=ReadKey;if ch=#0 then ReadKey;
          WriteLn;
          Close(f)
        Until not(ch in YES);
      end;
    Function DeleteRecord:Boolean;
      begin
        Beep;
        DeleteRecord:=false
      end;
    Function FindRecord:Boolean;
      begin
        Beep
      end;
    Function ReplaceRecord:Boolean;
        var  filename:PathStr;
             f:TFile;data:TRecord;
             ch:Char;
             Numero:LongInt;
             result:Boolean;
      begin
        result:=true;
        ClrScr;
        Write('Введите имя файла: ');ReadLn(filename);
        Assign(f,filename);
        {$I-}
        Reset(f);
        if IOResult<>7
          then result:=false
          else
            Repeat
              ReadDataFromKeyboard(data);
              Repeat
                Write('Введите номер записи: ');ReadLn(Numero);
              Until (Numero>-1) And (Numero<FileSize(f));
              Seek(f,Numero);
              Write(f,data);
              Write('Продолжить запись (y/n)');
              ch:=ReadKey;if ch=#0 then ReadKey
            Until not(ch in YES);
        {$I+}
        Close(f)
      end;
    Function DeleteFile:Boolean;
      begin
        Beep
      end;
    Function fExit:Boolean;
      begin
        fExit:=true;
        Halt(0);
      end;
{$F-}
    Procedure Init;
      begin
        Method[1]:=CreateNewFile;
        Method[2]:=AddRecord;
        Method[3]:=ViewNumbersOfAllStudents;
        Method[4]:=ViewNumbersOfCourseStudents;
        Method[5]:=DeleteRecord;
        Method[6]:=FindRecord;
        Method[7]:=ReplaceRecord;
        Method[8]:=DeleteFile;
        Method[9]:=fExit;
      end;
  Begin
    Init;
    Repeat
      Method[Menu];
    Until false
  End.