Списки

program Project1;
 
type
  {Тип основных данных.}
  TData = String;
  {Тип, описывающий указатель на элемент.}
  TPElem = ^TElem;
  {Тип, описывающий элемент списка.}
  TElem = record
    Data : TData;   {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент.}
  end;
  {Тип, описывающий список.}
  TDList = record
    PFirst, PLast : TPElem; {Указатели на первый и на последний элементы списка.}
  end;
 
{Процедуры для работы со списком.}
 
{Начальная инициализация списка. Внимание! Эту процедуру можно выполнять
только в отношении пустого списка. Иначе будут утечки памяти.}
procedure Init(var aL : TDList);
begin
  aL.PFirst := nil;
  aL.PLast := nil;
end;
 
{Освобождение памяти, занятой для элементов списка и инициализация.}
procedure LFree(var aL : TDList);
var
  P, PDel : TPElem;
begin
  P := aL.PFirst; {Указатель на первый элемент списка.}
  while P <> nil do
  begin
    PDel := P; {Запоминаем указатель на текущий элемент.}
    P := P^.PNext; {Получаем указатель на следующий элемент.}
    Dispose(PDel); {Освобождаем память, занятую текущим элементом списка.}
  end;
  Init(aL);
end;
 
{Добавление элемента в конец списка.}
procedure Add(var aL : TDList; const aData : TData);
var
  P : TPElem;
begin
  New(P); {Выделяем паямять для элемента.}
  P^.Data := aData; {Записываем данные.}
  P^.PNext := nil; {Обнуляем указатель на следующий элемент, т. к., элемент станет последним в списке.}
  if aL.PFirst = nil then {Если список пуст, то новый элемент станет первым элементом списка.}
    aL.PFirst := P
  else {Если список непустой, то новый элемент прикрепляем к последнему элементу списка.}
    aL.PLast^.PNext := P;
  aL.PLast := P; {Новый элемент становится последним элементом списка.}
end;
 
{Распечатка списка.}
procedure LWriteln(const aL : TDList);
var
  P : TPElem;
begin
  P := aL.PFirst; {Указатель на первый элемент списка.}
  if P <> nil then
  repeat
    if P <> aL.PFirst then {Если это не первый элемент, то ставим перед ним запятую.}
      Write(', ');
    Write('"', P^.Data, '"'); {Распечатываем данные текущего элемента.}
    P := P^.PNext; {Получаем указатель на следующий элемент.}
  until P = nil
  else
    Write('Список пуст.');
  Writeln;
end;
 
{Рекурсивная процедура для записи элементов списка в файл в прямом порядке.}
procedure ListForToFile(const aPElem : TPElem; var aF : Text);
begin
  if aPElem <> nil then
  begin
    Write(aF, aPElem^.Data); {Запись в файл текущего элемента списка.}
    {Если это не последний элемент списка (и, соответственно, не последний элемент файла),
    то в файле после него добавляем переход на следующую строку.}
    if aPElem^.PNext <> nil then
      Writeln(aF);
    {Рекурсивный вызов для записи в файл следующего элемента списка.}
    ListForToFile(aPElem^.PNext, aF);
  end;
end;
 
{Рекурсивная процедура для записи элементов списка в файл в обратном порядке.}
procedure ListRevToFile(const aPElem : TPElem; var aF : Text);
begin
  if aPElem <> nil then
  begin
    {Рекурсивный вызов для записи в файл следующего элемента списка.}
    ListRevToFile(aPElem^.PNext, aF);
    {Если это не последний элемент списка (и, соответственно, не первый элемент файла),
    то в файле перед ним добавляем переход на следующую строку.}
    if aPElem^.PNext <> nil then
      Writeln(aF);
    Write(aF, aPElem^.Data); {Запись в файл текущего элемента списка.}
  end;
end;
 
const
  FileNameFor = 'file_for.txt';
  FileNameRev = 'file_rev.txt';
var
  F : Text;
  L : TDList;
  Data : TData;
  i, Cnt : Integer;
  S : String;
begin
  Init(L); {Начальная инициализация списка.}
 
  repeat
    Writeln('----------');
    {Создаём список.}
    Write('Задайте количество элементов: ');
    Readln(Cnt);
    for i := 1 to Cnt do
    begin
      Write('Элемент N ', i, ': ');
      Readln(Data);
      Add(L, Data);
    end;
    Writeln('Задан список:');
    LWriteln(L);
 
    Assign(F, FileNameFor);
    Rewrite(F);
    ListForToFile(L.PFirst, F);
    Close(F);
    Writeln('Элементы списка записаны в файл ', FileNameFor, ' в прямом порядке.');
 
    Assign(F, FileNameRev);
    Rewrite(F);
    ListRevToFile(L.PFirst, F);
    Close(F);
    Writeln('Элементы списка записаны в файл ', FileNameRev, ' в обратном порядке.');
 
    LFree(L); {Освобождение памяти, занятой для элементов списка.}
    Writeln('Память, выделенная для списка, освобождена.');
 
    Writeln('Повторить - Enter, выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.