program Phonebook;
uses Crt;
type
Phone = record
SurnameS: string[15];
NameS: string[15];
PhoneS: string[15];
AddressS: string[50];
end;
const
filename = '000000.txt';
var
PhoneF: file of Phone;
PhoneR: Phone;
a: array [1 .. 600] of Phone;
procedure WritePhone;
begin
Assign(PhoneF, filename);
Reset(PhoneF);
ClrScr;
writeln('Vse zapisi: ');
writeln;
while not Eof(PhoneF) do
begin
PhoneR.SurnameS := ' ';
PhoneR.NameS := ' ';
PhoneR.PhoneS := ' ';
PhoneR.AddressS := ' ';
read(PhoneF, PhoneR);
writeln;
write(' ', PhoneR.SurnameS);
write(' ', PhoneR.NameS);
write(' ', PhoneR.PhoneS);
write(' ', PhoneR.AddressS);
end;
Close(PhoneF);
writeln;
writeln;
write('Nagmite lybuy klavishu ...');
ReadKey;
end;
procedure AddPhone;
begin
Assign(PhoneF, filename);
Reset(PhoneF);
while not Eof(PhoneF) do
Read(PhoneF, PhoneR);
PhoneR.SurnameS := ' ';
PhoneR.NameS := ' ';
PhoneR.PhoneS := ' ';
PhoneR.AddressS := ' ';
ClrScr;
writeln('Dobavlenie zapisi: ');
writeln;
Write('Vvedite familiy: ');
readln(PhoneR.SurnameS);
write('Vvedite imya: ');
readln(PhoneR.NameS);
write('Vvedite nomer telefona: ');
readln(PhoneR.PhoneS);
write('Vvedite adres: ');
readln(PhoneR.AddressS);
write(PhoneF, PhoneR);
Close(PhoneF);
writeln;
writeln('Zapis uspehno dobavlena v bazu !!!');
writeln;
write('Nagmite lybuy klavishu ...');
ReadKey;
end;
procedure DeletePhone;
var
temp: file of Phone;
Nazv: string[15];
begin
Assign(PhoneF, filename);
Reset(PhoneF);
Assign(temp, filename);
Rewrite(temp);
PhoneR.SurnameS := ' ';
PhoneR.NameS := ' ';
PhoneR.PhoneS := ' ';
PhoneR.AddressS := ' ';
ClrScr;
writeln('Udalenie zapisi: ');
writeln;
Write('Vvedite familiy: ');
readln(Nazv);
while not Eof(PhoneF) do
begin
Read(PhoneF, PhoneR);
if PhoneR.SurnameS <> Nazv then
Write(temp, PhoneR);
end;
Close(temp);
Close(PhoneF);
Erase(PhoneF);
Rename(temp, filename);
writeln;
writeln('Zapis uspehno udalena iz bazu !!!');
writeln;
write('Nagmite lybuy klavishu ...');
ReadKey;
end;
procedure EditPhone;
var
Nazv: string[15];
temp: file of Phone;
begin
Assign(PhoneF, filename);
Reset(PhoneF);
Assign(temp, filename);
Rewrite(temp);
PhoneR.SurnameS := ' ';
PhoneR.NameS := ' ';
PhoneR.PhoneS := ' ';
PhoneR.AddressS := ' ';
ClrScr;
writeln('Redaktirovanie zapisi: ');
writeln;
Write('Vvedite familiy, kotoruy hotite izmenit: ');
readln(Nazv);
while not Eof(PhoneF) do
begin
PhoneR.SurnameS := ' ';
PhoneR.NameS := ' ';
PhoneR.PhoneS := ' ';
PhoneR.AddressS := ' ';
Read(PhoneF, PhoneR);
if PhoneR.SurnameS <> Nazv then
Write(temp, PhoneR);
end;
writeln;
write('Vvedite novuy familiy: ');
readln(PhoneR.SurnameS);
write('Vvedite novoe imya: ');
readln(PhoneR.NameS);
write('Vvedite novyi nomer telefona: ');
readln(PhoneR.PhoneS);
write('Vveddite novyi adres: ');
readln(PhoneR.AddressS);
write(temp, PhoneR);
Close(temp);
Close(PhoneF);
Erase(PhoneF);
Rename(temp, filename);
writeln;
writeln('Zapis uspehno izmenena !!!');
writeln;
write('Nagmite lybuy klavishy ...');
ReadKey;
end;
procedure FindSurname;
var
Nazv: string[15];
k: integer;
begin
k := 0;
Assign(PhoneF, filename);
Reset(PhoneF);
ClrScr;
writeln('Poisk zapisi po familii: ');
writeln;
Write('Vvedite familiy: ');
readln(Nazv);
while not Eof(PhoneF) do
begin
PhoneR.SurnameS := ' ';
PhoneR.NameS := ' ';
PhoneR.PhoneS := ' ';
PhoneR.AddressS := ' ';
read(PhoneF, PhoneR);
if PhoneR.SurnameS = Nazv then
begin
writeln;
write(' ', PhoneR.SurnameS);
write(' ', PhoneR.NameS);
write(' ', PhoneR.PhoneS);
write(' ', PhoneR.AddressS);
k := k + 1;
end;
end;
Close(PhoneF);
writeln;
writeln;
writeln('Poisk zavershen, naideno zapisei: ', k);
writeln;
write('Nagmite lybuy klavishu ...');
ReadKey;
end;
procedure FindPhone;
var
Nazv: string[15];
k: integer;
begin
k := 0;
Assign(PhoneF, filename);
Reset(PhoneF);
ClrScr;
writeln('Poisk zapisi po nomeru telefona: ');
writeln;
Write('Vvedite nomer telefona: ');
readln(Nazv);
while not Eof(PhoneF) do
begin
PhoneR.SurnameS := ' ';
PhoneR.NameS := ' ';
PhoneR.PhoneS := ' ';
PhoneR.AddressS := ' ';
read(PhoneF, PhoneR);
if PhoneR.PhoneS = Nazv then
begin
writeln;
write(' ', PhoneR.SurnameS);
write(' ', PhoneR.NameS);
write(' ', PhoneR.PhoneS);
write(' ', PhoneR.AddressS);
k := k + 1;
end;
end;
Close(PhoneF);
writeln;
writeln;
writeln('Poisk zavershen, naideno zapisei: ', k);
writeln;
write('Nagmite lybuy klavishu ...');
ReadKey;
end;
procedure SortSurname;
var
i, j, c: integer;
tr: Phone;
begin
c := 0;
Assign(PhoneF, filename);
Reset(PhoneF);
ClrScr;
writeln('Sortirovka po familii: ');
writeln;
while not Eof(PhoneF) do
begin
inc(c, 1);
read(PhoneF, a[c]);
end;
for i := 1 to c do
for j := 1 to c - 1 do
begin
if a[j].SurnameS > a[j + 1].SurnameS 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].SurnameS);
write(' ', a[i].NameS);
write(' ', a[i].PhoneS);
write(' ', a[i].AddressS);
end;
Close(PhoneF);
writeln;
writeln;
write('Nagmite lybuy klavishu ...');
ReadKey;
end;
procedure SortAddress;
var
i, j, c: integer;
tr: Phone;
begin
c := 0;
Assign(PhoneF, filename);
Reset(PhoneF);
ClrScr;
writeln('Sortirovka po adresu: ');
writeln;
while not Eof(PhoneF) do
begin
inc(c, 1);
read(PhoneF, a[c]);
end;
for i := 1 to c do
for j := 1 to c - 1 do
begin
if a[j].AddressS > a[j + 1].AddressS 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].SurnameS);
write(' ', a[i].NameS);
write(' ', a[i].PhoneS);
write(' ', a[i].AddressS);
end;
Close(PhoneF);
writeln;
writeln;
write('Nagmite lybuy klavishu ...');
ReadKey;
end;
procedure SortPhone;
var
i, j, c: integer;
tr: Phone;
begin
c := 0;
Assign(PhoneF, filename);
Reset(PhoneF);
ClrScr;
writeln('Sortirovka po nomeru telefona: ');
writeln;
while not Eof(PhoneF) do
begin
inc(c, 1);
read(PhoneF, a[c]);
end;
for i := 1 to c do
for j := 1 to c - 1 do
begin
if a[j].PhoneS > a[j + 1].PhoneS 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].SurnameS);
write(' ', a[i].NameS);
write(' ', a[i].PhoneS);
write(' ', a[i].AddressS);
end;
Close(PhoneF);
writeln;
writeln;
write('Nagmite lybuy klavishu ...');
ReadKey;
end;
procedure SortType;
var
b: integer;
begin
repeat
begin
ClrScr;
writeln('"Zapisnaya telefonnaya knigka" - menu sortirovki');
writeln;
writeln('1. Ne sortirovat');
writeln('2. Sortirovat po familii');
writeln('3. Sortirovat po adresu');
writeln('4. Sortirovat po nomeru telefona');
writeln('----------------------------');
writeln('5. Vozvrat v glavnoe menu');
writeln;
write('Vyberite punkt meny: ');
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('"Zapisnaya telefonnaya knigka" - glavnoe 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. Vyhod');
writeln;
write('Vyberite 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.