Программа

{ ВоенМех 
  Телефонная книга }
Program TelephoneBook;
Uses Crt;                                   { Подключение модуля Crt }
Const FileName='TELEPHON.DAT';              { Имя внешнего файла }
Type SubscriberType=record                  { Тип "Абонент" }
                      Name:string[10];        { Фамилия абонента }
                      year:word;              { Год подключения }
                      Number:longint          { Номер абонента }
                    end;
Var Subscriber:SubscriberType;      { Переменная "Абонент" }
    F: file of SubscriberType;      { Файл абонентов }
    Exit:Boolean;                   { Флаг выхода }
Procedure Stop;                     { Процедура остановки программы }
  Begin
    WriteLn;                        { Пропуск строки }
    Write('Нажмите [Enter]');       { Вывод приглашения нажать "Enter" }
    ReadLn                          { Остановка программы до нажатия "Enter" }
  End;
Function Question(Str:string):boolean; { Функция получения ответа на вопрос }
  var Answer:Char;                     { Переменная для ответа на вопрос }
  Begin
    Write(Str);                      { Вывод вопроса }
    repeat
      Answer:=ReadKey;                 { Получение ответа }
      Question:=Answer in ['Y','y']    { Определение значения функции }
    until Answer in ['Y','y','N','n']; { Выход из цикла при получении
                                         корректного ответа }
    WriteLn(Answer)                     { Печать полученного ответа }
  End;
Procedure MakeFile;                     { Процедура создания файла }
  var i:byte;                           { Счетчик }
  Begin
    ClrScr;                                      { Очистка экрана }
    Rewrite(F);                                  { Открытие файла под запись }
    while Question('Создать запись ? [Y/N] ') do { Цикл ввода записей }
      begin
        Write('Фамилия       ');  { Вывод приглашения ввести фамилию }
        with Subscriber do
          begin
           ReadLn(Name);                                      { Ввод фамилии }
           while Length(Name)<10 do Name:=Name+' ';
                                  { Цикл добавления пробелов в конец фамилии }
            Write('Год установки ');{ Вывод приглашения ввести год установки }
            ReadLn(Year);           { Ввод года установки }
            Write('Номер         ');{ Вывод приглашения ввести номер }
            ReadLn(Number)          { Ввод номера }
          end;
        Write(F,Subscriber);        { Запись в файл }
        WriteLn                     { Пропуск строки }
      end;
    Close(F);                       { Закрытие файла }
  End;
Function Menu:Char;                 { Функция вывода меню и получения ответа }
  var Answer:Char;                  { Переменная для ответа на меню }
  Begin
    ClrScr;                         { Очистка экрана }
    { Вывод меню: }
    WriteLn('[0] Выход');
    WriteLn('[1] Просмотр файла');
    WriteLn('[2] Номер по фамилии ');
    WriteLn('[3] Количество телефонов ');
    repeat
      Answer:=ReadKey              { Чтение клавиатуры }
    until Answer in ['0'..'3'];
                           { Выход из цикла при получении корректного ответа }
    Menu:=Answer
  End;
Procedure OutFile;         { Процедура вывода файла }
  Begin
    ClrScr;                                        { Очистка экрана }
    WriteLn(' ФАМИЛИЯ    ГОД УСТАНОВКИ    НОМЕР'); { Вывод шапки }
    Reset(F);                                    { Открытие файла для чтения }
    while not EOF(F) do                          { Цикл просмотра файла }
      begin
        Read(F,Subscriber);                      { Чтение записи }
        with Subscriber do WriteLn(Name:10,Year:10,Number:15); { Ввод записи }
      end;
    Close(F);                       { Закрытие файла }
    Stop                            { Остановка программы }
  End;
Procedure SubscriberNumber;               { Процедура поиска номера }
  var Name:string[10];                    { Фамилия }
      Flag:boolean;                       { Флаг "Фамилия найдена" }
  Begin
    ClrScr;                               { Очистка экрана }
    Write('Введите фамилию ');            { Вывод приглашения ввести фамилию }
    ReadLn(Name);                         { Ввод фамилии }
    while Length(Name)<10 do Name:=Name+' ';
                                  { Цикл добавления пробелов в конец фамилии }
    Flag:=false;                  { Сброс флага }
    Reset(F);                     { Открытие файла для чтения }
    while not EOF(F) do           { Цикл просмотра файла }
      begin
        Read(F,Subscriber);       { Чтение записи }
        if Subscriber.Name=Name   { Если найдено искомое имя }
          then begin              { то }
                 WriteLn(' ',Subscriber.Number); { ввод номера }
                 Flag:=true                      { подъем флага }
               end
      end;
    Close(F);                       { Закрытие файла }
    if not Flag then WriteLn(' ФАМИЛИЯ ОТСУТСТВУЕТ !');
                                    { Если флаг опущен, то - вывод сообщения }
    Stop                            { Остановка программы }
  End;
Procedure MeterNumber;                    { Процедура подсчета телефонов }
  var Year:word;                          { Переменная "Год" }
      Meter:word;                         { Счетчик телефонов }
  Begin
    ClrScr;                               { Очистка экрана }
    Write('Введите год ');                { Вывод приглашения ввести год }
    ReadLn(Year);                         { Ввод года }
    Meter:=0;                             { Сброс счетчика телефонов }
    Reset(F);                             { Открытие файла для чтения }
    while not EOF(F) do                   { Цикл просмотра файла }
      begin
        Read(F,Subscriber);      { Чтение записи }
        if Subscriber.Year>=Year { Если телефон установлен с заданного года }
          then Meter:=Meter+1    { то - учет данной записи }
      end;
    Close(F);                    { Закрытие файла }
    WriteLn('Количество телефонов установленных с ',Year,' года: ',Meter);
                                                              { Вывод ответа }
    Stop                            { Остановка программы }
  End;
BEGIN
  ClrScr;                    { Очистка экрана }
  Assign(F,FileName);        { Связывание файловой переменной с именем файла }
  if Question('Создать новый файл '+FileName+'?  [Y/N]  ') then MakeFile;
                             { Если ответ - "Да", то - создание нового файла }
  Exit:=false;               { Сброс флага "Выход" }
  repeat
    case Menu of             { Выбор действия по ответу на меню }
      '0':Exit:=true;            { Установка флага "Выход" }
      '1':OutFile;               { Печать файла }
      '2':SubscriberNumber;      { Поиск номера телефона }
      '3':MeterNumber            { Подсчет количества телефонов }
    end
  until Exit
END.