Type
 TElem = string;      

 TList = ^TNode;      
 TNode = record       
	 Info: TElem;  
	 Next: TList   
	 end;
var
 P1,P2:TList;
 r:TList;
 A:integer;

Procedure Insert(var P1: Tlist; x : integer);
  begin
  new®;
  r^.info:=x;
  r^.next:=P1^.next;
  P1^.next:=r;
 end; 

P^.next := list_2; { <--- вставляешь список после P }
while p2^.next <> nil do p2 := p2^.next; { <--- ищешь конец второго списка }
p2^.next := saved_pointer; { <--- вот и понадобилось то, сохраненное значение }

Program laba9;
Type

 point = ^item;       
 item = record        
	 Number: integer; 
	 Next: point;  
 end;
var
 P1,P2: pointer;
 A:integer;

Procedure SeachAndInsert(P1,P2: point ; x : integer ; var q : point);
 var
  flag : boolean;
  save:Point;
 begin
  flag:=true;
  while (P1<>nil) and flag=true do
  begin
   if P1^.number=x then
    begin
    flag:=false;
    save^.next:=P1^.next;
    end
   else
    begin
     P1:=P1^.next;
    end;
  end;
   P1^.next:=P2;
   while P2^.next<> nil do
   P1:=P2^.next;
   P1^.next:=save^.next;
 end;

procedure BListPrint(var P1 : pointer );
begin
 write('< ');
 while P1 <> nil DO
 begin
  write( P1^.number );
  If P1^.Next <> nil then write(',');
  P1 := P1^.Next
 end;
 writeln(' >')
end;

function Chartoint(var j: char): integer ;
	begin
		case j of
			'1': Chartoint:=1;
			'2': Chartoint:=2;
			'3': Chartoint:=3;
			'4': Chartoint:=4;
			'5': Chartoint:=5;
			'6': Chartoint:=6;
			'7': Chartoint:=7;
			'8': Chartoint:=8;
			'9': Chartoint:=9;
			else Chartoint:=0;
		end;
	end;

Procedure Probel(var fin:text);
 begin
  if ch=' ' then
   begin
   read(fin,ch);
   Probel(fin);
   end;
 end;

Procedure Create(var p : point; var fin:text;);
 var
 k:integer;
 r:point;
 begin
  new®;
  reset(fin);
  while not eof(fin) do
  begin
  read(fin,ch);
  Probel(fin);
  while not (ch=' ') and (not eof(fin)) do
    begin
     p:=chartoint(ch);
     x:=x*10+k;
     read(fin,ch);
    end;
  r^.number:=x;
  p^.number:=r^.number;
  p^.next:=r^.next;
  x:=0;
  close(fin);
  end;
 end;

Function CharToInt(ch: Char): Integer;
begin
  if Ch in ['1' .. '9'] then CharToInt := Ord(ch) - Ord('0') else CharToInt := 0;
end;

 
 uses CRT;
Type

 point = ^item;       {ЏаҐ¤бв ў«Ґ­ЁҐ бЇЁбЄ  }
 item = record        {‡ўҐ­® бЇЁбЄ }
	 Number: integer;
	 Next: point;   {‘«Ґ¤гойЁ© н«Ґ¬Ґ­в бЇЁбЄ }
	 end;
var
 P1,P2: point;
 A : integer;
 fin1,fin2 : text;

Procedure SeachAndInsert(P1,P2: point ; x : integer);
 var
  flag : boolean;
  save:Point;
 begin
  flag:=true;
  while (P1<>nil) and flag=true do
  begin
   if P1^.number=x then
    begin
    flag:=false;
    save^.next:=P1^.next;
    end
   else
    begin
     P1:=P1^.next;
    end;
  end;
   P1^.next:=P2;
   while P2^.next<> nil do
   P1:=P2^.next;
   P1^.next:=save^.next;
 end;


Procedure Create(var p : point; var fin:text);
 var
 r,m:point;
 begin
  new®;
  reset(fin);
  while not eof(fin) do
  begin
   new(m);
   read(fin,m^.number);
   m^.next:=nil;
   r^.next:=m;
   p:=m;
   write(p^.number);
   end;
   close(fin);
 end;


