Телефонный справочник

program Phonebook;
uses Crt;
type Phone = record
Surname: string[15];
Name : string[15];
Phone : string[15];
Address: string[50];
end;
var PhFile : file of Phone;
PhW : Phone;
a : array[1..600] of Phone;
procedure WritePhone;
begin
Assign(PhFile,'Phone\phone.dat');
Reset(PhFile);
ClrScr;
writeln('Vse zapisi:');
writeln;
while not Eof(PhFile) do
begin
PhW.SurName:='';
PhW.Name:='';
PhW.Phone:='';
PhW.Address:='';
read(PhFile,PhW);
writeln;
write(PhW.SurName);
write(' ',PhW.Name);
write('',PhW.Phone);
write('',PhW.Address);
end;
Close(PhFile);
writeln;
writeln;
write('Nazmite lubuyu klavishu...');
ReadKey;
end;
procedure AddPhone;
begin
Assign(PhFile,'Phone\phone.dat');
Reset(PhFile);
while not Eof(PhFile) do Read(PhFile,PhW);
PhW.SurName:='';
PhW.Name:='';
PhW.Phone:='';
PhW.Address:='';
ClrScr;
writeln('Dobavlenie zapisi:');
writeln;
Write('Vvedite familiyu:');
readln(PhW.SurName);
write('Vvedite imja:');
readln(PhW.Name);
write('Vvedite nomer telefona:');
readln(PhW.Phone);
write('Vvedite adress:');
readln(PhW.Address);
write(PhFile,PhW);
Close(PhFile);
writeln;
writeln('Zapis uspeshno dobavlena!');
writeln;
write('Nazmite lubuyu klavishu…');
ReadKey;
end;
procedure DeletePhone;
var temp : file of Phone;
Nazv : string[15];
begin
Assign(PhFile,'Phone\phone.dat');
Reset(PhFile);
Assign(temp,'Phone\temp.dat');
Rewrite(temp);
PhW.SurName:='';
PhW.Name:='';
PhW.Phone:='';
PhW.Address:='';
ClrScr;
writeln('Udalenie zapisi:');
writeln;
Write('Vvedite familiyu:');
readln(Nazv);
while not Eof(PhFile) do
begin
Read(PhFile,PhW);
if PhW.SurName<>Nazv then Write(temp,PhW);
end;
Close(temp);
Close(PhFile);
Erase(PhFile);
Rename(temp,'Phone\phone.dat');
writeln;
writeln('Zapis uspeshno udalena!');
writeln;
write('Nazmite lubuyu klavishu...');
ReadKey;
end;
procedure EditPhone;
var Nazv : string[15];
temp : file of Phone;
begin
Assign(PhFile,'Phone\phone.dat');
Reset(PhFile);
Assign(temp,'Phone\temp.dat');
Rewrite(temp);
PhW.SurName:='';
PhW.Name:='';
PhW.Phone:='';
PhW.Address:='';
ClrScr;
writeln('Redaktirovanie zapisi:');
writeln;
Write('Vvedite familiyu kotoruyu hotite izmenit:');
readln(Nazv);
while not Eof(PhFile) do
begin
PhW.SurName:='';
PhW.Name:='';
PhW.Phone:='';
PhW.Address:='';
Read(PhFile,PhW);
if PhW.SurName<>Nazv then Write(temp,PhW);
end;
writeln;
write('Vvedite novuyu familiyu:');
readln(PhW.SurName);
write('Vvedite novoe imja:');
readln(PhW.Name);
write('Vvedite noviy nomer telefona:');
readln(PhW.Phone);
write('Vvedite noviy adress:');
readln(PhW.Address);
write(temp,PhW);
Close(temp);
Close(PhFile);
Erase(PhFile);
Rename(temp,'Phone\phone.dat');
writeln;
writeln('Zapis uspeshno izmenina!');
writeln;
write('Nazmite lubuyu klavishu');
ReadKey;
end;
procedure FindSurname;
var Nazv : string[15];
k : integer;
begin
k:=0;
Assign(PhFile,'Phone\phone.dat');
Reset(PhFile);
ClrScr;
writeln('Poisk zapisi po familiyi:');
writeln;
Write('Vvedite familiyu:');
readln(Nazv);
while not Eof(PhFile) do
begin
PhW.SurName:='';
PhW.Name:='';
PhW.Phone:='';
PhW.Address:='';
read(PhFile,PhW);
if PhW.SurName=Nazv then
begin
writeln;
write(PhW.SurName);
write(' ',PhW.Name);
write('',PhW.Phone);
write('',PhW.Address);
k:=k+1;
end;
end;
Close(PhFile);
writeln;
writeln;
writeln('Poisk zavershen, najdeno zapisey: ',k);
writeln;
write('Nazmite lubuyu klavishu…');
ReadKey;
end;
procedure FindPhone;
var Nazv : string[15];
k : integer;
begin
k:=0;
Assign(PhFile,'Phone\phone.dat');
Reset(PhFile);
ClrScr;
writeln('Poisk zapisi po nomeru telefona:');
writeln;
Write('Vvedite nomer telefona:');
readln(Nazv);
while not Eof(PhFile) do
begin
PhW.SurName:='';
PhW.Name:='';
PhW.Phone:='';
PhW.Address:='';
read(PhFile,PhW);
if PhW.Phone=Nazv then
begin
writeln;
write(PhW.SurName);
write(' ',PhW.Name);
write('',PhW.Phone);
write('',PhW.Address);
k:=k+1;
end;
end;
Close(PhFile);
writeln;
writeln;
writeln('Poisk zavershen, najdeno zapisey: ',k);
writeln;
write('Nazmite lubuyu klavishu...');
ReadKey;
end;
procedure SortSurname;
var i,j,c: integer;
tr: Phone;
begin
c:=0;
Assign(PhFile,'Phone\phone.dat');
Reset(PhFile);
ClrScr;
writeln('Sortirovka po familiyi:');
writeln;
while not Eof(PhFile) do begin
inc(c,1);
read(PhFile,a[c]);
end;
for i:=1 to c do
for j:=1 to c-1 do begin
if a[j].SurName>a[j+1].SurName then begin
tr:=a[j+1];
a[j+1]:=a[j];
a[j]:=tr;
end;
end;
for i:=1 to c do begin
writeln;
write(a[i].SurName);
write(' ',a[i].Name);
write('',a[i].Phone);
write('',a[i].Address);
end;
Close(PhFile);
writeln;
writeln;
write('Nazmite lubuyu klavishu…');
ReadKey;
end;
procedure SortAddress;
var i,j,c: integer;
tr: Phone;
begin
c:=0;
Assign(PhFile,'Phone\phone.dat');
Reset(PhFile);
ClrScr;
writeln('Sortirovka po adressu:');
writeln;
while not Eof(PhFile) do begin
inc(c,1);
read(PhFile,a[c]);
end;
for i:=1 to c do
for j:=1 to c-1 do begin
if a[j].Address>a[j+1].Address then begin
tr:=a[j+1];
a[j+1]:=a[j];
a[j]:=tr;
end;
end;
for i:=1 to c do begin
writeln;
write(a[i].SurName);
write(' ',a[i].Name);
write('',a[i].Phone);
write('',a[i].Address);
end;
Close(PhFile);
writeln;
writeln;
write('Nazmite lubuyu klavishu…');
ReadKey;
end;
procedure SortPhone;
var i,j,c: integer;
tr: Phone;
begin
c:=0;
Assign(PhFile,'Phone\phone.dat');
Reset(PhFile);
ClrScr;
writeln('Sortirovka po adressu:');
writeln;
while not Eof(PhFile) do begin
inc(c,1);
read(PhFile,a[c]);
end;
for i:=1 to c do
for j:=1 to c-1 do begin
if a[j].Phone>a[j+1].Phone then begin
tr:=a[j+1];
a[j+1]:=a[j];
a[j]:=tr;
end;
end;
for i:=1 to c do begin
writeln;
write(a[i].SurName);
write(' ',a[i].Name);
write('',a[i].Phone);
write('',a[i].Address);
end;
Close(PhFile);
writeln;
writeln;
write('Nazmite lubuyu klavishu…');
ReadKey;
end;
 
