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.