Procedure BListPrint( P : point );
begin
 write('< ');
 while P <> nil DO
 begin
  write( P^.number );
  If P^.Next <> nil then write(',');
  P := P^.Next
 end;
 writeln(' >')
end;

 begin
 clrscr;
 chdir('C:\Tpascal');
 assign(fin1,'test1.txt');
 assign(fin2,'test2.txt');
 Create(P1,fin1);
 BListPrint(P1);
 Create(P2,fin2);
 BListPrint(P2);
 writeln('‚ўҐ¤ЁвҐ Ї а ¬Ґва Ђ:');
 read(A);
 SeachAndInsert(P1,P2,A);
 BListPrint(P1);
 end.

Цитата(Krjuger @ 13.05.2009 12:16)

И еще процедуры должны быть говорящие,а то хрен поймеш что за апы и дауны,когщда до списков дойдеш будеш так голову вскрывать...

Procedure SeachAndInsert(P1, P2: point ; x : integer);
var
  flag: boolean;
  saved: Point;
begin
  flag:=true;

  while (P1<>nil) and flag do begin { <--- Обрати внимание !!! }
    if P1^.number = x then begin
      flag := false; saved := P1^.next;
    end
    else begin
      P1 := P1^.next;
    end;
  end;

  P1^.next:=P2;
  while P2^.next<> nil do P2:=P2^.next; { <-- Здесь у тебя тоже был полный бардак }
  P2^.next:=save;
end;

Procedure Create(var p : point; var fin:text);
var
  curr, last: point;
begin
  reset(fin);
  while not seekeof(fin) do begin { А это - чтобы не засовывало лишний ноль в конец списка }
    new(curr);
    read(fin, curr^.number);
    curr^.next := nil;

    if p = nil then p := curr
    else last^.next := curr;

    last := curr;
    write(last^.number:4);
  end;
  close(fin);
end;

while (P1<>nil) and flag=true do

while ((P1<>nil) and flag)=true do ...

 
Program laba9;
uses CRT;
Type

 point = ^item;       {ЏаҐ¤бв ў«Ґ­ЁҐ бЇЁбЄ  }
 item = record        {‡ўҐ­® бЇЁбЄ }
	 Number: integer;
	 Next: point;   {‘«Ґ¤гойЁ© н«Ґ¬Ґ­в бЇЁбЄ }
	 end;
var
 P1,P2: point;
 A : integer;
 fin1,fin2 : text;

Procedure SeachAndInsert(P1,P2: point ; x : integer);
 var
  flag : boolean;
  save:Point;
 begin
  flag:=true;
  while (P1<>nil) and flag=true do
  begin
   if P1^.number=x then
    begin
    flag:=false;
    save:=P1^.next;
    end
   else
    begin
     P1:=P1^.next;
    end;
  end;
   P1^.next:=P2;
   while P2^.next<> nil do
   P2:=P2^.next;
   P2^.next:=save;
 end;


Procedure Create(var p : point; var fin:text);
 var
 curr,last:point;
 begin
  reset(fin);
  while not seekeof(fin) do
  begin
   new(curr);
   read(fin,curr^.number);
   curr^.next:=nil;
   if p=nil then
    p:=curr
   else
    last^.next:=curr;
    last:=curr;
   end;
   close(fin);
 end;


Procedure BListPrint( P : point );
begin
 write('< ');
 while P <> nil DO
 begin
  write( P^.number );
  If P^.Next <> nil then write(',');
  P := P^.Next
 end;
 writeln(' >')
end;

 begin
 clrscr;
 chdir('C:\Tpascal');
 assign(fin1,'test1.txt');
 assign(fin2,'test2.txt');
 Create(P1,fin1);
 BListPrint(P1);
 Create(P2,fin2);
 BListPrint(P2);
 writeln('‚ўҐ¤ЁвҐ Ї а ¬Ґва Ђ:');
 read(A);
 SeachAndInsert(P1,P2,A);
 BListPrint(P1);
 end.