Однонаправленные списки

unit Unit1;
 
interface
type
int=^rec;
rec=record
elem:integer;
next:int;
end;
procedure form(n:integer;var p:int);
procedure vivod(var p:int);
function  chis_uzel(p:int):integer;
procedure poisk(p:int;k1:integer);
procedure dobavlenie(p:int;k1,k:integer);
procedure iskl(p:int; k:integer);
procedure obedinenie(p, q:int);
procedure razbivka(k:integer; var p,q:int);
procedure copy(p:int;var q:int);
procedure delete(p:int);
function uzel(p:int; var a:int; l:integer):boolean;
implementation
 
procedure form(n:integer; var p:int);
var i:integer;
    a:int;
begin
   new(p);
   randomize;
   p^.elem:=random(100);
   if (p^.elem mod 2=1) then p^.elem:=p^.elem+1;
   p^.next:=nil;
   a:=p;
   for i:=2 to n do
 
  begin
     new(a^.next);
     a:=a^.next;
     a^.elem:=random(100);
     if (a^.elem mod 2=1) then a^.elem:=a^.elem+1;
     a^.next:=nil;
  end;
end;
 
procedure vivod(var p:int);
var t:int;
begin
t:=p;
while t<>nil do
begin
writeln(t^.elem);
t:=t^.next;
end;
 
end;
 
function chis_uzel(p:int):integer;
begin
result:=0;
while p<>nil do 
begin
result:=result+1;
p:=p^.next;
end;
end;
 
procedure poisk(p:int;k1:integer);
var i:integer; k:int;
begin
k:=p;
writeln;
write('3) vvedite k element= ');
readln(k1);
for i:=1 to k1-1 do
begin
  k:=k^.next;
end;
writeln;
writeln('znachenie k-togo elementa= ',k^.elem);
end;
 
 procedure dobavlenie(p:int;k1,k:integer);
   var i:integer;a:int;
 begin
     new(a);
     a^.elem:=k1;
     for I := 2 to k  do 
     p:=p^.next;
     if p^.next<>nil then begin 
     a^.next:=p^.next;
     p^.next:=a;
     end
     else
     a^.next:=nil;
     p^.next:=a;
 end;
 
procedure iskl(p:int; k:integer);
 var  a:int;
begin
p:=p^.next;  
a:=p^.next;
if p^.next<>nil then 
     begin
     p^.next:= a^.next; 
     dispose(a); 
     end;
 end;
 
 procedure obedinenie(p,q:int);
   var r:int;n:integer;
begin
   write('vvedite razmer 2 spiska = ');
   readln(n);
   form(n,q);
   writeln;
   writeln('vtoroy spisok = ');
   vivod(q);
   r:=p;
        while p^.next<>nil do
        p:=p^.next;
        p^.next:=q;
end; 
 
procedure razbivka(k:integer; var p,q:int);
   var i,n:integer;a:int;
begin
   i:=1;
   a:=p;
   while (a<>nil) and (i<>k)  do  begin
     a:=a^.next; i:=i+1;
   end;
     q:=a^.next;
     a^.next:=nil;
end;  
 
procedure copy(p:int;var q:int);
var r:int;
begin
new(q); 
q^.elem:=p^.elem; 
q^.next:=nil;
r:=q;
while p^.next<>nil do 
begin
p:=p^.next;
new(r^.next);
r:=r^.next;
r^.elem:=p^.elem;
r^.next:=nil;
end;
writeln;
end; 
 
procedure delete(p:int);
 var q,a:int;
begin
 q:=p;
 while q^.next<>nil do
  begin
   a:=q^.next; 
   dispose(a);
  end;
 p:=nil;
end;
 
function uzel(p:int; var a:int; l:integer):boolean;
var q:int; 
begin
write('vvedite znachenie uzla= ');
readln(l);
uzel:=true;
q:=p;
while q<>nil do
begin
if q^.elem=l then
uzel:=true
else result:=false;
a:=q;
end;
q:=q^.next;
end;
 
end.
 
 
ОСНОВНАЯ ПОРГРАММА
program Project2;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils,
  Unit1 in 'Unit1.pas';
 
var n,k1,k,l:integer; p,q,a:int; b:integer;
begin
write('1) vvedite razmer spiska= ');
readln(n);
form(n,p);
writeln;
vivod(p);
 
writeln;
b:=chis_uzel(p);
writeln('2) chislo uzlov v spiske=',b);
writeln;
 
poisk(p,k1);
writeln;
 
write('4) vvedite nomer elementa= ');
readln(k);
writeln;
write('vvedite chislo= ');
readln(k1);
writeln;
dobavlenie(p,k1,k);
writeln('spisok c dobavlenbIm elementom= ');
vivod(p);
writeln;
 
 
 
write('5) vvedite nomer elementa= ');
readln(k);
iskl(p,k);
writeln;
writeln('spisok c udalenim elementom= ');
vivod(p);
writeln;
 
obedinenie(q,p);
writeln('obedinennuy spisok= ');
vivod(p);
writeln;
 
writeln;
write('7) vvedite nomer elementa= ');
readln(k);
razbivka(k,p,q);
writeln;
writeln('pervyi spisok= ');
vivod(p);
writeln;
writeln;
writeln('vtoroy spisok= ');
vivod(q);
writeln;
 
copy(p,q);
writeln('8) skopirovanniy spisok= ');
vivod(p);
writeln;
 
delete(p);
writeln('udalenniy spisok');
vivod(q);
writeln;
 
if uzel(p,a,l)=true then writeln('uzel naiden!')
                  else writeln('uxel ne naiden!');
readln;
readln;
end.

procedure obedinenie(var p,q:int);
   var r:int;
begin
   if p = nil then {первый список пуст}
          p := q 
  else  
  begin 
   r:=p;
   while r^.next<>nil do
        r:=r^.next;
   r^.next:=q;
  end; 
end;