Сортировка связанного списка

programnoname;

type
  PData = ^TData;
  TData = record


    next: PData;
    Name: string[40];
    { ...другие поля данных }
  end;

var
  root: PData; { это указатель на первую запись в связанном списке }

procedure InsertRecord(var root: PData; pItem: PData);
{ вставляем запись, на которую указывает pItem в список начиная
с root и с требуемым порядком сортировки }
var
  pWalk, pLast: PData;
begin
  if root = nil then
  begin
    { новый список все еще пуст, просто делаем запись,
    чтобы добавить root к новому списку }
    root := pItem;
    root^.next := nil
  end { If }
  else
  begin
    { проходимся по списку и сравниваем каждую запись с одной
    включаемой. Нам необходимо помнить последнюю запись,
    которую мы проверили, причина этого станет ясна немного позже. }
    pWalk := root;
    pLast := nil;

    { условие в следующем цикле While определяет порядок сортировки!
    Это идеальное место для передачи вызова функции сравнения,
    которой вы передаете дополнительный параметр InsertRecord для
    осуществления общей сортировки, например:

    While CompareItems( pWalk, pItem ) < 0 Do Begin
    where
    Procedure InsertRecord( Var list: PData; CompareItems: TCompareItems );
    and
    Type TCompareItems = Function( p1,p2:PData ): Integer;
    and a sample compare function:
    Function CompareName( p1,p2:PData ): Integer;
    Begin
    If p1^.Name < p2^.Name Then
    CompareName := -1
    Else
    If p1^.Name > p2^.Name Then
    CompareName := 1
    Else
    CompareName := 0;
    End;
    }
    while pWalk^.Name < pItem^.Name do
      if pWalk^.next = nil then
      begin
        { мы обнаружили конец списка, поэтому добавляем
        новую запись и выходим из процедуры }
        pWalk^.next := pItem;
        pItem^.next := nil;
        Exit;
      end { If }
      else
      begin
        { следующая запись, пожалуйста, но помните,
        что одну мы только что проверили! }
        pLast := pWalk;

        { если мы заканчиваем в этом месте, то значит мы нашли
        в списке запись, которая >= одной включенной. Поэтому
        вставьте ее перед записью, на которую в настоящий момент
        указывает pWalk, которая расположена после pLast. }
        if pLast = nil then
        begin
          { Упс, мы вывалились из цикла While на самой первой итерации!
          Новая запись должна располагаться в верхней части списка,
          поэтому она становится новым корнем (root)! }
          pItem^.next := root;
          root := pItem;
        end { If }
        else
        begin
          { вставляем pItem между pLast и pWalk }
          pItem^.next := pWalk;
          pLast^.next := pItem;
        end; { Else }
        { мы сделали это! }
      end; { Else }
  end; { InsertRecord }

procedure SortbyName(var list: PData);
var

  newtree, temp, stump: PData;
begin { SortByName }

  { немедленно выходим, если сортировать нечего }
  if list = nil then
    Exit;
  { в
  newtree := Nil;}

  {********
  Сортируем, просто беря записи из оригинального списка и вставляя их
  в новый, по пути "перехватывая" для определения правильной позиции в
  новом дереве. Stump используется для компенсации различий списков.
  temp используется для указания на запись, перемещаемую из одного
  списка в другой.
  ********}
  stump := list;
  while stump <> nil do
  begin
    { временная ссылка на перемещаемую запись }
    temp := stump;
    { "отключаем" ее от списка }
    stump := stump^.next;
    { вставляем ее в новый список }
    InsertRecord(newtree, temp);
  end; { While }

  { теперь помещаем начало нового, сортированного
  дерева в начало старого списка }
  list := newtree;
end; { SortByName }
begin

  New(root);
  root^.Name := 'BETA';
  New(root^.next);
  root^.next^.Name := 'ALPHA';
  New(root^.next^.next);
  root^.next^.next^.Name := 'Torture';

  WriteLn(root^.name);
  WriteLn(root^.next^.name);
  WriteLn(root^.next^.next^.name);
end.