Динамический однонаправленный список. Удаление элементов из списка. - Delphi - Ответ 2832648

program Project1;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils, Windows;
 
type
  //Тип указателя на элемент списка.
  TPElem = ^TElem;
  //Тип элемента списка.
  TElem = record
    Data : String;
    PNext : TPElem; //Указатель на следующий элемент списка.
  end;
  //Тип, описывающий однонаправленный список.
  TList = record
    PFirst : TPElem; //Указатель на первый элемент списка.
    PLast : TPElem; //Указатель на последний элемент списка.
  end;
 
//Начальная инициализация списка. Внимание! Эту процедуру можно выполнять
//только в отношении пустого списка! Иначе - будут утечки памяти.
procedure Init(var aList : TList);
begin
  aList.PFirst := nil;
  aList.PLast := nil;
end;
 
//Добавление элемента в конец однонаправленного списка.
procedure AddL(var aList : TList; const aPElem : TPElem);
begin
  if aPElem = nil then Exit;
 
  aPElem^.PNext := nil;
  if aList.PFirst = nil then
    aList.PFirst := aPElem
  else
    aList.PLast^.PNext := aPElem
  ;
  aList.PLast := aPElem;
end;
 
(*
Исключение элемента из однонаправленного списка по указателю
на предыдущий элемент.
Функция возвращает указатель на элемент, который исключён из списка.
Если указатель на предыдущий элемент равен NIL, то исключается первый
элемент списка.
Эта функция только исключает элемент из списка. Если, кроме этого
требуется удалить элемент из памяти, тогда надо выполнить вызов
Dispose() за пределами процедуры.*)
function Del(var aList : TList; var aPPrev : TPElem) : TPElem;
begin
  Result := nil;
  if aList.PFirst = nil then Exit;
 
  if aPPrev = nil then begin
    Result := aList.PFirst;
    aList.PFirst := Result^.PNext;
  end else begin
    Result := aPPrev^.PNext;
    if Result <> nil then aPPrev^.PNext := Result^.PNext;
  end;
  if aList.PLast = Result then aList.PLast := aPPrev;
end;
 
//Удаление однонаправленного списка из памяти и инициализация.
procedure ListFree(var aList : TList);
var
  PNext, PDel : TPElem;
begin
  if aList.PFirst = nil then Exit;
 
  PNext := aList.PFirst;
  while PNext <> nil do begin
    PDel := PNext;
    PNext := PNext^.PNext;
    Dispose(PDel);
  end;
  aList.PFirst := nil;
  aList.PLast := nil;
end;
 
//Распечатка однонаправленного списка.
procedure ListPrint(const aList : TList);
var
  PElem : TPElem;
  i : Integer;
begin
  if aList.PFirst = nil then begin
    Writeln('Список пуст.');
    Exit;
  end;
 
  PElem := aList.PFirst;
  i := 0;
  while PElem <> nil do begin
    Inc(i);
    if i > 1 then Write(', ');
    Write(PElem^.Data);
    PElem := PElem^.PNext;
  end;
  Writeln;
end;
 
var
  L : TList;
  PElem, PPrev, PDel : TPElem;
  i : Integer;
  S : String;
begin
  //Переключение окна консоли на кодовую страницу CP1251 (Win-1251).
  //Если после переключения русские буквы показываются неверно,
  //следует открыть системное меню консольного окна - щелчком мыши в левом
  //верхнем углу окна консоли и выбрать:
  //Свойства - закладка "Шрифт" - выбрать шрифт: "Lucida Console".
  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);
 
  //Начальная инициализация списка.
  Init(L);
 
  repeat
    //Создание списока.
    Writeln('Создание списка.');
    Writeln('Прекратить ввод - пустая строка + Enter.');
    i := 0;
    repeat
      Write('Элемент ', i + 1, ': ');
      Readln(S);
      if S = '' then Continue;
      Inc(i);
      New(PElem);
      PElem^.Data := S;
      AddL(L, PElem);
    until S = '';
    Writeln('Составлен список:');
    ListPrint(L);
 
    Writeln('Задайте имя, которое следует удалить из списка:');
    Readln(S);
    //Удаляем из списка все элементы с заданным текстом.
    PPrev := nil; //Указатель на предыдущий элемент.
    PElem := L.PFirst; //Указатель на текущий элемент.
    while PElem <> nil do begin
      if PElem^.Data = S then begin //Удаление элемента и переход к следующему.
        PDel := Del(L, PPrev);
        PElem := PDel^.PNext;
        Dispose(PDel);
      end else begin //Переход к следующему элементу.
        PPrev := PElem;
        PElem := PElem^.PNext;
      end;
    end;
 
    Writeln('Cписок после удаления:');
    ListPrint(L);
 
    //Удаление списка из памяти.
    ListFree(L);
    Writeln('Список удалён из памяти. Работа завершена.');
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.