Здравствуйте, BlackCanary. С Новым годом!
Текст программы в приложении. Turbo Pascal. Порядок работы такой. Сначала файл должен быть создан (п.1). Перед выполнением операций (добавление, поиск, печать) файл должен быть предварительно один раз открыт. Реализовано добавление, а также оба поиска. Нет проверок на уникальность фамилий, комнат и телефонов.
Будут вопросы - обращайтесь.


Приложение:
{
Предприятие имеет местную телефонную станцию на 20 номеров.
Телефонный справочник данного предприятия для каждого номера
телефона содержит номер помещения и список служащих, сидящих в данном помещении.

Составить программу, которая:
Корректирует базу;
По номеру телефона выдает номер помещения и список сидящих в нем людей;
По номеру помещения выдает номер телефона;
По фамилии выдает номер телефона и номер помещения.
Номер телефона-двузначный.
В одном помещении может находиться от одного до четырех служащих.
}
program p175664;

uses
crt;

const
MaxRoom = 20;
MinPhone = '01';
MaxPhone = '99';
MaxCapacity = 4;

Type
TRecNo = LongInt;
TRoomNo = 1..MaxRoom;
TPhone = string[2];
TPerson = string[10];
TPersons = array[1..MaxCapacity] of TPerson;
TRoom = record
RoomNo: TRoomNo;
phone: TPhone;
persons: TPersons;
end;
TFunc = function(rec, etalon: TRoom): boolean;
TRoomFile = file of TRoom;
var
iChoice : integer;
fH: TRoomFile;
IsOpen: boolean;
SearchFunc : TFunc;
etalon, FoundRoom: TRoom;
FoundRec: TRecNo;
i, j: integer;

procedure Create( var fH: TRoomFile ); forward; { Создание файла }
procedure Input( var fH: TRoomFile ); forward; { Ввод данных }
procedure Menu; forward;
procedure Open( var fH: TRoomFile ); forward; { Открытие файла }
procedure Print( var fH: TRoomFile ); forward; { Вывод данных }
procedure SayGoodBye; forward; { Выход }
function Search( var fH: TRoomFile; f: TFunc; etalon: TRoom; var r: TRoom ): TRecno; forward; { Поиск по условию }

{$F+}
function SearchName( rec, etalon: TRoom ): boolean; forward; { Поиск по фамилии }
{$F-}

{$F+}
function SearchPhone( rec, etalon: TRoom ): boolean; forward; { Поиск по номеру телефона }
{$F-}

procedure Create( var fH: TRoomFile );
var
fName: string; { имя файла }
begin
{ если открыт, закроем }
if IsOpen then begin
Close( fH );
IsOpen := false;
end;

write('Полный путь к файлу :');
readln(fName);

{$I-}
Assign(fH, fName);
Rewrite(fH);
{$I+}
if (IOResult <> 0) then
Writeln('Файл уже существует')
else
begin
IsOpen := true;
Writeln('Файл успешно создан');
end;
readln;
end; { Create }

procedure Input( var fH: TRoomFile );
var
r: TRoom;
count: integer;
i: integer;
begin
write('Комната: ');
readln(r.RoomNo);
write('Телефон: ');
readln(r.phone);
for i:= 1 to MaxCapacity do
begin
write('ФИО: ');
readln(r.persons[i]);
end;

seek( fH, FileSize( fH ) );
write( fH, r );
readln;
end; { Input }

procedure Menu;
begin
clrscr;
Writeln( ' 0: Выход' );
Writeln( ' 1: Создание файла' ); { Создание файла }
Writeln( ' 2: Открытие файла' ); { Открытие файла }
Writeln( ' 3: Ввод данных' ); { Ввод данных }
Writeln( ' 4: Печать файла' ); { Вывод данных }
Writeln( ' 5: Поиск по номеру телефона' ); { Поиск по номеру телефона }
Writeln( ' 6: Поиск по фамилии' ); { Поиск по фамилии }
Write( ' Выбран пункт:');

end; { Menu }

