Версия для печати темы

program kursovaya;
uses crt;
type tinf=record
imya,nazv,nom,imyarod:string;
end;
list=^Tlist;
Tlist=record
data:Tinf;
next:List;
end;
var znom:tinf;
zn:string;
spis:list;
str:string;
I,j:integer;
ch:char;
f,g:text;
procedure addelem(var spis1:list;znom1:Tinf);
var
tmp:list;
begin
if spis1=nil then
begin
getmem(spis1,sizeof(Tlist));
tmp:=spis1;
end
else
begin
tmp:=spis1;
while tmp^.next<>nil do
tmp:=tmp^.next;
getmem(tmp^.next,sizeof(tlist));
tmp:=tmp^.next;
end;
tmp^.next:=nil;
tmp^.data:=znom1;
end;

procedure files(var spis1:list);
var tmp:list;
begin
if spis1=nil then begin writeln('spisok pyst');
exit;
end
else
tmp:=spis1;
while  tmp<>nil do
begin
writeln(g,tmp^.data.imya,' ',tmp^.data.nazv,' ',tmp^.data.nom,' ',tmp^.data.imyarod);
tmp:=tmp^.next;
end;
end;


procedure vivod(spis1:list);
begin
writeln;
if spis1=nil then
begin
writeln('spisok pyst');
exit;
end;
while spis1<>nil do
begin
writeln(spis1^.data.imya,' ',spis1^.data.nazv,' ',spis1^.data.nom,' ',spis1^.data.imyarod);
spis1:=spis1^.next;
end;
writeln;
end;

procedure freestek(spis1:list);
var
tmp:list;
begin
while spis1<>nil do
begin
tmp:=spis1;
spis1:=spis1^.next;
freemem(tmp,sizeof(tList));
end;
end;

procedure poisk(spis1:list;znom1:string);
begin
while (spis1<>nil) do begin
if spis1^.data.imya=znom1 then
writeln(spis1^.data.imya,' ',spis1^.data.nazv,' ',spis1^.data.nom,' ',spis1^.data.imyarod);
spis1:=spis1^.next;
end;
writeln;
end;
procedure delelem(var spis1:list;tmp:list);
var
tmpi:list;
begin
if (spis1=nil) or (tmp=nil) then exit;
if tmp=spis1 then
begin
spis1:=tmp^.next;
freemem(tmp,sizeof(Tlist));
end
else
begin
tmpi:=spis1;
while tmpi^.next<>tmp do
tmpi:=tmpi^.next;
tmpi^.next:=tmp^.next;
freemem(tmp,sizeof(Tlist));
end;
end;
procedure delete(var spis1:list;posi:integer);
var i:integer; tmp:list;
begin
if posi<1 then
exit;
if spis1=nil then
begin
writeln('spisok pyst');
exit
end;
i:=1;
tmp:=spis1;
while (tmp<>nil) and (i<>posi) do
begin
tmp:=tmp^.next;
inc(i)
end;
delelem(spis1,tmp);
end;

procedure sortirovka(nom:list);
var
tmp,rab:list;
tmps:tinf;
begin
getmem(tmp,sizeof(Tlist));
rab:=nom;
while rab<>nil do
begin
tmp:=rab^.next;
while tmp<>nil do
begin
if tmp^.data.imya<rab^.data.imya then
begin
tmps:=tmp^.data;
tmp^.data:=rab^.data;
rab^.data:=tmps;
end;
tmp:=tmp^.next
end;
rab:=rab^.next
end;
end;
procedure rednazv(var spis1:list;posi:integer);
var i:integer;
tmp:list;
st:string;
begin
if posi<1 then
exit;
if spis1=nil then
begin
write('spisok pyst');
end;
i:=1;
tmp:=spis1;
while (tmp<>nil) and (i<>posi) do
begin
tmp:=tmp^.next;
inc(i);
end;
writeln('vvedite nazvanie');
readln(st);
tmp^.data.nazv:=st;
end;
procedure rednom(var spis1:list;posi:integer);
var i:integer;
tmp:list;
st:string;
begin
if posi<1 then
exit;
if spis1=nil then
begin
write('spisok pyst');
end;
i:=1;
tmp:=spis1;
while (tmp<>nil) and (i<>posi) do
begin
tmp:=tmp^.next;
inc(i);
end;
writeln('vvedite nomer');
readln(st);
tmp^.data.nom:=st;
end;
procedure redimyarod(var spis1:list;posi:integer);
var i:integer;
tmp:list;
st:string;
begin
if posi<1 then
exit;
if spis1=nil then
begin
write('spisok pyst');
end;
i:=1;
tmp:=spis1;
while (tmp<>nil) and (i<>posi) do
begin
tmp:=tmp^.next;
inc(i);
end;
writeln('vvedite imya roditelya');
readln(st);
tmp^.data.imyarod:=st;
end;


procedure redimya(var spis1:list;posi:integer);
var i:integer;
tmp:list;
st:string;
begin
if posi<1 then
exit;
if spis1=nil then
begin
write('spisok pyst');
end;
i:=1;
tmp:=spis1;
while (tmp<>nil) and (i<>posi) do
begin
tmp:=tmp^.next;
inc(i);
end;
writeln('vvedite imya');
readln(st);
tmp^.data.imya:=st;
end;
begin
spis:=nil;
clrscr;
assign(f,'D:\files.txt');
reset(f);
while not eof(f) do begin
readln(f,str);
znom.imya:=copy(str,1,6);
znom.nazv:=copy(str,8,4);
znom.nom:=copy(str,14,5);
znom.imyarod:=copy(str,19,2);
addelem(spis,znom);
end;
repeat
 writeln('1-dobavlenie elementa');
 writeln('2-vivod');
 writeln('3-sortirovka');
 writeln('4-clrscr');
 writeln('5-poisk');
 writeln('6-delete');
 writeln('7-redaktirovanie');
 writeln('8-zapisat v fail');
 writeln('9-vihod');
 readln(ch);
 case ch of
      '1':begin
               writeln('vvedite imya');
               readln(znom.imya);
               writeln('vvedite nazvanie');
               readln(znom.nazv);
               writeln('vvedite nomer voliera');
               readln(znom.nom);
               writeln('vvedite imya roditelya');
               readln(znom.imyarod);
               addelem(spis,znom);
          end;
       '2':begin clrscr;
                vivod(spis);
           end;
       '3':begin
                sortirovka(spis);
           end;
       '4':begin clrscr;
       end;
       '5':begin
                if spis=nil then
                writeln('Spisok pyst')
                else
                begin
                writeln('Vvedite imya');
                readln(str);
                poisk(spis,str);
                end;
          end;
       '6':begin
                writeln('vvedite nomer elementa kootoriy nado ydalit');
                readln(i);
                delete(spis,i);
                end;
       '7':begin
                writeln('vvedite nomer elementa kotoriy hotite redaktirovat');
                readln(i);
                writeln('4to vi hotite redaktirovat? 1-imya,2-nazvanie,3-nomer voliera,4-imya roditelya');
                readln(j);
                case j of
                1:begin
                redimya(spis,i);
                end;
                2:begin rednazv(spis,i); end;
                3:begin rednom(spis,i); end;
                4:begin redimyarod(spis,i); end;
                end;
           end;
       '8':begin assign(g,'D:\file2.txt');
                 rewrite(g);
                 files(spis);
                 writeln('Vvedite nazvanie faila v formate D:\***.txt');
                 readln(str);
                 rename(g,str);
                 close(g);
                 end;

   end;
until ch='9';
close(f);
freestek(spis);
spis:=nil;
end.