Program Task;
Const n=30;
Type Rec=Record {Запись}
surname : String; {Фамилия}
phone : String; {Телефон}
End; List=Array [1..n] Of Rec;
Var A : List;
s : String;
Procedure Init(Var X : List; Var k: Byte);
Var f : Text;
s : String;
Begin
Assign(f, 'C:\Documents and Settings\Администратор\Рабочий стол\готовые\Output_a.txt');
ReSet(f);
k := 0;
While Not Eof(f) Do Begin
Inc(k);
With X[k] Do Begin
ReadLn(f, surname);
ReadLn(f, s);
End;
End;
Close(f);
End;
Procedure Solve_a(X : List; s : String);
Var i : Byte;
f : Text;
Begin
Assign(f, 'C:\Documents and Settings\Администратор\Рабочий стол\готовые\Output_a.txt');
Rewrite(f);
i := 1;
While (i<=n) And (X [i] . surname<>s) Do Inc(i);
If i>n Then WriteLn(f, 'Такого человека в записной книге нет')
Else WriteLn(f, s, ' имеет телефон ', X[i].phone);
Close (f) ;
End;
Procedure Init(Var X : List);
Var f : Text;
k : Byte;
Begin
Assign(f,'C:\Documents and Settings\Администратор\Рабочий стол\готовые\Output_a.txt');
ReSet (f);
For k := 1 To n Do
With X[k] Do Begin
ReadLn(f, phone);
ReadLn(f, surname);
End;
Close(f) ;
End;
Procedure Solve_b(X : List; s : String);
Var i : Byte;
f : Text;
Begin
Assign(f, 'C:\Documents and Settings\Администратор\Рабочий стол\готовые\Output_a.txt');
Rewrite(f); i := 1;
While (i<=n) And (X [i] .phone<>s) Do Inc(i);
If i>n Then WriteLn(f, 'Такого телефона в записной книге нет' )
Else WriteLn(f, 'Телефон ', s, ' имеет ', X[i].surname);
close(f);
End;
Begin
Init(A);
WriteLn('Введите фамилию ');
ReadLn(s) ;
Solve_a(A, s);
WriteLn('Введите телефон в формате **-**-**');
ReadLn(s);
Solve_b(A, s);
ReadLn;
End.