Составить программу, которая заполняет и (или) корректирует данные о жильцах и по фамилии определяет номер, где проживает жилец.

type BazSam = record
  ImTip,FamKonstr: string;
  Year,KolKres,Gruz: integer;
  end;
 
Procedure ramki (x1,y1,x2,y2,cf,ct:byte; zag:string);
 begin
writeln(zag);
end;
 
Procedure menu (x1,y1,x2,y2,cf,ct:byte; zag:string; var v:Byte);
begin
  ramki(x1,y1,x2,y2,cf,ct,zag);
  writeln('Sozdat bazu dannix - 1');
  writeln('Posmotret bazu dannix - 2');
  writeln('Sdelat viborku v baze - 3');
  writeln('Naiti informaciu v baze - 4');
  writeln('vixod - 5');
  readln(v);
end;
 
Procedure ProvName ( var name:string; var fe:boolean);
Var f1:text;
begin
     Writeln('Vvedite imja bazi v formate name.txt');
     readln (name);
     assign (f1, name);
     reset (f1);
end;
 
Procedure sozdbd(name:string);
var y1,x1,x2,y2,cf,ct:byte;
f1:text;
g:integer;
s,zag:string;
 begin
 Assign(f1,name);
 Rewrite(f1);
 g:=1;
 write(f1,'tip':5);
 write(f1,'Famila konstruktora':28);
 write(f1,'god vipuska':15);
 write(f1,'koli4. Kresel':17);
 writeln(f1,'Gruzopodemnost':19);
 while g<>0 do begin
                 Writeln('vvedite tip');
                 readln(s);
                 write(f1,s:5);
                 Writeln('vvedite Familiu konstruktora');
                 readln(s);
                 write(f1,s:28);
                 Writeln('vvedite God vipuska');
                 readln(s);
                 write(f1,s:15);
                 Writeln('vvedite koli4. Kresel');
                 readln(s);
                 write(f1,s:17);
                 Writeln('vvedite Gruzopodemnost');
                 readln(s);
                 writeln(f1,s:19);
                 writeln('Esho odin samoliot? 1-Yes 0-No');
                 read(g);{
                 x1:=10; y1:=5; x2:=70; y2:=20;
                 ct:=0;
                 cf:=7;
                 zag:='';
                 ramki(x1,y1,x2,y2,cf,ct,zag);}
               end;
 close(f1);
end;
 
 
  var
  fe:boolean;
  name,zag:string;
  y1,x1,x2,y2,cf,ct,v,r:byte;
begin
   x1:=10; y1:=5; x2:=70; y2:=20;
  ct:=0;
  cf:=7;
  zag:='Zadanie';
  ramki(x1,y1,x2,y2,cf,ct,zag);
  Writeln('Razrabotat programmu obrabotki baz dannix samoliotov');
  Writeln('nazmite Enter dla prodolshenia');
  readln;
  while v<>5 do
    begin
     x1:=10; y1:=5; x2:=70; y2:=20;
     ct:=0;
     cf:=7;
     zag:='';
     menu(x1,y1,x2,y2,cf,ct,zag,v);
     If v=1 then
       begin
         x1:=10; y1:=5; x2:=70; y2:=20;
         ct:=0;
         cf:=7;
         ramki(x1,y1,x2,y2,cf,ct,zag);
         While r<>1 do
         begin
           ProvName(name,fe);
           If fe=false then r:=1
           else begin
                 writeln('takaia baza ushe est. Zamenit? 1-Yes 0-No');
                 readln(r);
                end;
         end;
         x1:=10; y1:=5; x2:=70; y2:=20;
         ct:=0;
         cf:=7;
         ramki(x1,y1,x2,y2,cf,ct,zag);
         Sozdbd(name);
       end;
    end;
end.

var
  mas1: array[0..4] of string;  //  Жильцы по одноместным номерам
  mas2: array[0..1, 0..9] of string;  //  Жильцы по двухместным номерам
  s: string;
  nom: byte;  //  Выбор меню
 
function Dos(mes:string): string;  //  Перекодировка OEM->ANSI, что бы не было кракозябров после ввода строки
begin
  SetLength(Result, Length(mes));  // Устанавливаем длину выходной строки равной входящей
  if Length(Result)> 0 then  //  Если длина больше 0 перекодируем строку OemToAnsi(PChar(mes), PChar(Result));
end;
 
 
procedure Zag;  // Процедура загрузки данных из файла
var
  f: Text;
  i, j:
integer;
    s0, s1: string;
