Процедура добавления строк в линейный список

uses crt;
type
  List = ^Tlist;
  Tlist = record
    next: List;
    s: String;
    info:integer;
  end;
procedure Vvod(var l: list);
var
  p: ^list;
  ss: String;
begin
  p:=@l;
  WriteLn('Vvedite stroki, okonchanie vvoda .');
  repeat
    ReadLn(ss);
     if ss='.' then break;
    New(p^); p^^.s:=ss; p:=@p^^.next;
  until False;
  p^:=nil;
end;
 
function ykaz(l: list; n: integer): list;
begin
  while (l <> nil) and (n > 1) do begin
    l := l^.next; dec(n);
  end;
ykaz := l
end;
 
procedure add(var q: list; i, j: integer);
var
  pred,posl: list;
  T: list;
begin
 
  posl := ykaz(q, i);
  pred := ykaz(q, j);
  if (posl = nil) or (pred = nil) then
  begin
    writeln('Index za predelami svyazi'); exit
  end;
 
  new(T);
  T^.info := pred^.info;
 
  T^.next := posl^.next;
  posl^.next := T;
 
end;
procedure Vivod(p: list);
begin
  WriteLn('Sodergimoe spiska:');
  while p<>nil do with p^ do begin
    WriteLn(s); p:=next;
  end;
end;
var h:List; i,j:integer;
begin
clrscr;
       Vvod(h);
   Write('Vvedite i - ');
readln(i);
Write('Vvedite j - ');
readln(j);
 
add(h,i,j);
Vivod(h);
readln;
end.

type
  TInfo = integer;
  PList = ^TList;
 
  TList = record
    Info: TInfo;
    Next: PList;
  end;
 
  procedure ListAdd(var root: PList; info: TInfo);
  var
    p: PList;
    Last: PList;
  begin
    new(p);
    p^.Info := Info;
    p^.Next := nil;
    if Assigned(root) then
    begin
      Last := root;
      while Assigned(Last^.Next) do
        Last := Last^.Next;
      Last^.Next := p;
    end
    else
      root := p;
  end;
 
  procedure ListFree(var root: PList);
  var
    p: PList;
  begin
    while Assigned(root) do
    begin
      p := root;
      root := root^.Next;
      Dispose(p);
    end;
  end;
 
  procedure ListShow(root: PList);
  begin
    Write('<');
    while Assigned(root) do
    begin
      Write(root^.Info: 3);
      root := root^.Next;
    end;
    writeln('>');
  end;
 
var
  i: integer;
  root: PList;
begin
  randomize;
  root := nil;
  ListShow(root);
  for i := 1 to 10 do
    ListAdd(root, i);
  ListShow(root);
  ListFree(root);
  ListShow(root);
end.

program tak;
 
type
  TInfo = integer;
  PList = ^TList;
 
  TList = record
    Info: TInfo;
    Next: PList;
  end;
 
  procedure ListAdd(var root: PList; info: TInfo);
  var
    p: PList;
    Last: PList;
  begin
    new(p);
    p^.Info := Info;
    p^.Next := nil;
    if Assigned(root) then
    begin
      Last := root;
      while Assigned(Last^.Next) do
        Last := Last^.Next;
      Last^.Next := p;
    end
    else
      root := p;
  end;
 
  procedure ListFree(var root: PList);
  var
    p: PList;
  begin
    while Assigned(root) do
    begin
      p := root;
      root := root^.Next;
      Dispose(p);
    end;
  end;
 
  procedure ListShow(root: PList);
  begin
    Write('<');
    while Assigned(root) do
    begin
      Write(root^.Info: 3);
      root := root^.Next;
    end;
    writeln('>');
  end;
 
  function ListGetPointerByIndex(root: PList; aIndex: integer): PList;
  begin
    if aIndex <= 0 then
      root := nil;
    while Assigned(root) do
    begin
      if aIndex = 1 then
        break;
      Dec(aIndex);
      root := root^.Next;
    end;
    ListGetPointerByIndex := root;
  end;
 
  function ListInsert(var root: PList; IndexI, IndexJ: integer): boolean;
  var
    ItemI, ItemJ, ItemNew: PList;
  begin
    ItemI := ListGetPointerByIndex(root, IndexI);
    ItemJ := ListGetPointerByIndex(root, IndexJ);
    if Assigned(ItemI) and Assigned(ItemJ) then
    begin
      new(ItemNew);
      ItemNew^.Info := ItemJ^.Info;
      ItemNew^.Next := ItemI^.Next;
      ItemI^.Next := ItemNew;
    end;
    ListInsert := Assigned(ItemI) and Assigned(ItemJ);
  end;
 
var
  i: integer;
  root: PList;
begin
  root := nil;
  ListShow(root);
  for i := 1 to 10 do
    ListAdd(root, i);
  ListShow(root);
  if ListInsert(root, 10, 10) then
    writeln('ListInsert - Ok!')
  else
    writeln('ListInsert - fault');
  ListShow(root);
  ListFree(root);
end.