7.6 Пример программы

В приведенном ниже примере реализована программа «Телефонный справочник», отвечающая требованиям к данной лабораторной работе (п. 7.3). Программа подробно прокомментирована, поэтому не нуждается в дополнительных пояснениях. Рекомендуется тщательным образом проанализировать предлагаемый пример, поскольку в нем найдутся ответы на многие вопросы, которые, несомненно, возникнут при выполнении работы.

programPhoneBook;{Программа "Телефонная книга"}

const

AFileName = 'phones.spr'; {Имя файла}

MaxRecordCount = 100; {Максимальное число записей в справочнике}

type

TFam = string[20];{Объявление типа "фамилия абонента"}

{Описание записи из телефонной книги}

TPhoneRec = record

Fam: TFam; {фамилия абонента}

Phone: string[15]; {телефон абонента}

Pol: Boolean; {пол абонента TRUE-муж, FALSE-жен}

BirthYear: Word; {год рождения}

end;

{Объявление типа-массива записей телефонной книги}

TPhoneTable = array[1..MaxRecordCount] of TPhoneRec;

{Процедура выполняет загрузку справочника из файла}

procedure LoadFromFile(var ATable: TPhoneTable; var ACount: Integer);

var

F:fileofTPhoneRec;{Объявляем файловую переменную}

begin

Assign(F, AFileName); {Инициализируем файловую переменную}

{$I-} {Отключаем генерацию ошибок ввода/вывода}

Reset(F); {Открываем файл для чтения}

{$I+} {Возвращаем директиву "I" в исходное состояние}

ifIOResult = 0then{Если файл успешно открыт}

begin{то считываем из него записи}

ACount := 0; {Обнуляем счетчик записей}

whilenotEof(F)do{Пока не достигнут конец файла...}

begin

Inc(ACount); {Увеличиваем ACount на единицу }

Read(F, ATable[ACount]); {Считываем запись из файла}

end;

Close(F); {Закрываем файл}

Writeln('Spravochnik uspeshno zagruzhen iz faila: ', AFileName,

'. Kolichetvo zapisei: ', ACount);

endelse{Иначе выводим сообщение "Файл не найден!"}

Writeln('ERROR: Fail ne naiden!');

end;

{Процедура выполняет сохранение справочника в файл}

procedure SaveToFile(const ATable: TPhoneTable; const ACount: Integer);

var

F: file of TPhoneRec; {Объявляем файловую переменую}

I: Integer;

begin

Assign(F, AFileName); {Инициализируем файловую переменную}

Rewrite(F); {Открываем файл для записи}

for I := 1 to ACount do {Цикл перебора записей}

Write(F, ATable[I]); {Сохраняем запись в файл}

Close(F); {Закрываем файл}

Writeln('Spravochnik uspeshno sohranen v fail: ', AFileName);

end;

{Процедура выводит на экран запись с указанным номером}

procedure ShowRecord(const ATable: TPhoneTable; Num: Integer);

var

ARec: TPhoneRec;

C: Char;

begin

ARec := ATable[Num];

if ARec.Pol then {if ARec.Pol = True}

C := 'm'

else

C := 'f';

Writeln('No', Num, ': Fam=', ARec.Fam, ', Tel=',

ARec.Phone, ', Pol=', C, ', God rozhd=', ARec.BirthYear);

end;

{Процедура выводит на экран список всех записей}

procedure ShowAllRecords(const ATable: TPhoneTable;

const ACount: Integer);

var

I: Integer;

begin

Writeln('Spisok vseh zapisei:');

for I := 1 to ACount do

ShowRecord(ATable, I);

end;

{Процедура добавления новой записи в справочник}

procedure AddNewRecord(var ATable: TPhoneTable; var ACount: Integer);

var

ARec: TPhoneRec;

C: Char;

begin

Write('Vvedite familiu: ');

Readln(ARec.Fam);

Write('Vvedite telefon: ');

Readln(ARec.Phone);

Write('Vvedite pol ("m" / "f"): ');

Readln(C);

if C = 'm' then

ARec.Pol := True {Мужчина}

else { if C = 'f' }

ARec.Pol := False; {Женщина}

Write('Vvedite god rozhdenia: ');

Readln(ARec.BirthYear);

Inc(ACount); {Увеличиваем счетчик записей на 1}

ATable[ACount] := ARec; {Записываем запись ARec в массив ATable}

Write('Dobablena zapis: ');

ShowRecord(ATable, ACount); {Печатаем запись на экран}

end;

{Процедура отыскивает запись по заданной фамилии и печатает на экране}

procedure FindRecord(const ATable: TPhoneTable; const ACount: Integer);

var

I: Integer;

IsFind: Boolean;

Fam: TFam;

begin

Write('Vvedite familiu: ');

Readln(Fam);

IsFind := False; {Сбрасываем флаг перед поиском}

for I := 1 to ACount do

if ATable[I].Fam = Fam then

begin

IsFind := True; {Устанавливаем флаг "Успешный поиск"}

Write('Zapis naidena: ');

ShowRecord(ATable, I);

Break; {Выход из цикла}

end;

ifnotIsFindthen{Если запись не найдена}

Writeln('Zapis ne naidena!');

end;

var

MenuNum: Byte;

PhoneTable: TPhoneTable; {Переменная-справочник}

PhoneCount: Integer; {Текущее количество записей в справочнике}

begin

PhoneCount := 0; {При запуске программы справочник еще пуст}

Writeln('Telefonnaya kniga. Avtor: Ivanov I.I');

repeat

Writeln('Vvedite cifru dlya vypolneniya deistviya:');

Writeln('1 - zagruzka spravochnika iz faila');

Writeln('2 - novaya zapis');

Writeln('3 - spisok vseh zapisei');

Writeln('4 - poisk zapisi po familii');

Writeln('5 - sohranenie spravochnika v fail');

Writeln('6 - vyhod iz programmy');

Write('> ');

Readln(MenuNum);

case MenuNum of

1: LoadFromFile(PhoneTable, PhoneCount);

2: AddNewRecord(PhoneTable, PhoneCount);

3: ShowAllRecords(PhoneTable, PhoneCount);

4: FindRecord(PhoneTable, PhoneCount);

5: SaveToFile(PhoneTable, PhoneCount);

end;

untilMenuNum = 6;

end.

Следует отметить, что благодаря разбивке программного кода на подпрограммы, основная часть программы оказалась очень простой. Несмотря на «солидный» размер (более 150 строк кода), разобраться в данном примере не составит чрезмерных трудностей (при условии последовательного выполнения всех предыдущих лабораторных работ).