program Project2;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
zap = record { структура запись }
id: integer;
lname: string[20];
fname: string[20];
mname: string[20];
adress: string[50];
number: integer;
end;
ff = file of zap;
Tptr = ^Elem;
Elem = record { структура список }
ok: zap;
pred, link: Tptr;
end;
var
z: zap;
i, j: integer;
yn: string;
f1, f2: ff;
beg, p, p1: Tptr;
procedure vivod_na_ekran;
begin
p := beg;
while p^.link <> beg do
begin
writeln(p^.ok.id, ' ', p^.ok.lname, ' ', p^.ok.fname, ' ', p^.ok.mname, ' ',
p^.ok.adress, ' ', p^.ok.number);
p := p^.link;
end;
begin
if p^.link = beg then
writeln(p^.ok.id, ' ', p^.ok.lname, ' ', p^.ok.fname, ' ', p^.ok.mname,
' ', p^.ok.adress, ' ', p^.ok.number);
end;
end; { конец процедуры }
procedure insert_abon;
var
nov: Tptr;
el_vstavki: integer;
a: boolean;
begin
assign(f2, 'elem');
{ rewrite(f2);
writeln('vvedite element dly vstavki');
writeln('vvedite id');
readln(z.id);
writeln('vvedite lname');
readln(z.lname);
writeln('vvedite fname');
readln(z.fname);
writeln('vvedite mname');
readln(z.mname);
writeln('vvedite adress');
readln(z.adress);
writeln('vvedite number');
readln(z.number);
write(f2,z);
close(f2); }
reset(f2);
new(nov);
read(f2, z);
nov^.ok := z;
nov^.link := nil;
writeln(' Element dly vstavki');
writeln(nov^.ok.id, ' ', nov^.ok.lname, ' ', nov^.ok.fname, ' ',
nov^.ok.mname, ' ', nov^.ok.adress, ' ', nov^.ok.number);
writeln('posle chego vstavliat');
read(el_vstavki); { элемент после которого происходит вставка }
p := beg;
a := false;
while (p^.link <> beg) and (a = false) do
begin
if p^.ok.id = el_vstavki then
begin
nov^.link := p^.link;
p^.link := nov;
a := true;
end;
p := p^.link;
end;
if p^.link = beg then
begin
if p^.ok.id = el_vstavki then
nov^.link := p^.link;
p^.link := nov;
vivod_na_ekran;
end
else
vivod_na_ekran;
close(f2);
readln;
end; { конец процедуры }
procedure delete_abon;
var
i: integer;
t: boolean;
del: Tptr;
begin
writeln('Vvedite nomer zapisi dly udalenia');
readln(i);
p := beg;
t := false;
while (p^.link <> beg) and (t = false) do
begin
if i = p^.link.ok.id then
begin
del := p.link;
p.link := p.link.link;
dispose(del);
t := true;
end;
p := p^.link;
end;
if (p^.link = beg) and (t = false) then
begin
if i = beg^.ok.id then
del := p.link;
p.link := p.link.link;
dispose(del);
beg := p^.link;
vivod_na_ekran;
end
else
vivod_na_ekran;
end; { конец процедуры }
procedure odnofamil;
var
f: Tptr;
b: string;
t: boolean;
begin
t := false;
writeln('poisk odnofamilcev');
p := beg;
f := beg;
while p^.link <> beg do
begin
while f^.link.ok.number <> p^.ok.number do
begin
if (p^.ok.lname = f^.link.ok.lname) and (b <> p^.ok.lname) then
begin
writeln(p.ok.lname, ' ', p.ok.fname, ' ', p.ok.number);
writeln(f^.link.ok.lname, ' ', f^.link.ok.fname, ' ',
f^.link.ok.number);
b := p^.ok.lname;
{ если 3 и более однофамильцев здесь нужно дописать }
t := true;
end;
f := f^.link;
end;
p := p^.link;
f := f^.link.link;
end;
if t = false then
begin
writeln('NET ODNOFAMILCEV V SPISKE!!!');
end;
end; { конец процедуры однофамильцы }
procedure redakt;
var
i, j: integer;
buf: Tptr;
c: char;
s: string[20];
num: integer;
begin
writeln('vvedite nomer elementa dly redaktirovaniya');
readln(i);
p := beg;
while p^.link <> beg do
begin
if i = p^.ok.id then
begin
new(buf);
buf^.ok := p^.ok;
writeln('Element dly redaktirovania');
writeln(buf^.ok.id, ' ', buf^.ok.lname, ' ', buf^.ok.fname, ' ',
buf^.ok.mname, ' ', buf^.ok.adress, ' ', buf^.ok.number);
repeat
writeln('Est polia dly redaktirovania (y/n)?');
readln(c);
if c = 'y' then
begin
writeln('Chto hotite redaktirovat? Vvedite cifry?');
writeln('Familia - 1, Imya - 2, Otchestvo - 3,Adress - 4, Nomer telephona - 5');
readln(j);
case j of
1:
begin
writeln('Vvedite familiy');
readln(s);
buf^.ok.lname := s;
end;
2:
begin
writeln('Vvedite Imya');
readln(s);
buf^.ok.fname := s;
end;
3:
begin
writeln('Vvedite Otchestvo');
readln(s);
buf^.ok.mname := s;
end;
4:
begin
writeln('Vvedite Adress');
readln(s);
buf^.ok.adress := s;
end;
5:
begin
writeln('Vvedite Telephone');
readln(num);
buf^.ok.number := num;
end;
end;
s := '';
num := 0;
writeln(buf^.ok.id, ' ', buf^.ok.lname, ' ', buf^.ok.fname, ' ',
buf^.ok.mname, ' ', buf^.ok.adress, ' ', buf^.ok.number);
p^.ok := buf^.ok;
end
else
until c = 'n';
end;
p := p^.link;
end;
// writeln('otredakt element');
// writeln( buf^.ok.id,' ',buf^.ok.lname,' ',buf^.ok.fname,' ',buf^.ok.mname,' ',buf^.ok.adress,' ',buf^.ok.number);
vivod_na_ekran;
end; { конец процедуры }
begin
{ главное тело программы }
assign(f1, 'exp');
{ rewrite(f1);
i:=0;
j:=0;
while i=0 do // цикл while потом поменяем на repeat
begin
j:=j+1;
z.id:=j;
writeln('vvedite lname');
readln(z.lname);
writeln('vvedite fname');
readln(z.fname);
writeln('vvedite mname');
readln(z.mname);
writeln('vvedite adress');
readln(z.adress);
writeln('vvedite number');
readln(z.number);
write(f1, z);
Writeln('Eshe odin abonent(y/n)?');
readln(yn);
if yn='n' then i:=1;
end;
close(f1); }
reset(f1);
new(p); // выделение памяти под текущую запись(ссылка)
read(f1, z); // чтение из файла записей
p^.ok := z; // разыменование указателя и присвоение ему структуры записей
p^.link := nil;
// присвоение следующей ссылочной переменной нулевого значения
beg := p; // переменной beg присваивается значение ссылки на область памяти способной хранить структуру запись
p1 := p; // аналогично beg
while not eof(f1) do
begin
new(p); // выделение памяти на которую указывает (p)
read(f1, z);
p^.ok := z;
// запись значения z в область памяти на которую указывает указатель p
p^.link := beg; //
p1^.link := p;
p1 := p; // присвоение переменной p1 ссылки на область памяти способную хранить структу запись
end;
close(f1);
p := beg;
while p^.link <> beg do
begin
writeln(p^.ok.id, ' ', p^.ok.lname, ' ', p^.ok.fname, ' ', p^.ok.mname,
' ', p^.ok.adress, ' ', p^.ok.number);
p := p^.link;
end;
begin
if p^.link = beg then
writeln(p^.ok.id, ' ', p^.ok.lname, ' ', p^.ok.fname, ' ', p^.ok.mname,
' ', p^.ok.adress, ' ', p^.ok.number);
end;
{ сюда можно поставить case }
insert_abon;
redakt;
delete_abon;
odnofamil;
readln;
{ TODO -oUser -cConsole Main : Insert code here }
end.