procedure Open( var fH: TRoomFile );
{ Открытие файла }
var
fName: string; { имя файла }
begin
{ если открыт, закроем }
if IsOpen then begin
Close( fH );
IsOpen := false;
end;

write('Полный путь к файлу:');
readln(fName);

{$I-}
Assign(fH, fName);
Reset(fH);
{$I+}
if ((IOResult <> 0) or (fName = '')) then
Writeln('Файл не существует')
else
begin
IsOpen := true;
Writeln('Файл успешно создан');
end;
readln;
end; { Open }

procedure Print( var fH: TRoomFile );
{ Вывод данных }
var
r: TRoom;
i: integer; { счетчик записей }
j: integer; { счетчик сотрудников }
begin
write( '----------------');
for j:= 1 to MaxCapacity do
write( '-------------');
writeln;

write( 'Комната Телефон' );
for j:= 1 to MaxCapacity do
write( ' Сотрудник ', j, ' ');
writeln;

write( '-----------------');
for j:= 1 to MaxCapacity do
write( '-------------');
writeln;

seek(fH, 0);
i := 0;
while not( eof( fH ) ) do
begin
read( fH, r );
inc( i );
write( r.RoomNo:7, r.Phone:7);
for j:= 1 to MaxCapacity do
write( r.persons[j]: 13);
writeln;
if i mod 10 = 0 then readln; { 10 в списке }
end; { while }
readln;
end; { Print }

procedure SayGoodBye;
{ Выход }
begin
writeln( 'Удачи!' );
readln;
end; { SayGoodBye }


function Search( var fH: TRoomFile; f: TFunc; etalon: Troom; var r: TRoom): TRecno;
{ Поиск }
var
rec: TRoom;
i: LongInt;
found : boolean;
begin
seek(fH, 0);
i:= 0;
found := false;
while not (eof(fH)) and (not(found)) do
begin
read(fH, rec);
if f(rec, etalon) then
found := true;
inc(i);
end;
if found then
begin
r := rec;
search := i-1;
end
else
search := -1;
end; { Search }

{$F+}
function SearchName( rec, etalon: TRoom ): boolean;
var
i: 0..MaxCapacity;
found : boolean;
begin
i:= 0;
found := false;
while (i<= MaxCapacity) and not(found) do
begin
inc(i);
if rec.persons[i]=etalon.persons[1] then
found := true;
end;
SearchName := found;
end; { SearchName }
{$F-}

{$F+}
function SearchPhone( rec, etalon: TRoom ): boolean;
begin
SearchPhone := rec.phone=etalon.phone;
end; { SearchPhone }
{$F-}

begin { Main }
iChoice := 0;
IsOpen := false;
while true do begin
Menu;
Readln( iChoice );

case iChoice of
0: begin
if IsOpen then
Close( fH );
SayGoodBye;
exit
end;
1: Create( fH ); { Создание файла }
2: Open( fH ); { Открытие файла }
3: Input( fH ); { Ввод данных }
4: Print( fH ); { Вывод данных }
5:
begin
etalon.phone := '99';
write('Телефон: ');
readln(etalon.phone);
if (etalon.phone>'00') and (etalon.phone<'99') then
begin
FoundRec := Search( fH, SearchPhone, etalon, FoundRoom);
if FoundRec <> -1 then
begin
write('Комната: ', FoundRoom.RoomNo);
for j:= 1 to MaxCapacity do
write(FoundRoom.persons[j], ';');
writeln;
end
else
writeln('Телефон не найден');
end
else
writeln('Неверный формат номера');
readln;
end;

6:
begin
etalon.persons[1] := '$';
write('ФИО :');
readln(etalon.persons[1]);
if etalon.persons[1]<>'$' then
begin
FoundRec := Search( fH, SearchName, etalon, FoundRoom);
if FoundRec <> -1 then
writeln('Комната: ', FoundRoom.RoomNo, ' Телефон: ', FoundRoom.Phone)
else
writeln('Сотрудник не найден');
end
else
writeln('Неверный формат фамилии');
readln;
end;

end; { case }
end; { while }
end.