procedure SortType;
var b: integer;
begin
repeat
begin
ClrScr;
writeln('"Phonebook" – menu sortirovki');
writeln;
writeln('1. Ne sortirovat');
writeln('2. Sortirovat po familiyi');
writeln('3. Sortirovat po adressu');
writeln('4. Sortirovat po nomeru telefona');
writeln('----------------------------');
writeln('5. Vernutsa v hlavnoe menu');
writeln;
write('Vuberite punkt menu: ');
readln(b);
case b of
1 : WritePhone;
2 : SortSurname;
3 : SortAddress;
4 : SortPhone;
end;
end;
until b=5;
end;
procedure PhoneMenu;
var b: integer;
begin
repeat
begin
ClrScr;
writeln('"Phonebook" – Hlavnoe menu');
writeln;
writeln('1. Pokazat vse zapisi');
writeln('2. Dobavit zapis');
writeln('3. Udalit zapis');
writeln('4. Redaktirovat zapis');
writeln('5. Poisk po familii');
writeln('6. Poisk po nomeru telefona');
writeln('----------------------------');
writeln('7. Vixod');
writeln;
write('Vuberite punkt menu: ');
readln(b);
case b of
1 : SortType;
2 : AddPhone;
3 : DeletePhone;
4 : EditPhone;
5 : FindSurname;
6 : FindPhone;
end;
end;
until b=7;
end;
begin
ClrScr;
PhoneMenu;
end.