program noname;
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.