ПОЧТИ ТОЖЕ САМОЕ, ПРИКОЛИСТ
Код
program Project4;
{$APPTYPE CONSOLE}
uses
SysUtils;
const
M=30;
type
str=string[50];
spr=record
name:str;
family:str;
tel1:str;
tel2:str;
end;
mas=array[1..M] of spr;
procedure num2(var f:text; var t:mas; var k:integer);
var
abon:spr;
S:str;
i:integer;
begin
for i:=1 to M do
begin
t[i].family:=' ';
t[i].name:=' ';
t[i].tel1:=' ';
t[i].tel2:=' ';
end;
reset(f);
k:=0;
while not seekeof(f) do
begin
readln(f,S);
S:=S+' ';
i:=pos(' ',S);
abon.family:=copy(S,1,i-1);
delete(S,1,i);
i:=pos(' ',S);
abon.name:=copy(S,1,i-1);
delete(S,i,1);
i:=pos(' ',S);
abon.tel1:=copy(S,1,i-1);
delete(S,1,i);
i:=pos(' ',S);
abon.tel2:=copy(S,1,i-1);
k:=k+1;
t[k]:=abon;
end;
close(f);
end;
procedure num1(var f:text; var t:mas; var k:integer);
var
abon:spr;
begin
append(f);
writeln('vvedite familiy');
readln(abon.family);
write(f,abon.family,' ');
writeln('vvedite ima');
readln(abon.name);
write(f,abon.name,' ');
writeln('vvedite domashnii telefon');
readln(abon.tel1);
write(f,abon.tel1,' ');
writeln('vvedite mobilnii telefon');
readln(abon.tel2);
writeln(f,abon.tel2);
close(f);
num2(f,t,k);
end;
procedure num3(t:mas; k:integer);
var
i,n:integer;
a,S:str;
begin
writeln('vvedite bykvy dla poiska');
readln(S);
n:=0;
for i:=1 to k do
begin
a:=copy(t[i].family,1,1);
if a=S then
begin
writeln(t[i].family,' ',t[i].name,' ',t[i].tel1,' ',t[i].tel2);
n:=1;
end;
end;
if n=0 then
writeln('abonent ne naiden');
end;
procedure num4(t:mas; k:integer);
var
S:str;
i,n:integer;
begin
writeln('vvedite familiy');
readln(S);
n:=0;
for i:=1 to k do
begin
if S=t[i].family then
begin
writeln(t[i].family,' ',t[i].name,' ',t[i].tel1,' ',t[i].tel2);
n:=1;
end;
end;
if n=0 then
writeln('abonent ne naiden');
end;
procedure num5(var f:text; var t:mas; k:integer);
var
S:str;
i,n,j:integer;
begin
writeln('vvedite familiy');
readln(S);
j:=0;
for i:=1 to k do
begin
if t[i].family=S then
begin
writeln(t[i].family,' ',t[i].name,' ',t[i].tel1,' ',t[i].tel2);
writeln('esli xotite redaktirovat, na*mite 1; esli net - 0');
readln(n);
if n=1 then
begin
writeln('vvedite familiy');
readln(t[i].family);
writeln('vvedite ima');
readln(t[i].name);
writeln('vvedite domashnii telefon');
readln(t[i].tel1);
writeln('vvedite mobilnii telefon');
readln(t[i].tel2);
j:=1;
end;
end;
end;
if j=1 then
begin
rewrite(f);
for i:=1 to k do
writeln(f,t[i].family,' ',t[i].name,' ',t[i].tel1,' ',t[i].tel2);
close(f);
end
else
writeln('abonent ne naiden');
end;
procedure num6(var f:text; var t:mas; var k:integer);
var
S:str;
i,n:integer;
begin
writeln('vvedite familiy');
readln(S);
n:=0;
for i:=1 to k do
begin
if t[i].family=S then
begin
t[i].family:=t[k].family;
t[k].family:=' ';
t[i].name:=t[k].name;
t[k].name:=' ';
t[i].tel1:=t[k].tel1;
t[k].tel1:=' ';
t[i].tel2:=t[k].tel2;
t[k].tel2:=' ';
k:=k-1;
n:=1;
end;
end;
if n=1 then
begin
rewrite(f);
for i:=1 to k do
writeln(f,t[i].family,' ',t[i].name,' ',t[i].tel1,' ',t[i].tel2);
close(f);
writeln('ydalenie zaversheno');
end
else
writeln('abonent ne naiden');
end;
procedure num7(t:mas; k:integer);
var
i:integer;
begin
for i:=1 to k do
writeln(t[i].family,' ',t[i].name,' ',t[i].tel1,' ',t[i].tel2);
end;
procedure menu(z:integer; var f:text);
var
t:mas;
k:integer;
begin
writeln;
z:=10;
while z>0 do
begin
writeln('vvedite pynkt:');
writeln('1 - dobavit abonenta');
writeln('2 - poisk po bykve');
writeln('3 - poisk po familii');
writeln('4 - redaktirovat dannie');
writeln('5 - ydalit abonenta');
writeln('6 - vivesti vse');
writeln('0 - vixod iz programmi');
readln(z);
case z of
1:num1(f,t,k);
2:num3(t,k);
3:num4(t,k);
4:num5(f,t,k);
5:num6(f,t,k);
6:num7(t,k);
else
writeln('nevernii vvod');
end;
writeln;
end;
end;
var
f:text;
z:integer;
begin
{ TODO -oUser -cConsole Main : Insert code here }
assign(f,'qw.txt');
menu(z,f);
end.