Program Spravo4nik;
Uses CRT;
Type user = record
             num: String;
             god: Word;
             fam: String;
             adr: String;
             dlg: Word;
             end;
Const fl = 'USERS.DAT';
Var f: File of user;
     a: user;
     c: Char;

Procedure AddUser;
Begin
Repeat
ClrScr;
Writeln('Добавление нового пользователя');
Write('Введите фамилию пользователя: '); Readln(a.fam);
Write('Введите номер телефона: '); Readln(a.num);
Write('Введите год установки телефона: '); Readln(a.god);
Write('Введите адрес проживания абонента: '); Readln(a.adr);
Write('Введите задолженность абонента (без "-"): '); Readln(a.dlg);
Write('Данные введены верно? Нажмите ENTER');
c := Readkey;
Until c = #13;
Assign(f, fl);
{$I-}
ReSet(f);
{$I+}
IF IOResult <> 0 THEN ReWrite(f);
Seek(f, FileSize(f));
Write(f, a);
Close(f);
End;

Procedure PrintFile;
Begin
ClrScr;
Assign(f, fl);
{$I-}
ReSet(f);
{$I+}
If IOResult <> 0 Then
    Begin
    Writeln('Файл не найден');
    Exit;
    End;
While Not EoF(f) do
       Begin
       Read(f,a);
       Write('Фамилия: ',a.fam,' (',a.num,')',#13#10);
       End;
ReadKey;
End;

Procedure ClearFile;
Begin
ClrScr;
Write('Нажмите ENTER для очистки или любую клавишу для отмены');
c := ReadKey;
If (c = #13) then
    Begin
    Assign(f, fl);
    ReWrite(f);
    Close(f);
    Writeln('Файл очищен');
    End
Else Writeln('Отменено пользователем');
ReadKey;
End;

Procedure SearchNumber;
Var s: String;
     flag: Boolean;
Begin
ClrScr;
flag := False;
Write('Введите фрагмент фамилии абонента: '); Readln(s);
Assign(f, fl);
{$I-}
ReSet(f);
{$I+}
If IOResult <> 0 Then
    Begin
    Writeln('Файл не найден');
    Exit;
    End;
While Not EoF(f) do
       Begin
       Read(f,a);
       If (Pos(s,a.fam)<>0) then
          Begin
          flag := True;
          Write(a.fam,' -- ',a.num,#13#10);
          End;
       End;
If (flag = False) then Writeln('Ничего не найдено');
Readkey;
End;

Procedure SearchAdress;
Var s: String;
     flag: Boolean;
Begin
ClrScr;
flag := False;
Write('Введите номер абонента: '); Readln(s);
Assign(f, fl);
{$I-}
ReSet(f);
{$I+}
If IOResult <> 0 Then
    Begin
    Writeln('Файл не найден');
    Exit;
    End;
While Not EoF(f) do
       Begin
       Read(f,a);
       If (a.num = s) then
          Begin
          flag := True;
          Write(a.adr,#13#10);
          End;
       End;
If (flag = False) then Writeln('Ничего не найдено');
Readkey;
End;

Procedure PrintUsers;
Var flag: Boolean;
Begin
ClrScr;
Assign(f, fl);
{$I-}
ReSet(f);
{$I+}
If IOResult <> 0 Then
    Begin
    Writeln('Файл не найден');
    Exit;
    End;
While Not EoF(f) do
       Begin
       Read(f,a);
       If (a.dlg > 0) then
          Begin
          flag := True;
          Write(a.fam,' (Долг ',a.dlg,')',#13#10);
          End;
       End;
If (flag = False) then Writeln('Должников не найдено');
Readkey;
End;

Procedure Menu;
Begin
Repeat
ClrScr;
Writeln('[0] Вывести содержимое справочника');
Writeln('[1] Добавить нового пользователя');
Writeln('[2] Обнулить файл');
Writeln('[3] Найти номер по фамилии');
Writeln('[4] Найти адрес по номеру');
Writeln('[5] Вывести список должников');
Writeln('[ESC] Выход');
c := ReadKey;
Case c of
'0': PrintFile;
'1': AddUser;
'2': Clearfile;
'3': SearchNumber;
'4': SearchAdress;
'5': PrintUsers;
End;
Until c = #27;
End;

Begin
ClrScr;
Menu;
End.