uses crt;
type
sp=^kniga;
kniga= record
fio: string[50];
adres:string;
tel:longint;
l:sp;
end;
var
ff: file of kniga;
bf: kniga;
top,p,t,n:sp;
fio,ffio:string[50];
adres,fadres:string;
y,k:integer;
tel,ftel:longint;
r:real;
flag:integer;
{процедура создания файла}
procedure pr(var top:sp);
var
p,t,n:sp;
fio:string[50];
adres:string;
tel:longint;
begin
assign(ff,'kniga.dat');
rewrite(ff);
reset(ff);
if flag=0 then
begin
top:=nil;
flag:=1;
end;
clrscr;
repeat
write('BB fio - '); readln(bf.fio);
if length(fio)<>0 then
begin
write(' BB adres - '); readln(bf.adres);
write(' BB tel - '); readln(bf.tel);
read(ff,bf);
close(ff);
new(n);
n^.adres:=adres;
n^.fio:=fio;
n^.tel:=tel;
n^.l:=nil;
t:=top;
p:=nil;
while (t<>nil) and (fio>t^.fio) do
begin
p:=t; t:=t^.l;
end;
if p=nil then begin
n^.l:=top; top:=n;
end
else begin
n^.l:=p^.l; p^.l:=n;
end;
end;
until length(fio)=0;
t:=top;
clrscr;
writeln('spisok');
while t<>nil do begin
write( t^.fio,' ');
write( t^.adres,' ');
writeln( t^.tel,' ');
t:=t^.l;
end;
readln;
end;
{процедура удаления файла}
procedure pdelete(var top:sp);
var
p,t,n:sp;
ffio,fio:string[50];
fadres:string;
ftel:longint;
f:real;
begin
f:=0;
t:=top;
clrscr;
writeln('кого удалить? (fio,adres,tel) ');
readln( ffio); readln( fadres); readln( ftel);
repeat
if (t^.fio = ffio) and (t^.adres = fadres) and (t^.tel = ftel) then begin
p^.l:=t^.l;
dispose(t);
write( ffio,' ');
write( fadres,' ');
write( ftel,' ');
writeln( 'удален');
f:=1;
end;
t:=t^.l;
until t=nil;
if f=0 then begin writeln('в списке нет искомого человека');
readln; end;
t:=top;
writeln('spisok');
while t<>nil do begin
write( t^.fio,' ');
write( t^.adres,' ');
writeln( t^.tel,' ');
t:=t^.l;
end;
readln;
end;
{основная программа (меню)}
begin
assign(ff,'kniga.dat');
rewrite(ff);
reset(ff);
flag:=0;
clrscr;
repeat
writeln('1 - добавить');
writeln('2 - удалить');
writeln('3 - выйти');
readln(y);
clrscr;
case y of
1: {writeln('1- процедура выполнена');} pr(top);
2: {writeln('2- процедура выполнена');} pdelete(top);
end;
if y>3 then
writeln('ошибка ввода');
until y=3;
end.
Сообщение отредактировано: volvo -