Описать и проверить процедуру или функцию, которая вставляет в список L за первым вхождением элемента Е все элементы списка L1, если Е входит в L1.

type
  {Тип основных данных.}
  TData = Integer;
  {Тип указателя на элемент списка.}
  TPElem = ^TElem;
  {Тип элемента списка.}
  TElem = record
    Data : TData; {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент списка.}
  end;
  {Тип, описывающий однонаправленный список.}
  TDList = record
    PFirst, PLast : TPElem; {Указатели на первый и на последний элементы списка.}
  end;

{Решение задачи.
Вставить в список L1 за первым вхождением элемента Е все элементы списка L2,
если Е входит в L2.
Если список L2 вставлен в список L1, то функция возвращает порядковый
номер первого элемента E в первом списке.
В противном случае, функция возвращает значение = 0.}
function Proc(var aL1, aL2 : TDList; const aE : TData) : Integer;
var
  PElem, PE : TPElem;
  Res : Integer;
begin
  Result := 0;
  {Ищем в первом списке первый элемент со значением E.}
  Res := 0; {Порядковый номер найденного элемента.}
  PE := aL1.PFirst; {Указатель на текущий элемент списка.}
  while (PE <> nil) and (PE^.Data <> aE) do begin
    Inc(Res);
    PE := PE^.PNext; {Получаем указатель на следующий элемент списка.}
  end;
  {Если элемент E найден в первом списке.}
  if PE <> nil then begin
    {Проверяем, присутствует ли элемент E во втором списке.}
    PElem := aL2.PFirst;
    while (PElem <> nil) and (PElem^.Data <> aE) do
      PElem := PElem^.PNext;
    {Если элемент E найден во втором списке, то вставляем второй список
    после элемента E в первом списке.}
    if PElem <> nil then begin
      aL2.PLast^.PNext := PE^.PNext;
      PE^.PNext := aL2.PFirst;
      Init(aL2);
      Result := Res;
    end;
  end;
end;

program Project1;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils, Windows;
 
type
  {Тип основных данных.}
  TData = Integer;
  {Тип указателя на элемент списка.}
  TPElem = ^TElem;
  {Тип элемента списка.}
  TElem = record
    Data : TData; {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент списка.}
  end;
  {Тип, описывающий однонаправленный список.}
  TDList = record
    PFirst, PLast : TPElem; {Указатели на первый и на последний элементы списка.}
  end;
 
{Начальная инициализация списка. Внимание! Эту процедуру можно выполнять
только в отношении пустого списка! Иначе - будут утечки памяти.}
procedure Init(var aList : TDList);
begin
  aList.PFirst := nil;
  aList.PLast := nil;
end;
 
{Добавление элемента в конец однонаправленного списка.}
procedure Add(var aList : TDList; const aData : TData);
var
  PElem : TPElem;
begin
  New(PElem); {Выделяем память для нового элемента.}
  PElem^.Data := aData; {Запись основных данных.}
  {Указатель на следующий элемент равен nil, т. к. это последний элемент в списке.}
  PElem^.PNext := nil;
  {Если список пуст, то новый элемент становится первым элементом списка.}
  if aList.PFirst = nil then
    aList.PFirst := PElem
  {Если список непустой, то новый элемент прикрепляется к последнему элементу списка.}
  else
    aList.PLast^.PNext := PElem;
  aList.PLast := PElem; {Новый элемент становится последним элементом списка.}
end;
 
{Особождение памяти, занятой под список.}
procedure LFree(var aList : TDList);
var
  PNext, PDel : TPElem;
begin
  PNext := aList.PFirst;
  while PNext <> nil do begin
    PDel := PNext;
    PNext := PNext^.PNext;
    Dispose(PDel);
  end;
  Init(aList);
end;
 
{Распечатка однонаправленного списка.}
procedure LWriteln(const aList : TDList);
var
  PElem : TPElem;
