Очередь строковых значений (через односвязные списки)

const
  st: array [1..7] of string = ('one', 'two', 'three', 'four', 'five', 'six', 'seven');
 
type
  //Указатель на элемент очереди.
  TPElem = ^TElem;
  //Элемент очереди.
  TElem = record
    Data: string; //Основные данные.
    PNext: TPElem; //Указатель на следующий элемент в очереди.
  end;
  //Очередь.
  TQueue = record
    PFirst, PLast: TPElem; //Указатель на первый и последний элементы очереди.
    Cnt: Integer; //Количество элементов в очереди.
  end;
 
//Инициализация очереди. Внимание! Нельзя выполнять эту процедуру в отношении
//непустой очереди! Иначе, произойдёт утечка памяти.
//Эту процедуру следует выполнять в самом начале программы.
procedure Init(var aQueue: TQueue);
begin
  aQueue.PFirst := nil;
  aQueue.PLast := nil;
  aQueue.Cnt := 0;
end;
 
//Добавление элемента в конец очереди.
procedure QueuePush(var aQueue: TQueue; var aPElem: TPElem);
begin
  if aPElem = nil then Exit;
  
  aPElem^.PNext := nil;
  if aQueue.PFirst = nil then
    aQueue.PFirst := aPElem
  else
    aQueue.PLast^.PNext := aPElem
  ;
  aQueue.PLast := aPElem;
  Inc(aQueue.Cnt);
end;
 
//Изъятие элемента из начала очереди.
function QueuePop(var aQueue: TQueue; var aPElem: TPElem): Boolean;
begin
  QueuePop := False;
  if aQueue.PFirst = nil then Exit;
  
  aPElem := aQueue.PFirst;
  aQueue.PFirst := aPElem^.PNext;
  if aQueue.PFirst = nil then aQueue.PLast := nil;
  Dec(aQueue.Cnt);
  QueuePop := True;
end;
 
//Удаление очереди из памяти (очистка очереди).
procedure QueueFree(var aQueue: TQueue);
var
  PDel: TPElem;
begin
  while QueuePop(aQueue, PDel) do Dispose(PDel);
end;
 
//Распечатка очереди.
procedure QueuePrint(var aQueue: TQueue);
var
  QTmp: TQueue;
  PElem: TPElem;
  i: Integer;
begin
  if aQueue.PFirst = nil then begin
    Writeln('Очередь пуста.');
    Exit;
  end;
  //Начальная инициализация вспомогательной очереди.
  Init(QTmp);
  //Переливаем элементы из исходной очереди во вспомогательную и при этом
  //выполняем распечатку.
  i := 0;
  while QueuePop(aQueue, PElem) do 
  begin
    //Добавление элемента во вспомогательную очередь.
    QueuePush(QTmp, PElem);
    //Распечатка.
    Inc(i);
    if i > 1 then Write(', ');
    Write(PElem^.Data);
  end;
  Writeln;
  
  aQueue := QTmp;
end;
 
const
  //Основа для выбора длины очереди.
  M = 10;
 
var
  Q1, Q2: TQueue;
  PElem: TPElem;
  k, i, j: Integer;
  S: String;
 
begin
  //Инициализация очередей.
  Init(Q1);
  for i := 1 to 7 do
  begin
    New(PElem);
    PElem^.Data := st[i];
    //      Добавьте в очередь строки 
    QueuePush(Q1, PElem);
  end;
  Writeln('Составлены очереди:');
  Writeln('Первая очередь. Количество элементов: ', Q1.Cnt, '. Элементы:');
  QueuePrint(Q1);
  for i := 1 to 4 do
    QueuePop(Q1, PElem);
  Writeln('Новая очередь. Количество элементов: ', Q1.Cnt, '. Элементы:');
  QueuePrint(Q1);
  New(PElem);
  PElem^.Data := 'eight';
  QueuePush(Q1, PElem);
  New(PElem);
  PElem^.Data := 'nine';
  QueuePush(Q1, PElem);
  Writeln('Еще одна новая очередь. Количество элементов: ', Q1.Cnt, '. Элементы:');
  j := Q1.Cnt;
  writeln(j);
  QueuePrint(Q1);    
  k := 0;
  for i := 1 to j do
  begin
    if length(PElem^.Data) = 4 then
      inc(k);
    QueuePop(Q1, PElem);      
  end;
  writeln('количество строк, состоящих из 4 символов: ', k);
  QueueFree(Q1);
end.