Объединить исходные списки, поместив все элементы первого списка после данного элемента А второго - PascalABC.NET

type
  TElem = integer;//тип данных 
  PNode = ^Node;//тип, описывающий указатель на элемент
  Node = record
    Element: TElem; //поле данных
    pNext: PNode; //прямой указатель
    pPrev: PNode; //обратный указатель
  End;
 
///Начальная инициализация и заполнение списков случайными числами
procedure Create(var pBegin: PNode; {var -- после процедуры должно быть начальное значение } a: byte);
var
  pAux: PNode;
  x: TElem;
begin
  New(pBegin);  // Заглавный элемент
  pAux := pBegin;
  pAux^.Element := random(100);
  ///pAux^.pNext := nil; -- сразу не нужен. Мы же не по одному элеименту добавляем.
  pAux^.pPrev := nil;
  ///write(pAux^.Element:4);
  while a - 1 > 0 do
    begin
      dec(a);
      New(pAux^.pNext);
      pAux^.pNext^.pPrev := pAux;
      pAux := pAux^.pNext;
      pAux^.Element := random(100);
      ///write(pAux^.Element:4);
      ///pAux^.pNext := nil;
    end;
  pAux^.pNext := nil; /// -- а вот за последним ни кого не будет!
end;
 
procedure OutList(List : PNode);
begin
  if List = nil then
    begin
      WriteLn('пусто');
      Exit;
    end;
    
  repeat
    Print(List^.Element);
    List := List^.pNext;
  until List = nil;
  WriteLn;
end;
 
var
  len1, len2: byte;//длины первого и второго списков
  pBegin1, pBegin2: PNode;// Ссылка на первый элемент
 
begin
  Randomize; /// -- Достаточно одного раза
  
  len1 := 4; create(pbegin1, len1); /// Заполнение первого списка
  len2 := 5; create(pbegin2, len2); /// Заполнение второго списка
  
  /// Вывод списков
  writeln('Элементы первого списка:'); OutList(pBegin1);
  writeln('Элементы второго списка:'); OutList(pBegin2);
  
  /// ---------- Здесь реализуем вставку ----------
  var A := ReadLnInteger('Введите номер элемента второго списка, после которого поместить в него первый: A =');
  if (A < 1) or (A > len2) then
    begin
      WriteLn('Во втором списке нет элемента с номером ', A);
      Halt;
    end;
  
  /// Ищем указанный номер от начала второго списка
  var i := A;
  var Cur : PNode := pBegin2;
  while (i > 1) and (Cur <> nil) do
    begin
      i -= 1; Cur := Cur^.pNext;
    end;
    
  /// Ищем „хвост“ первого списка
  var Last : PNode := pBegin1;
  if Last = nil then
    begin
      WriteLn('Первый список пуст. Вставлять не чего!');
      Halt;
    end;
  while Last^.pNext <> nil do Last := Last^.pNext;
  
  /// Произведём вставку в разрыв между Cur и следющим:
  if Cur^.pNext <> nil then
    begin
      Cur^.pNext^.pPrev := Last; /// Предыдущий в разрыве - это хвост первого
      Last^.pNext := Cur^.pNext; /// Следующий за хвостом первого - следующий в разрыве
    end;
  Cur^.pNext := pBegin1; /// За разрывом - голова первого
  pBegin1^.pPrev := Cur; /// Перед головой первого - текущий в разрыве
  
  len2 += len1;
  len1 := 0; pBegin1 := nil; /// Первый исчез
  WriteLn('Произведена вставка первого списка после элемента ', A, ' второго.');
  
  /// Вывод результата
  writeln('Элементы первого списка:'); OutList(pBegin1);
  writeln('Элементы второго списка:'); OutList(pBegin2);
end.