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

     Процедура FindSurname - поиск по фамилии. Для работы данной процедуры нам потребуются дополнительные переменные:

     k - целого типа, в данной переменной будет хранится количество найденных записей;

     Nazv - строкового типа длинной 15 символов, в этой переменной будет храниться значение поля фамилии записи которую необходимо найти.

     Переменной k присваиваем значение равное 0. С помощью операторов Assign и Reset открываем файл phone.dat и устанавливаем указатель в первую позицию. С помощью операторов Writeln и Readln создаем интерфейс для ввода фамилии (по фамилии мы будем искать в файле нужную нам запись) с клавиатуры, присваиваем введенное значение переменной Nazv. В цикле при помощи условного оператора сравниваем значение поля SurnameS со значением переменной Nazv и при совпадение выводим данную запись на экран, при каждом совпадении значение переменной k будет увеличиваться на единицу. Выводим значение переменной k на экран. Закрываем файл.

     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;

     Процедура FindPhone - поиск по номеру телефона. Работа данной процедуры аналогична работе процедуры FindSurname, за одним лишь исключением: сравнение идет по полю PhoneS, а не по полю SurnameS.

     procedure FindPhone;

     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.PhoneS=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;

     Процедура SortSurname - сортировка по фамилии. Данная процедура открывает файл phone.dat, далее в цикле переписывает все записи в массив а. Затем при помощи цикла и условного оператора сравнивает и сортирует записи в алфавитном порядке по полю Фамилия. Далее при помощи цикла выводит на экран уже отсортированные записи из массива.

     procedure SortSurname;

     var i,j,c: integer;

     tr: Phone;

     begin

     c:=0;

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

     Reset(PhoneF);

     ClrScr;

     writeln('Сортировка по Фамилии:');

     writeln;

     while not Eof(PhoneF) do begin

     inc(c,1);

     read(PhoneF,a[c]);

     end;

     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;

     end;

     end;

     for i:=1 to c do begin

     writeln;

     write(a[i].SurnameS);

     write(' ',a[i].NameS);

     write('',a[i].PhoneS);

     write('',a[i].AddressS);

     end;

     Close(PhoneF);

     writeln;

     writeln;

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

     ReadKey;

     end;

     Процедуры SortAddress и SortPhone - работают аналогично процедуре SortSurname, только за одним исключением сравниваются и сортируются записи по полям адрес и номер телефона соответственно.

     procedure SortAddress;

     var i,j,c: integer;

     tr: Phone;

     begin

     c:=0;

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

     Reset(PhoneF);

     ClrScr;

     writeln('Сортировка по адресу:');

     writeln;

     while not Eof(PhoneF) do begin

     inc(c,1);

     read(PhoneF,a[c]);

     end;

     for i:=1 to c do

     for j:=1 to c-1 do begin

     if a[j].AddressS>a[j+1].AddressS then begin

      tr:=a[j+1];

      a[j+1]:=a[j];

      a[j]:=tr;

     end;

     end;

     for i:=1 to c do begin

     writeln;

     write(a[i].SurnameS);

     write(' ',a[i].NameS);

     write('',a[i].PhoneS);

     write('',a[i].AddressS);

     end;

     Close(PhoneF);

     writeln;

     writeln;

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

     ReadKey;

     end;

     procedure SortPhone;

     var i,j,c: integer;

     tr: Phone;

     begin

     c:=0;

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

     Reset(PhoneF);

     ClrScr;

     writeln('Сортировка по адресу:');

     writeln;

     while not Eof(PhoneF) do begin

     inc(c,1);

     read(PhoneF,a[c]);

     end;

     for i:=1 to c do

     for j:=1 to c-1 do begin

     if a[j].PhoneS>a[j+1].PhoneS then begin

      tr:=a[j+1];

      a[j+1]:=a[j];

      a[j]:=tr;

     end;

     end;

     for i:=1 to c do begin

     writeln;

     write(a[i].SurnameS);

     write(' ',a[i].NameS);

     write('',a[i].PhoneS);

     write('',a[i].AddressS);

     end;

     Close(PhoneF);

     writeln;

     writeln;

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

     ReadKey;

     end;

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

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

     2. Сортировать по Фамилии - вызывает процедуру SortSurname;

     3. Сортировать по адресу - вызывает процедуру SortAddress;

     4. Сортировать по номеру телефона - вызывает процедуру SortPhone;

     5. Возврат в главное меню - возвращается к главному меню;

     procedure SortType;

     var b: integer;

     begin

     repeat

      begin

      ClrScr;

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

       writeln;

      writeln('1. Не сортировать');

      writeln('2. Сортировать по Фамилии');

      writeln('3. Сортировать по адресу');

      writeln('4. Сортировать по номеру телефона');

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

      writeln('5. Возврат в главное меню');

      writeln;

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

       readln(b);

      case b of

      1 : WritePhone;