begin
  if aList.PFirst = nil then
    Write('Список пуст.')
  else begin
    PElem := aList.PFirst;
    while PElem <> nil do begin
      if PElem <> aList.PFirst then Write(', ');
      Write(PElem^.Data);
      PElem := PElem^.PNext;
    end;
  end;
  Writeln;
end;
 
{Диалог добавления элементов в список.}
procedure WorkAdd(var aL : TDList);
var
  S : String;
  i : Integer;
  Data : TData;
begin
  Writeln('Прекратить ввод - пустая строка + Enter.');
  i := 0;
  repeat
    Write('Новый элемент ', i + 1, ': ');
    Readln(S);
    if S <> '' then begin
      if TryStrToInt(S, Data) then begin
        Inc(i);
        Add(aL, Data);
      end else
        Writeln('Неверный ввод! Повторите.');
    end;
  until S = '';
end;
 
{Решение задачи.
Вставить в список L1 за первым вхождением элемента Е все элементы списка L2,
если Е входит в L2.
Если список L2 вставлен в список L1, то функция возвращает порядковый
номер первого элемента E в первом списке.
В противном случае, функция возвращает значение = 0.}
function Proc(var aL1, aL2 : TDList; const aE : TData) : Integer;
var
  PElem, PE : TPElem;
  Res : Integer;
begin
  Result := 0;
  {Ищем в первом списке первый элемент со значением E.}
  Res := 0; {Порядковый номер найденного элемента.}
  PE := aL1.PFirst; {Указатель на текущий элемент списка.}
  while (PE <> nil) and (PE^.Data <> aE) do begin
    Inc(Res);
    PE := PE^.PNext; {Получаем указатель на следующий элемент списка.}
  end;
  {Если элемент E найден в первом списке.}
  if PE <> nil then begin
    {Проверяем, присутствует ли элемент E во втором списке.}
    PElem := aL2.PFirst;
    while (PElem <> nil) and (PElem^.Data <> aE) do
      PElem := PElem^.PNext;
    {Если элемент E найден во втором списке, то вставляем второй список
    после элемента E в первом списке.}
    if PElem <> nil then begin
      aL2.PLast^.PNext := PE^.PNext;
      PE^.PNext := aL2.PFirst;
      Init(aL2);
      Result := Res;
    end;
  end;
end;
 
var
  L1, L2 : TDList;
  E : TData;
  Res : Integer;
  F : Boolean;
  S : String;
begin
  {Переключение окна консоли на кодовую страницу CP1251 (Win-1251).
  Если после переключения русские буквы показываются неверно,
  следует открыть системное меню консольного окна - щелчком мыши в левом
  верхнем углу окна консоли и выбрать:
  Свойства - закладка "Шрифт" - выбрать шрифт: "Lucida Console".}
  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);
 
  {Начальная инициализация списков.}
  Init(L1);
  Init(L2);
 
  repeat
    Writeln('Добавление элементов в первый список.');
    WorkAdd(L1);
    Writeln('Составлен список:');
    LWriteln(L1);
    Write('Для продолжения нажмите Enter. ');
    Readln;
 
    Writeln('Добавление элементов во второй список.');
    WorkAdd(L2);
    Writeln('Составлен список:');
    LWriteln(L2);
    Write('Для продолжения нажмите Enter. ');
    Readln;
 
    repeat
      Write('Задайте значение искомого элемента (E): ');
      Readln(S);
      F := TryStrToInt(S, E);
      if not F then
        Writeln('Неверный ввод! Повторите.');
    until F;
 
    {Решение задачи.}
    Res := Proc(L1, L2, E);
 
    if Res > 0 then begin
      Writeln('Элемент найден в первом списке. Его порядковый номер: ', Res);
      Writeln('После найденного элемента вставлен второй список.');
    end
    else begin
      Writeln('Искомый элемент в первом списке не обнаружен.');
      Writeln('Первый список остался без изменений.');
    end;
    Writeln('Первый список:');
    LWriteln(L1);
 
    {Освобождение памяти, занятой под списки.}
    LFree(L1);
    LFree(L2);
    Writeln('Память, занятая под списки, освобождена.');
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.