Program DataBase;
uses crt;
Const
MaxRec=200;
Type
REC=record
     Name:string;
     Number:string[8];
    end;
aRec=array[1..MaxRec] of rec;
function get_str(max_len: byte): string;
 var s: string; ch: char;
 begin
   s := '';
   repeat
     ch := readkey;
     if length(s) <= max_len then
       case ch of
        #27: begin
                  get_str := '';
                   exit;
             end;
        #8: begin
               if length(s) > 0 then begin
                 write(#8,#32,#8);
                 delete(s, length(s), 1)
               end
            end
         else
           if length(s) <> max_len then
             begin s := s + ch; write(ch) end
       end;
   until ch = #13;
   writeln;
   get_str := s
 end;
Procedure ReadBD(var DBB:aREC);
Var
  I:byte;
  S:string;
  f:text;
Begin
  write('Enter path: (введите путь к файлу):'); readln(s);
  assign(f,s);
  {$I-} reset(f); {$I-}
  If ioresult = 0 Then begin
    for i:=1 to MaxRec do begin
      with DBB[I] do begin
        readln(f,name); readln(f,number)
      end
    end;
    close(f)
  end
else Writeln('file not found');
end;
Procedure SaveBD(DBB:aRec);
var
I:byte;
f:text;
s:string;
begin
write('Enter path: (введите путь к файлу):'); readln(s);
assign(f,s);
rewrite(f);
for i:=1 to MaxRec do
begin
 with DBB[I] do
 begin
  writeln(f,name);
  writeln(f,number)
 end
end;
close(f);
writeln('Сохраненно! нажмите любую клавишу ...');
readkey
end;
Procedure EnterBD(var DBB:aRec);
var
  i:byte;
  finished: boolean;
begin
  i:=1; finished := false;
  while (i <= maxRec) and (not finished) do
    with DBB[i] do begin
      write('Enter name:'); name := get_str(80);
      if name <> '' then begin
        write('Enter number:'); readln(number)
      end
      else finished := true;
      inc(i)
    end;
end;
Procedure PrintBD(DBB:aRec);
var i:byte;
begin
for i:=1 to MaxRec do
begin
 writeln(i,'. NAME= ',DBB[I].NAME);
 writeln('Number = ',DBB[I].NUMBER);
end;
writeln('нажмите любую клавишу ...');
readkey
end;

Procedure NAM(DBB:Arec);
var i:byte;
s:string;
begin
writeln('введите имя для поиска');
readln(s);
for i:=1 to MaxRec do if DBB[i].name=s then writeln(DBB[i].number);
writeln(' нажмите любую клавишу ...');
readkey
end;

Procedure NUM(DBB:Arec);
var i:byte;
s:string[8];
begin
writeln('введите номер для поиска');
readln(s);
for i:=1 to MaxRec do if DBB[i].number=s then writeln(DBB[i].name);
writeln('нажмите любую клавишу ...');
readkey
end;


var
c:byte;
a:ARec;
Begin
repeat
 Clrscr;
 writeln('Что сделать?'); writeln;
 writeln('1. Ввод базы вручную');
 writeln('2. ввод базы из файла');
 writeln('3. сохранение базы в файле');
 writeln('4. Вывод базы на экран');
 writeln('5. поиск по имени');
 writeln('6. Поиск по номеру'); writeln;
 writeln( 'Для выхода - нажмите Esc!');
 c:=ORD(readkey);
 case c of
  49: EnterBD(A);
  50: ReadBD(a);
  51: SaveBD(a);
  52: PrintBD(A);
  53: NAM(A);
  54: NUM(A);
 end;
 Until c=27;
end.