Найти ошибку.

[stas45rus]

Всем добрый вечер. Помогите пжл. наконец-то кто-нибудь найти ошибку в программе. Пять дней мучаюсь. Программа, при прямом обходе, выдаёт неправильный порядок чисел. Вот код:

Program Haffman;
Uses Crt;
Type
  Knot=^Pknot;
  Pknot=Record
         Counter:Longint;
         Symbol,Bit:Byte;
         Next,Right,Left:Knot;
        End;
Var
  P:Knot;
  f:File;
  r:Text;
  Ch:Char;
  St:String;
  i,Buf:Byte;
  s:Longint;

Procedure InsertList(Var P:Knot; s:Longint; i:Byte);
Begin
  If P=Nil Then
   begin
     New(P);
     P^.Counter:=s;
     P^.Symbol:=i;
     P^.Bit:=0;
     P^.Next:=Nil;
     P^.Right:=Nil;
     P^.Left:=Nil;
   end
  Else InsertList(P^.Next,s,i);
End;

Function Sortinglist(P:Knot):Knot;
Var
  X,N:Knot;
  s:Longint;
  i,m:Byte;
Begin
  X:=P;
  While X<>Nil Do
   Begin
     N:=X^.Next;
     While N<>Nil Do
      Begin
        If N^.Counter<X^.Counter Then
         Begin
           s:=N^.Counter;
           i:=N^.Symbol;
           m:=N^.Bit;
           N^.Counter:=X^.Counter;
           N^.Symbol:=X^.Symbol;
           N^.Bit:=X^.Bit;
           X^.Counter:=s;
           X^.Symbol:=i;
           X^.Bit:=m;
         End;
        N:=N^.Next;
      End;
     X:=X^.Next;
   End;
  Sortinglist:=X;
End;

Function AdditionList(P:Knot):Knot;
Var
  s:Longint;
  i:Byte;
  X,N:Knot;
Begin
  i:=0;
  While (P<>Nil) and (P^.Next<>Nil) Do
   begin
     s:=P^.Counter+P^.Next^.Counter;
     InsertList(P,s,i);
     X:=P;
     While X<>Nil Do
      begin
        N:=X;
        X:=X^.Next;
      end;
     New(N^.Right);
     N^.Right^.Counter:=P^.Next^.Counter;
     N^.Right^.Symbol:=P^.Next^.Symbol;
     N^.Right^.Bit:=1;
     N^.Right^.Next:=Nil;
     N^.Right^.Right:=P^.Next^.Right;
     N^.Right^.Left:=P^.Next^.Left;
     New(N^.Left);
     N^.Left^.Counter:=P^.Counter;
     N^.Left^.Symbol:=P^.Symbol;
     N^.Left^.Bit:=0;
     N^.Left^.Next:=Nil;
     N^.Left^.Right:=P^.Right;
     N^.Left^.Left:=P^.Left;
     SortingList(P);
     X:=P;
     N:=P^.Next;
     P:=P^.Next^.Next;
     Dispose(X);
     Dispose(N);
   end;
  AdditionList:=P;
End;

Procedure BypassList(P:Knot);
Begin
  If P<>Nil Then
   begin
     Writeln(r,P^.Counter:4,P^.Symbol:4,P^.Bit:4);
     BypassList(P^.Left);
     BypassList(P^.Right);
   end;
End;

Procedure Compression;
Begin
  P:=Nil;
  For i:=0 To 255 Do
   begin
     s:=0;
     While not(eof(f)) Do
      begin
        BlockRead(f,Buf,1);
        If i=Buf Then Inc(s);
      end;
     If eof(f) Then Seek(f,0);
     If s<>0 Then InsertList(P,s,i);
   end;
  SortingList(P);
  AdditionList(P);
  BypassList(P);
End;

Begin
 Clrscr;
 Writeln('Для архивации файла нажмите ''a''.');
 Writeln('Для распвковки файла нажмите ''r''.');
 Writeln('Для отмены нажмите любую клавишу.');
 Ch:=Readkey;
 Case Ch Of
   #97:Begin
         Writeln('Введите полный путь и имя файла:');
         Readln(st);
         Assign(f,st);
         Reset(f,1);
         If FileSize(f)=0 Then Writeln('Файл пуст!!!')
          Else
           Begin
             Assign(r,'D:\Kopiya.TXT');
             Rewrite(r);

             Compression;

             Close(r);
           End;
         Close(f);
       End;
  Else Halt;
 End; 
 Readln;
End.

[stas45rus]

неужели никто не может помочь???

[Mandrivnyk]

Procedure BypassList(P:Knot);
Begin
  If P<>Nil Then
   begin
     Writeln(r,P^.Counter:4,P^.Symbol:4,P^.Bit:4);
     BypassList(P^.Left);
     BypassList(P^.Right);
   end;
End;

Если не ошибаюсь, надо так:

     Writeln(r,P^.Counter:4,P^.Symbol:4,P^.Bit:4);
     BypassList(P^.Right);
     BypassList(P^.Left);

А то, что у тебя -- обратный обход...

[stas45rus]

А вот по - моему ты ошибаешься, а не я. То что я написал, это прямой обход. А при обратном Writeln ставится в конце. И ошибка тут не в этом, а именно, как я думаю, в формировании дерева.