Паскаль, не могу разобраться в чем ошибка. В общем напишите программку
Паскаль, не могу разобраться в чем ошибка. В общем напишите программу
Создать, нетекстовый файл, который содержит информацию о телефонах служащих учреждения (фамилия, инициалы, номер телефона).
Нужно:
А) отыскать номер телефона сотрудника по его фамилии
Б) переписать в алфавитном порядке в текстовый файл информацию о сотрудниках, у которых 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.
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.
, оставишь ответ?
Похожие вопросы
-
Вопросы ответы
Новое
NEW
Статьи
Информатика
Статьи
Последние вопросы
Игорь 14 лет назад был на 8 лет моложе, чем его
Математика.
Два тела массами m1 и m2 находящие на расстоянии R друг
Физика.
В сосуде 4целых одна пятая литр воды что бы заполнить сосуд
Математика.
Двум малярам Диме И Олегу поручили выкрасить фасад дома они разделили
Разные вопросы.
найти порядковый номер 41Э если в ядре 20 нейтронов
Разные вопросы.
в ряду натуральных чисел 3, 8, 10, 24, … 18 одно
Математика.
Предприятие по производству с/хоз продукции на производство затратило 3527000 руб Валовый
Разные вопросы.
Математика, задано на каникулы. ВАРИАНТ 1004
НОМЕР 1,2,3,4,5,6,7,8.
Математика.
Имеются три конденсатора емкостью С1=1мкФ, С2=2мкФ и С3=3мкФ. Какую наименьшую емкость
Физика.
Из точки м выходят 3 луча MP MN и MK причём
Геометрия.
Облако тегов