procedure FindSurname;
var Nazv : string[15];
k : integer;
begin
k:=0;
Assign(PhoneF,'Phone\phone.dat');
Reset(PhoneF);
ClrScr;
writeln('Поиск записи по Фамилии:');
writeln;
Write('Введите Фамилию:');
readln(Nazv);
while not Eof(PhoneF) do
PhoneR.SurnameS:='';
PhoneR.NameS:='';
PhoneR.PhoneS:='';
PhoneR.AddressS:='';
read(PhoneF,PhoneR);
if PhoneR.SurnameS=Nazv then
write(PhoneR.SurnameS);
write(' ',PhoneR.NameS);
write('',PhoneR.PhoneS);
write('',PhoneR.AddressS);
k:=k+1;
end;
Close(PhoneF);
writeln('Поиск завершен, найдено записей: ',k);
write('Нажмите любую клавишу...');
ReadKey;
Процедура FindPhone – поиск по номеру телефона. Работа данной процедуры аналогична работе процедуры FindSurname, за одним лишь исключением: сравнение идет по полю PhoneS, а не по полю SurnameS.
procedure FindPhone;
writeln('Поиск записи по номеру телефона:');
Write('Введите номер телефона:');
if PhoneR.PhoneS=Nazv then
Процедура SortSurname – сортировка по фамилии. Данная процедура открывает файл phone.dat, далее в цикле переписывает все записи в массив а. Затем при помощи цикла и условного оператора сравнивает и сортирует записи в алфавитном порядке по полю Фамилия. Далее при помощи цикла выводит на экран уже отсортированные записи из массива.
procedure SortSurname;
var i,j,c: integer;
tr: Phone;
c:=0;
writeln('Сортировка по Фамилии:');
while not Eof(PhoneF) do begin
inc(c,1);
read(PhoneF,a[c]);
for i:=1 to c do
for j:=1 to c-1 do begin
if a[j].SurnameS>a[j+1].SurnameS then begin
tr:=a[j+1];
a[j+1]:=a[j];
a[j]:=tr;
for i:=1 to c do begin
write(a[i].SurnameS);
write(' ',a[i].NameS);
write('',a[i].PhoneS);
write('',a[i].AddressS);
Процедуры SortAddress и SortPhone – работают аналогично процедуре SortSurname, только за одним исключением сравниваются и сортируются записи по полям адрес и номер телефона соответственно.
procedure SortAddress;
writeln('Сортировка по адресу:');
if a[j].AddressS>a[j+1].AddressS then begin
procedure SortPhone;
if a[j].PhoneS>a[j+1].PhoneS then begin
Процедура SortType – подменю сортировки. Данная процедура при помощи операторов Writeln и Readln создает подменю сортировки, для удобства работы с программой конечного пользователя. В меню присутствуют следующие пункты:
· 1. Не сортировать – вызывает процедуру WritePhone;
· 2. Сортировать по Фамилии – вызывает процедуру SortSurname;
· 3. Сортировать по адресу – вызывает процедуру SortAddress;
· 4. Сортировать по номеру телефона – вызывает процедуру SortPhone;
· 5. Возврат в главное меню – возвращается к главному меню;
procedure SortType;
var b: integer;
repeat
writeln('"Телефонный справочник" - меню сортировки');
writeln('1. Не сортировать');
writeln('2. Сортировать по Фамилии');
writeln('3. Сортировать по адресу');
writeln('4. Сортировать по номеру телефона');
writeln('----------------------------');
writeln('5. Возврат в главное меню');
write('Выберите пункт меню: ');
readln(b);
case b of
1 : WritePhone;
2 : SortSurname;
3 : SortAddress;
4 : SortPhone;
until b=5;
Процедура PhoneMenu – меню. Данная процедура при помощи операторов Writeln и Readln создает меню, для удобства работы с программой конечного пользователя. В меню присутствуют следующие пункты:
· 1. Показать все записи – вызывает процедуру WritePhone;
· 2. Добавить запись – вызывает процедуру AddPhone;
· 3. Удалить запись – вызывает процедуру DeletePhone;
· 4. Редактировать запись – вызывает процедуру EditPhone;
· 5. Поиск по Фамилии – вызывает процедуру FindSurname;
· 6. Поиск по номеру телефона – вызывает процедуру FindPhone;
· 7. Выход – завершает работу программы;
procedure PhoneMenu;
writeln('"Телефонный справочник" - Главное меню');
writeln('1. Показать все записи');
writeln('2. Добавить запись');
writeln('3. Удалить запись');
writeln('4. Редактировать запись');
writeln('5. Поиск по Фамилии');
writeln('6. Поиск по номеру телефона');
writeln('7. Выход');
1 : SortType;
2 : AddPhone;
3 : DeletePhone;
4 : EditPhone;
5 : FindSurname;
6 : FindPhone;
until b=7;
В основной программе происходит очистка экрана при помощи оператора ClrScr и вызывается процедура PhoneMenu.
PhoneMenu;
end.
Заключение
Данная программа продемонстрировала хорошую работоспособность. Имеет интуитивно понятный интерфейс и не должна вызывать затруднений в работе конечного пользователя. Для корректной работы программы файл phone.dat должен находиться в каталоге Phone, который в свою очередь должен находится в каталоге где установлен язык программирования Turbo Pascal.
Список литературы.
1. «Основы алгоритмизации и программирование», Е. Н. Сафьянова, учебное пособие, Томск, 2000 г.
Приложение 1. Листинг программы.
{Для корректной работы программы файл phone.dat
должен находиться в каталоге Phone, который в
свою очередь должен находится в каталоге где
установлен язык программирования Turbo Pascal}
program Phonebook;
uses Crt;
type Phone = record
SurnameS : string[15];
NameS : string[15];
PhoneS : string[15];
AddressS: string[50];
var PhoneF : file of Phone;
PhoneR : Phone;
a : array[1..600] of Phone;
procedure WritePhone;
writeln('Все записи:');
procedure AddPhone;
while not Eof(PhoneF) do Read(PhoneF,PhoneR);
writeln('Добавление записи:');
readln(PhoneR.SurnameS);
write('Введите Имя:');
readln(PhoneR.NameS);
write('Введите номер телефона:');
readln(PhoneR.PhoneS);
write('Введите адрес:');
readln(PhoneR.AddressS);
write(PhoneF,PhoneR);
writeln('Запись успешно добавлена в базу!!!');
procedure DeletePhone;
var temp : file of Phone;
Nazv : string[15];
Assign(temp,'Phone\temp.dat');
Rewrite(temp);
writeln('Удаление записи:');
Read(PhoneF,PhoneR);
if PhoneR.SurnameS<>Nazv then Write(temp,PhoneR);
Close(temp);
Erase(PhoneF);
Rename(temp,'Phone\phone.dat');
writeln('Запись успешно удалена из базы!!!');
procedure EditPhone;
temp : file of Phone;
writeln('Редактирование записи:');
Write('Введите Фамилию, которую хотите изменить:');
write('Введите новую Фамилию:');
write('Введите новое Имя:');
write('Введите новый номер телефона:');
write('Введите новый адрес:');
write(temp,PhoneR);
writeln('Запись успешно изменена!!!');
Страницы: 1, 2
