Паскаль, не могу разобраться в чем ошибка. В общем напишите программку

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

Задать свой вопрос
1 ответ
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 gt; 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)lt;gt;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.



, оставишь ответ?
Имя:*
E-Mail:


Добро пожаловать!

Для того чтобы стать полноценным пользователем нашего портала, вам необходимо пройти регистрацию.
Зарегистрироваться
Создайте собственную учетную запить!

Пройти регистрацию
Авторизоваться
Уже зарегистрированны? А ну-ка живо авторизуйтесь!

Войти на сайт