База данных "Учебная нагрузка группы"

program PhoneBook; {Программа "Телефонная книга"}
 
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: file of TPhoneRec; {Объявляем файловую переменную}
begin
  Assign(F, AFileName); {Инициализируем файловую переменную}
  {$I-}     {Отключаем генерацию ошибок ввода/вывода}
  Reset(F); {Открываем файл для чтения}
  {$I+}     {Возвращаем директиву "I" в исходное состояние}
  if IOResult = 0 then {Если файл успешно открыт}
  begin {то считываем из него записи}
    ACount := 0; {Обнуляем счетчик записей}
    while not Eof(F) do {Пока не достигнут конец файла...}
    begin
      Inc(ACount); {Увеличиваем ACount на единицу }
      Read(F, ATable[ACount]); {Считываем запись из файла}
    end;
    Close(F); {Закрываем файл}
    Writeln('Spravochnik uspeshno zagruzhen iz faila: ', AFileName,
      '. Kolichetvo zapisei: ', ACount);
  end else {Иначе выводим сообщение "Файл не найден!"}
    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;
 
  if not IsFind then {Если запись не найдена}
    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;
  until MenuNum = 6;
end.