Динамическая сортировка текста

uses crt;
const
  rAlf: string = 'аАбБвВгГдДеЕёЁжЖзЗиИйЙкКлЛмМнНоОпПрРсСтТуУфФхХцЦчЧшШщЩъЪыЫьЬэЭюЮяЯ';
 
type
  list = record
    clovo: string;
    info: integer;
    next: pointer;
  end;
  pointer = ^list;
 
{-------------------------------> Пузырёк <------------------------------------}
procedure SD_Bubble(var t: pointer);
var
  y, x: pointer;
  z: string;
  ii: integer;
begin
  New(x);
  y := t; 
  while y <> nil do
  begin
    x := y^.next;
    while x <> nil do
    begin
      if y^.info < x^.info then 
      begin
        z := x^.clovo;
        x^.clovo := y^.clovo;
        y^.clovo := z;
 
        ii := x^.info;
        x^.info := y^.info;
        y^.info := ii;
      end;
      if pos(y^.clovo[1], rAlf) > pos(x^.clovo[1], rAlf) then
      begin
        z := x^.clovo;
        x^.clovo := y^.clovo;
        y^.clovo := z;
        
        ii := x^.info;
        x^.info := y^.info;
        y^.info := ii;
      end;
      x := x^.next
    end;
    y := y^.next
  end;
end;
{-------------------------------> Добавление <---------------------------------}
procedure vXvost(s: string; var t: pointer);
var
  v: integer;
  y, z: pointer;
begin
  s[1] := Upcase(s[1]);
  New(y);
  y^.info := 1;
  y^.clovo := s;
  y^.next := nil;
  z := t;
  {----------------------> Проверка на Повтор и Счёт Слов <--------------------}
  while (z <> nil) do 
  begin
    if z^.clovo = y^.clovo then  
    begin z^.info := z^.info + y^.info;v := 1; end;
    z := z^.next;
  end;
  z := nil;
  if not (v = 1) then begin
    {----------------------------> Занос в Хвост <-------------------------------}
    if t = nil then t := y else
    begin
      z := t;
      while z^.next <> nil do z := z^.next;
      z^.next := y;
    end;
  end;
end;
{-------------------------------> ОСНОВНОЕ! <----------------------------------}
 
var
  f: text;
  slovo, stroka: string;
  i: integer;
  shead, q: pointer;
 
begin
  
  slovo := '';
  
  assign(f, 'infa200.txt');//<----------ОТКРЫЛ На Чтение!
  reset(f);
  while not eof(f) do
  begin
    readln(f, stroka);
    {-----------------------> РАЗБИЕНИЕ и ПОСЧЕТ СЛОВ <------------------------}
    for i := 1 to length(stroka) do
    begin
      if pos(stroka[i], rAlf) > 0 then
        slovo := slovo + stroka[i]
        else
      begin
        if length(slovo) > 0 then vXvost(slovo, shead);
        slovo := '';
      end;
    end;
    if not (slovo = '') then begin vXvost(slovo, shead);slovo := ''; end;
    {--------------------------------------------------------------------------}
  end;
  close(f);//<---------------ЗАКРЫЛ 
  
  SD_Bubble(shead);//<---------Булькаем...
  
  New(q);
  q := shead;//<-----------Захват Головы
  
  assign(f, 'Отсортировано!.txt');//<--------Создание!
  rewrite(f);
  while (q <> nil) do 
  begin
    writeln(f, q^.info, ' ', q^.clovo);
    q := q^.next;
  end;
  close(f);//<---------------ЗАКРЫЛ
  
  Dispose(q);
  
  assign(f, 'Отсортировано!.txt');//<--------Чтение!
  reset(f);
  while not eof(f) do
  begin
    readln(f, stroka); 
    writeln(stroka); 
  end;
  close(f);//<---------------ЗАКРЫЛ
  
end.