begin
  if not
FileExists('Gostin.txt') then  //  Проверяем существование файла
 
  begin
       writeln('Файла Gostin.txt не существует');
    Exit;  //  Выход из процедуры
    end;
  Assign(f,'Gostin.txt');   //  Связали файловую переменную с файлом
 
Reset(f);  //  Встали на начало файла
  Readln(f, s0);  //  Считываем одну строку
  for i:= 0 to 4 do  //  Загружаем данные по одноместным номерам
    begin
      Readln(f, s0);  //  Считываем строку
 
delete(s0, 1, 2);  //  Удаляем первые два символа
      mas1[i]:= s0;  // Записали в массив
    end;
  Readln(f, s0);  //  Считали строку
 
 for i:= 0 to 9 do  //  Загружаем данные по двухместным номерам
 
begin
     Readln(f, s0);  //  Считали строку
      While s0[1] <> ' ' do  //  Делаем пока не дойдём до пробела
 
delete(s0, 1, 1);  //  Удаляем первый символ
    delete(s0, 1, 1);  // Удаляем первый символ
     s1:= '';
      for j:= 1 to
Length(s0) do
       if s0[j] <> ',' then
 
s1:= s1 + copy(s0, j, 1)  //  Копируем символы пока не дойдём до символа ,
      else
          break;  //  Досрочный выход из цикла
 
mas2[0, i]:= s1;  //  Записали в массив строку
      While s0[1] <> ',' do //  Удаляем первый символ пока не дойдём до символа ,
 
   delete(s0, 1, 1);
    delete(s0, 1, 1);  //  Удаляем первый символ
    mas2[1, i]:= s0;  //  Записали строку в массив
    end;
 
Close(f);  //  Закрыли файл
end;
 
 
procedure Find;  // Процедура поиска жильца
var
    s0, s1: string;
  i: integer;
  fnd: boolean;
begin
  fnd:= false;
    for i := 0 to 4 do  // Ищем по одноместным номерам
    if (Pos(s, mas1[i]) <> 0) AND ((mas1[i][length(s) + 1] = ' ') OR (length(mas1[i]) = length(s)) OR (mas1[i][length(s) + 1] = '.')) then
    {Нашли вхождение фамилии в массиве}
      begin
    if fnd then
       begin
          writeln('Таких жильцов несколько! Введите инициалы жильца');
        readln(s0);  // Запомнили введёные данные с клавиатуры
        s0:= dos(s0);  // Перекодировали строку
           s:= s + ' ' + s0;  //  Добавили к фамилии инициалы
        Find;  //  Запуск процедуры поиска с начала
        exit;  //  Выход из процедуры
         end;
 
       s1:= ('Жилец с фамилией ' + s + ' проживает в номере') + IntToStr(i + 1);
        fnd:= true;
      end;
  for
i:= 0 to 9 do  //  Ищем по двухместным номерам
    begin
     if
(Pos(s, mas2[0, i]) <> 0) AND ((mas2[0, i][length(s) + 1] = '')
                              OR
(length(mas2[0, i]) = length(s))
 
          OR (mas2[0, i][length(s) + 1] = '.')) then
 
{Нашли вхождение фамилии в массиве}
     begin
          if fnd
then
          begin
           writeln('Таких жильцов несколько! Введите инициалы жильца');
          readln(s0);  // Запомнили введёные данные с клавиатуры
          s0:= dos(s0);  // Перекодировали строку
         s:= s + ' ' + s0;  // Добавили к фамилии инициалы
           Find;  //  Запуск процедуры поиска с начала
           exit;  //  Выход из процедуры
 
  end;
          s1:= ('Жилец с фамилией ' + s + ' проживает в номере ') + IntToStr(i + 6);
        fnd:= true;
 
     end;
      if (Pos(s, mas2[1, i]) <> 0) AND ((mas2[1,i][length(s) + 1] = ' ')
 
        OR (length(mas2[1, i]) = length(s))
 
                 OR (mas2[1, i][length(s) + 1] = '.'))
then
    {Нашли вхождение фамилии в массиве}
     begin
 
      if fnd then
       begin
 
writeln('Таких жильцов несколько! Введите инициалы жильца');
 
         readln(s0);  //  Запомнили введёные данные с клавиатуры
 
    s0:= dos(s0);  //  Перекодировали строку
            s:= s + ' ' + s0;  //  Добавили к фамилии инициалы
          Find;  //  Запуск процедуры поиска с начала
         exit;  //  Выход из процедуры
       end;
           s1:= ('Жилец с фамилией ' + s + ' проживает в номере ') + IntToStr(i + 6);
 
