Внешняя сортировка. Естественное слияние.

[Fireblade-fan]

Нужно написать программу, которая бы упорядочивала строки файла в порядке убывания длинны строк. Нашел в интернете процедуру, переделал под свой вариант, но она не работает чёт. (( Подскажите где ошибка здесь?

{$APPTYPE CONSOLE}
Program L10_9;
{sortirovka}


var
 f:text;
 s:string;

Procedure Create (var f:textfile);
var i,j,kst,ksim:integer;
    s:string; c:char;
begin
  randomize;
  assign(f,'file.txt');
  rewrite(f);
  kst:=random(10)+20;
  writeln('кол-во строк = ',kst);
  for i:=1 to kst do
  begin
    ksim:=random(55)+1;
    for j:=1 to ksim do
    begin
      c:=chr(random(122-97+1)+97);
      s:=s+c;
    end;
    writeln(s);
    writeln(f,s);
    s:='';
  end;
end;

Procedure Sort(var f: text);
Var
 s1,s2,where: integer; a1,a2,tmp:string;
 f1,f2: text;
Begin
  s1:=5;
  s2:=5;
  Assign(f1,'f1.txt');
  Assign(f2,'f2.txt');
  While (s1>1) and (s2>=1) do
  begin
    where:=1;
    s1:=0;
    s2:=0;
    Reset(f);
    Rewrite(f1);
    Rewrite(f2);
    Readln(f,a1);
    Writeln(f1,a1);
    While not EOF(f) do
    begin
      readln(f,a2);
      If (a2<a1) then
      begin
        Case where of
          1: begin
            where:=2;
            inc(s1);
            End;
          2: begin
            where:=1;
            inc(s2);
            End;
        End;
      End;
      Case where of
        1: writeln(f1,a2);
        2: writeln(f2,a2);
      End;
      a1:=a2;
    End;
    If where=2 then
    inc(s2)
    else
    inc(s1);
    Close(f);
    Close(f1);
    Close(f2);
    Rewrite(f);
    Reset(f1);
    Reset(f2);
    Readln(f1,a1);
    Readln(f2,a2);
    While (not EOF(f1)) and (not EOF(f2)) do
    begin
      If (a1<=a2) then
      begin
        Writeln(f,a1);
        Readln(f1,a1);
      End
      else
      begin
        Writeln(f,a2);
        Readln(f2,a2);
      End;
    End;
    While not EOF(f1) do
    begin
      tmp:=a1;
      Readln(f1,a1);
      If not EOF(f1) then
      Writeln(f,tmp)
      else
      Writeln(f,tmp);
    End;
    While not EOF(f2) do
    begin
      tmp:=a2;
      Readln(f2,a2);
      If not EOF(f2) then
      Writeln(f,tmp)
      else
      Writeln(f,tmp);
    End;
    Close(f);
    Close(f1);
    Close(f2);
  End;
  Erase(f1);
  Erase(f2);
End;
 
 
begin
 create(f);
 Sort(f);
 write('fail otsortirovan');
 readln
end.

[Fireblade-fan]

ну скомпилируйте кто-нибудь, посмотрите плиз!! уже третьи сутки её делаю

[ACE Valery]

Скомпилируйте сами. И посмотрите. В чем проблема? Не упорядочивает? Частично упорядочивает? Вообще никак не изменяет исходные данные? Изменяет, но не правильно? Описание "неработоспособности" функции дайте.

[Fireblade-fan]

после выполнения программы, должен быть отсортированый файл. А у меня он не отсортировывается и плюс пропадает половина строк.