Паскаль, не могу разобраться в чем ошибка. в общем напишите программу создать, нетекстовый файл, который содержит информацию о телефонах сотрудников учреждения (фамилия, инициалы, номер телефона). требуется: а) найти номер телефона сотрудника по его фамилии б) переписать в алфавитном порядке в текстовый файл информацию о сотрудниках, у которых первые цифры телефона 41.
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.