Опубликовано 11.06.2017 по предмету Информатика от Гость >> <<

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

Ответ оставил Гость

{1 шаг - Создать типизированный файл!}
Program Ex;
uses  crt;
Const Name=Baze;
       type
           StFio = string[30];
           Adress=string[50];
           RecBook = record
                        Fio : StFio;{Ф.И.О}
                        Adress: Adress;{Адрес}
                        num_tel:string[20]{Телефон};
                      end;

           mas= array[1..30] of RecBook;
        var
           BookFile : file of RecBook;
               Work : RecBook;
                Vid : Char;
           End_Menu : boolean;
               A: mas;

procedure sort_buble(var a:mas; count:integer);
var c:mas;
    last,current:integer;
begin
     for last := count downto 2 do
       for current := 1 to last-1 do
       begin
         if a[current].fio > a[current+1].fio then
     begin
        c[1]:=a[current];
        a[current]:=a[current+1];
        a[current+1]:=c[1];
     end;
       end;
end;

Procedure OutputRec_z;
begin
  with Work do
   begin
     Gotoxy(2,2);  Write( ФИО );
     gotoxy(19,2);  Write( Tel  );
     gotoxy(35,2);  Write( Адрес );
     gotoxy(2,4);   Write(fio);
     gotoxy(19,4);  Write(num_tel);
     gotoxy(35,4);  writeln(adress);
   end;
   readkey;
   clrscr;
end;

Procedure Find;
var
   Findst:string;
   End_Menu2:boolean;
begin
   Write( Введите строку поиска(FIO) );
   readln(Findst);
   TextColor(15);
   Clrscr;
   Assign(BookFile,Name);
   {$I-}    Reset(BookFile);   {$I+}
   if IOresult = 0 then
          begin
               Seek(BookFile, 0);
               while (not Eof(BookFile)) do
begin
     Clrscr;
     Read(BookFile,Work);
     if Pos(FindSt,Work.fio)<>0 then
       OutputRec_z;
end;
 writeln(Больше записей удовлетворяющих критерию поиска не обнаружено);
      readkey;
          end
end;

var f:text;
Procedure Find_b;
var
   i,j:integer;
begin
   TextColor(15);   Clrscr;
   Assign(BookFile,Name);
   {$I-}   Reset(BookFile);
   {$I+}
   if IOresult = 0 then
          begin
               i:=0;{кол-во записей тел которых начинается с 41}
               Seek(BookFile, 0);
               while (not Eof(BookFile)) do
               begin
                    Read(BookFile,Work);
                      if (Pos(41,Work.num_tel)=1) then
     begin
       i:=i+1;
       a[i]:=work;
     end;
     end;
     sort_buble(a, i);
     assign(f,res.txt);
     rewrite(f);
     for j:=1 to i do
     writeln(f,a[j].fio, , a[i].num_tel:7);
     close(f);
  end;
end;

{****************************************************************************}
        Procedure AddRec;
                  begin
                       Clrscr;
                       Write( номер добавляемой записи );
                       TextColor(15);
                       Write(FilePos(BookFile)+1);
                       with Work do
                            begin
                            writeln;
                                 Write( ФИО );
                                 Readln(fio);
                                 Write( Телефон );
                                 Readln(num_tel);
                                 Write( Адрес );
                                 Readln(adress);
                                 Write(BookFile,Work);
                            end;
                  end;
{****************************************************************************}
        Procedure Create_Book_Phone;
                  var
                     Ind, Count : integer;
                  begin
                       Clrscr;
                       Textcolor(15);
                       Assign(BookFile,Name);
                       Rewrite(BookFile);
                       Write( Создаю новый файл );
                       Writeln(Name);
                       Write( Введите количество записей в файле );
                       Readln(Count);
                       for Ind := 1 to Count do AddRec;
                       Writeln;
                       Writeln( Создание завершено);
                       Writeln;
                       Writeln( Количество записей в файле );
                       Writeln(Filesize(BookFile));
                       Close(BookFile);
                  end;
{****************************************************************************}
        Procedure OutputRec;
                  begin
                       Clrscr;
                       Read(BookFile,Work);
                       with Work do
                            begin
                                 Gotoxy(10,2);  Write(ФИО );
                                 gotoxy(34,2);  Write(Телефон  );
                                 gotoxy(50,2);  Write(Адрес );                                
                                 gotoxy(2,4);   Write(fio);
                                 gotoxy(35,4);  Write(num_tel);
                                 gotoxy(50,4);  writeln(adress);
                                 readkey;
                                 clrscr;
                             end;
                  end;
{****************************************************************************}
        Procedure OutputAllRec;
                  begin
                       Clrscr;
                       Assign(BookFile,Name);
                       {$I-} Reset(BookFile);{$I+}
                       if IOresult = 0 then
                          begin
                               Seek(BookFile, 0);
                               while (not Eof(BookFile)) do
                                OutputRec;
                          end
                       end;

{****************************************************************************}
BEGIN
     ClrScr;
     Textbackground(0);
     Vid := ;
     End_Menu := False;
     repeat
      Textcolor(15);
      Write( Текущий Файл:,chr(13),Name);
           Writeln;
           Writeln;
           Writeln(*********************************************************************);
           Writeln;
           Writeln(Меню:);
           Writeln(  2  Cоздать новый файл);
           Writeln(  3  Просмотреть все );
           Writeln(  4  Найти номер телефона сотрудника по его фамилии);
           Writeln(  5  Переписать в алф. порядке в текстовый файл информацию о сотрудниках первые цифры телефона 41);
           Writeln(  8  Bыход);
           Readln(Vid);
           case Vid of
               2 : Create_Book_Phone;
               3 : OutputAllRec;
               4 : Find;
               5 : Find_b;
               8 : End_Menu := true;
           end;
           ClrScr;
     until End_Menu;
END.