fnd:= true;
     end;
    end;
  if not fnd then
 
writeln('Жильца с фамилией ' + s + ' нет') //  Вывод результата поиска
  else
    begin
    writeln(s1);  //  Вывод результата поиска
    end;
 
end;
 
procedure spisok;
//  Процедура вывода списка всех жильцов
var
  i: integer;
begin
  writeln('Одноместные номера');
  for i:= 0 to 4 do  //  Выводим по одноместным
      writeln('#' + IntToStr(i + 1) + ' ' + (mas1[i]));
  writeln('');  //  Вывели на экран пустую строку
  writeln('Двухместные номера');
    for i:= 0 to 9 do  //  Выводим по двухместным
    writeln('#' + IntToStr(i + 6) + ' ' + (mas2[0, i]) + ',' + (mas2[1, i]));
end;
 
procedure save;  //  Процедура сохранения списка жильцов в файл
var
  f: Text;
  i: integer;
begin
 
Assign(f, 'Gostin.txt');  //  Связали файловую переменную с файлом
  Rewrite(f);  //  Открыли файл для перезаписи
  Writeln(f, '[1]');  //  Записали идентификатор одноместных номеров
  for i := 0 to 4 do  //  Записали данные по одноместным
    Writeln(f,  IntToStr(i + 1) + ' ' +  mas1[i]);
  Writeln(f, '[2]');  //  Записали идентификатор двухместных
  for i := 0 to 9 do  //  Записали данные по двухместным
    Writeln(f,  InttoStr(i + 6) + ' ' +  mas2[0, i] + ',' + mas2[1, i]);
  Close(f);  //  Закрыли файл
end;
 
procedure edit;  //  Процедура редактирования жильцов
var
    x, j: integer;
  s0, s1: string;
begin
 
writeln('Введите номер комнаты');
  readln(x);  //  Сохранили введённый номер
  if x < 6 then
     begin  //  По одноместным
    writeln('В этом номере проживают'  + mas1[x - 1]);
    writeln('Введите Фамилии и инициалы новых жильцов');
 
     readln(s0);  //  Сохранили фамилию жильца
      s0:= dos(s0);  // Перекодировали строку
     mas1[x - 1]:= s0;  //  Записали в массив
 
   end
  else
    begin  //  По двухместным
 
writeln('В этом номере проживают ' + (mas2[0, x - 6]) + ',' + (mas2[1, x - 6]));
     writeln('Введите Фамилии и инициалы новых жильцов');
      readln(s0);  //  Сохранили фамилию жильца
      s0:= dos(s0);  //  Перекодировали строку
      for j:= 1 to Length(s0) do
          if s0[j] <> ',' then
 
s1:= s1 + copy(s0, j, 1)  //  Копируем символы пока не дойдём до символа ,
      else
          break;  //  Досрочный выход из цикла
 
mas2[0, x - 6]:= s1;  //  Записали в массив
      While s0[1] <> ',' do
        delete(s0, 1, 1);  //  Удаляем первый символ пока не дойдём до символа ,
      delete(s0, 1, 1);  //  Удаляем первый символ
      mas2[1, x - 6]:= s0;  //  Записали в массив
    end;
    save;  //  Вызов процедуры сохранения списка жильцов
end;
 
procedure vubor;  //    Процедура выбора меню
begin
 
writeln('Выберите нужную операцию');
  writeln('1: Список жильцов');
  writeln('2: Изменить жильца');
 
 writeln('3: Сохранить список жильцов');
 
writeln('4: Поиск жильца');
    writeln('5: Выход');
  readln(nom);  //  Запомнили номер пункта меню
  Case
nom of  //  Выбор номера меню из списка
     1: spisok;  //  Вызов процедуры вывода списка жильцов
     2: edit;  //  Вызов процедуры редактирования списка жильцов
    3: save;  //  Вызов процедуры сохранения в файл списка жильцов
    4: begin
          writeln('Введите фамилию жильца');
         readln(s);  //  Запомнили введёную фамилию жильца
         s:= dos(s);  //  Перекодировали строку
       Find; //  Вызов процедуры вывода списка жильцов
       end;
    5: Exit; //  Выход из процедуры
  end;
  writeln('');
  vubor; //  Вызов процедуры выбора меню
end;
 
begin
  zag;  // Вызов процедуры загрузки списка жильцов
  vubor;  //  Вызов процедуры выбора меню
end.