Проект "Телефонный справочник"

      2 : SortSurname;

      3 : SortAddress;

      4 : SortPhone;

      end;

      end;

     until b=5;

     end;

     Процедура PhoneMenu - меню. Данная процедура при помощи операторов Writeln и Readln создает меню, для удобства работы с программой конечного пользователя. В меню присутствуют следующие пункты:

     1. Показать все записи - вызывает процедуру WritePhone;

     2. Добавить запись - вызывает процедуру AddPhone;

     3. Удалить запись - вызывает процедуру DeletePhone;

     4. Редактировать запись - вызывает процедуру EditPhone;

     5. Поиск по Фамилии - вызывает процедуру FindSurname;

     6. Поиск по номеру телефона - вызывает процедуру FindPhone;

     7. Выход - завершает работу программы;

     procedure PhoneMenu;

     var b: integer;

     begin

     repeat

      begin

      ClrScr;

       writeln('"Телефонный справочник" - Главное меню');

       writeln;

       writeln('1. Показать все записи');

       writeln('2. Добавить запись');

       writeln('3. Удалить запись');

       writeln('4. Редактировать запись');

       writeln('5. Поиск по Фамилии');

       writeln('6. Поиск по номеру телефона');

       writeln('----------------------------');

      writeln('7. Выход');

      writeln;

      write('Выберите пункт меню: ');

       readln(b);

      case b of

      1 : SortType;

      2 : AddPhone;

      3 : DeletePhone;

      4 : EditPhone;

      5 : FindSurname;

      6 : FindPhone;

      end;

       end;

     until b=7;

     end;

     В основной программе происходит очистка экрана при помощи оператора ClrScr и вызывается процедура PhoneMenu.

     begin

      ClrScr;

      PhoneMenu;

     end.

 

      Заключение 

     Данная программа продемонстрировала хорошую работоспособность. Имеет интуитивно понятный интерфейс и не должна вызывать затруднений в работе конечного пользователя. Для корректной работы программы файл phone.dat должен находиться в каталоге Phone, который в свою очередь должен находится в каталоге где установлен язык программирования Turbo Pascal.

 

      Список литературы. 

     «Основы алгоритмизации и программирование», Е. Н. Сафьянова, учебное пособие, Томск, 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];

      end;

     var PhoneF : file of Phone;

     PhoneR : Phone;

     a : array[1..600] of Phone;

     procedure WritePhone;

     begin

     Assign(PhoneF,'Phone\phone.dat');

     Reset(PhoneF);

     ClrScr;

     writeln('Все записи:');

     writeln;

     while not Eof(PhoneF) do

     begin

     PhoneR.SurnameS:='';

     PhoneR.NameS:='';

     PhoneR.PhoneS:='';

     PhoneR.AddressS:='';

     read(PhoneF,PhoneR);

     writeln;

     write(PhoneR.SurnameS);

     write(' ',PhoneR.NameS);

     write('',PhoneR.PhoneS);

     write('',PhoneR.AddressS);

     end;

     Close(PhoneF);

     writeln;

     writeln;

     write('Нажмите любую клавишу...');

     ReadKey;

     end;

     procedure AddPhone;

     begin

     Assign(PhoneF,'Phone\phone.dat');

     Reset(PhoneF);

     while not Eof(PhoneF) do Read(PhoneF,PhoneR);

     PhoneR.SurnameS:='';

     PhoneR.NameS:='';

     PhoneR.PhoneS:='';

     PhoneR.AddressS:='';

     ClrScr;

     writeln('Добавление записи:');

     writeln;

     Write('Введите Фамилию:');

     readln(PhoneR.SurnameS);

     write('Введите Имя:');

     readln(PhoneR.NameS);

     write('Введите номер телефона:');

     readln(PhoneR.PhoneS);

     write('Введите адрес:');

     readln(PhoneR.AddressS);

     write(PhoneF,PhoneR);

     Close(PhoneF);

     writeln;

     writeln('Запись успешно добавлена в базу!!!');

     writeln;

     write('Нажмите любую клавишу...');

     ReadKey;

     end;

     procedure DeletePhone;

     var temp : file of Phone;

     Nazv : string[15];

     begin

     Assign(PhoneF,'Phone\phone.dat');

     Reset(PhoneF);

     Assign(temp,'Phone\temp.dat');

     Rewrite(temp);

     PhoneR.SurnameS:='';

     PhoneR.NameS:='';

     PhoneR.PhoneS:='';

     PhoneR.AddressS:='';

     ClrScr;

     writeln('Удаление записи:');

     writeln;

     Write('Введите Фамилию:');

     readln(Nazv);

     while not Eof(PhoneF) do

     begin

     Read(PhoneF,PhoneR);

     if PhoneR.SurnameS<>Nazv then Write(temp,PhoneR);

     end;

     Close(temp);

     Close(PhoneF);

     Erase(PhoneF);

     Rename(temp,'Phone\phone.dat');

     writeln;

     writeln('Запись успешно удалена из базы!!!');

     writeln;

     write('Нажмите любую клавишу...');

     ReadKey;

     end;

     procedure EditPhone;

     var Nazv : string[15];

     temp : file of Phone;

     begin

     Assign(PhoneF,'Phone\phone.dat');

     Reset(PhoneF);

     Assign(temp,'Phone\temp.dat');

     Rewrite(temp);

     PhoneR.SurnameS:='';

     PhoneR.NameS:='';

     PhoneR.PhoneS:='';

     PhoneR.AddressS:='';

     ClrScr;

     writeln('Редактирование записи:');

     writeln;

     Write('Введите Фамилию, которую хотите изменить:');

     readln(Nazv);

     while not Eof(PhoneF) do

     begin

     PhoneR.SurnameS:='';

     PhoneR.NameS:='';

     PhoneR.PhoneS:='';

     PhoneR.AddressS:='';

     Read(PhoneF,PhoneR);

     if PhoneR.SurnameS<>Nazv then Write(temp,PhoneR);

     end;

     writeln;

     write('Введите новую Фамилию:');

     readln(PhoneR.SurnameS);

     write('Введите новое Имя:');

     readln(PhoneR.NameS);

     write('Введите новый номер телефона:');

     readln(PhoneR.PhoneS);

     write('Введите новый адрес:');

     readln(PhoneR.AddressS);

     write(temp,PhoneR);

     Close(temp);

     Close(PhoneF);

     Erase(PhoneF);

     Rename(temp,'Phone\phone.dat');

     writeln;

     writeln('Запись успешно изменена!!!');

     writeln;

     write('Нажмите любую клавишу...');

     ReadKey;

     end;

     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

     begin

     PhoneR.SurnameS:='';

     PhoneR.NameS:='';

     PhoneR.PhoneS:='';

     PhoneR.AddressS:='';

     read(PhoneF,PhoneR);

     if PhoneR.SurnameS=Nazv then

     begin

     writeln;

     write(PhoneR.SurnameS);

     write(' ',PhoneR.NameS);

     write('',PhoneR.PhoneS);

     write('',PhoneR.AddressS);

     k:=k+1;

     end;

     end;

     Close(PhoneF);

     writeln;

     writeln;

     writeln('Поиск завершен, найдено записей: ',k);

     writeln;

     write('Нажмите любую клавишу...');

     ReadKey;

     end;

     procedure FindPhone;

     var Nazv : string[15];

     k : integer;

     begin

     k:=0;

     Assign(PhoneF,'Phone\phone.dat');

     Reset(PhoneF);

     ClrScr;

     writeln('Поиск записи по номеру телефона:');

     writeln;

     Write('Введите номер телефона:');