Есть собственные наработки(пока мало)((см.код)), осталось только двусвязные компоненты отыскать...
uses crt;
const n=4;
type stek=^node;
node=record
key:integer;
next:stek;
end;
massiv=array[1..n] of stek;
var spsm:massiv;
i,j:integer;
v,sm:integer;
q:stek;
BEGIN
clrscr;
for i:=1 to n do
begin
q:=nil;
writeln('Введите все смежные вершины вершине ',i);
readln(sm);
while sm>0 do begin
new(spsm[i]);
spsm[i]^.key:=sm;
spsm[i]^.next:=q;
q:=spsm[i];
readln(sm);
end;
end;
for i:=1 to n do
begin
write(i,': ');
while spsm[i]<>nil do begin
write(spsm[i]^.key,' ');
spsm[i]:=spsm[i]^.next;
end;
writeln;
end;
readln;
END.