              ⭮⥫쭮 ⮤ 㯠 .
         -
N.B.   ᬠਢ ⮫쪮  ந騥 ᦠ⨥  ,
      .. ᪠騥 ⠭ 室 ଠ樨 "  ".

 Running -   ᠬ ⮩   ⮤ 㯠 ଠ樨 . ।
               ப ⥪,    ப ⮨ 40 ஡.
  筮 饩 ଠ樨.  ஡ ᦠ ⮩ ப
蠥  祭  -   40  ஡ ( 40  ) ᦨ  3  
 㯠   ⮤  ᨬ (running).  ,
騩    40  ஡   ᦠ⮩  ப , 䠪᪨  㤥  
஡ ( ᫥⥫쭮 뫠  ஡ ) . ன  - ᯥ樠
 "䫠"  㪠뢠    ࠧ ।騩  ப
   ᫥⥫쭮    ⠭  ப . ⨩  - 
 (  襬 砥  㤥 40 ).   ᠬ  , 筮
⮡  ࠧ,    ᫥⥫쭮     3- 
ᨬ,     ᠭ  ᫥⥫쭮 , ⮡  室
  ଠ樨 訩  ࠧ,   ᪠騩  ⠭
ଠ樨  室 .
      ⠢  ᪠  ⨭ ,    ,    
⮤ ᭮ ஡  롮 ⮣ ᠬ  "䫠", ⠪ 
 ॠ    ଠ樨    ࠢ  ᯮ  256 ਠ⮢
     257 ਠ - "䫠".      
஡  ࠧ訬 ,       稪 ,    
⠢  ஢   ⬠ 䬠 ( Huffman ).

 LZW   -     ⮣ ⬠ 稭  㡫   1977 .
           .  ( J. Ziv )  .  ( A. Lempel )   ୠ
" ଠ樮 ⥮ਨ "   " IEEE  Trans ".   ᫥⢨ 
   ࠡ⠭  . 祬 ( Terry A. Welch )   ⥫쭮
ਠ ࠦ   " IEEE Compute "   1984 .  ⮩   -
뢠  ஡ ⬠    騥 ஡  묨 
⮫   ॠ樨.     稫   - LZW
( Lempel - Ziv - Welch ) .
     LZW ।⠢ ᮡ  ஢ ᫥⥫쭮⥩
 ᨬ. 쬥  ਬ ப " ꥪ TSortedCollection
஦  TCollection.".    ப   ,  ᫮
"Collection"    .  ⮬ ᫮ 10 ᨬ - 80 .  ᫨
 ᬮ   ᫮    室 䠩,  ஬  祭, 
뫪  ࢮ 祭,  稬 ᦠ⨥ ଠ樨. ᫨ ᬠਢ
室  ଠ樨 ࠧ஬   64  ࠭  -
 ப  256 ᨬ,  뢠  "䫠" 稬,  ப  80
   8+16+8 = 32 .  LZW - "砥"  
ᦠ 䠩. ᫨    騥  ப  䠩 ,   
஢  ⠡. 祢  २⢮ ⬠  , 
  室    ⠡ ஢  ᦠ 䠩. 㣮 
ᮡ  ,  ᦠ⨥   LZW  室
樥    ⨢    䬠 ( Huffman ) ,  ஬
ॡ  室.

 Huffman - 砫   ᮧ 䠩   ࠧ஢  室
             ஢  ᫥⥫쭮⥩  ᪫祭  ⮢
㤥    祩.      ⠢ ᥡ ᤥ ᪮쪮
⢥  ᨫ       䬠 ( Huffman ).   ⠪
 ६  ਮ⥬   ⥫쭮   ᪠.
        䠩    䬠 ࢮ    ᤥ - 
室    䠩      ᪮쪮 ࠧ 砥
  ᨬ    ७    ASCII. ᫨  㤥 뢠 
256 ᨬ,       㤥 ࠧ  ᦠ⨨ ⥪⮢  EXE 䠩.

᫥      宦   ᨬ, 室 ᬮ
⠡    ASCII    ନ஢         
뢠.         ⮭宦   ᨬ  ⠡ 
  ஢  ⠡  뫮     뢠.  뫪 
᫥ ⠡  "㧫".   쭥襬 (  ॢ )  㤥 
ࠧ  㪠⥫      㪠뢠    "㧥".  ᭮
 ᬮਬ ਬ:
          䠩      100   騩 6 ࠧ ᨬ 
ᥡ .   ⠫  宦      ᨬ    䠩   稫
᫥饥 :
        Ŀ
             c        A    B    C    D    E    F  
        Ĵ
         ᫮ 宦   10   20   30   5    25   10 
        
         ६    ᫠   㤥 뢠  ⮩ 宦
  ᨬ. ⨬ ⠡  .
        Ŀ
             c        C    E    B    F    A    D  
        Ĵ
         ᫮ 宦   30   25   20   10   10   5  
        
      쬥  ᫥ ⠡  ᨬ  襩 ⮩.  襬
砥    D (5)    ᨬ  F  A (10),    
 ਬ A.
    ନ㥬  "㧫" D  A  "㧥",  宦  ண
㤥 ࠢ 㬬  D  A :

            30    10     5     10     20     25
             C     A     D      F      B      E
                               
                          
                            Ŀ
                            15  = 5 + 10
                            
         ࠬ - 㬬  ᨬ D  A.   ᭮ 饬 
ᨬ  ᠬ묨   ⠬ 宦. ᪫  ᬮ D  A 
ᬠਢ      "㧥"  㬬୮ ⮩ 宦. 
    ⥯   F   "㧫".  ᤥ  ᫨ﭨ
㧫 :

            30    10     5     10     20     25
             C     A     D      F      B      E
                                     
                                     
                           Ŀ      
                          Ĵ15      
                                   
                                      
                                 Ŀ 
                             Ĵ25 = 10 + 15
                                  
     ᬠਢ ⠡ ᭮  ᫥  ᨬ ( B  E ).
 த   ०   "ॢ"  ନ஢, ..  
 ᢥ   㧫.

            30    10     5     10     20     25
             C     A     D      F      B      E
                                                
                                                
                          Ŀ                  
                         Ĵ15                  
                                              
                                                 
                                Ŀ        Ŀ 
                            Ĵ25      Ĵ45
                                           
                        Ŀ                   
                    Ĵ55             
                                             
                              Ŀ    
                           Ĵ Root (100) 
                               

        ॢ ᮧ,   ஢ 䠩 .  
ᥭ 筨    ( Root ) .   ᨬ ( ॢ )
 ᫥    ॢ   ⢥  ᫨   
,   0- ,  筮 1-    ࠢ .
  C,  㤥    55 (   0 ), ⥬ ᭮  (0)
 ᠬ  ᨬ .   䬠  襣 ᨬ C - 00.  ᫥饣
ᨬ (  )      砥 - ,ࠢ,, ,  뫨 
᫥⥫쭮 0100. 믮   ᪠   ᨬ 稬

   C = 00   ( 2  )
   A = 0100 ( 4  )
   D = 0101 ( 4  )
   F = 011  ( 3  )
   B = 10   ( 2  )
   E = 11   ( 2  )

      ᨬ 砫쭮 ।⠢ 8- ⠬ (   ),  ⠪
  㬥訫 ᫮ ⮢ 室  ।⠢  ᨬ,
 ᫥⥫쭮  㬥訫  ࠧ  室  䠩 . ⨥  ᪫뢥
᫥騬 ࠧ :
       Ŀ
            ࢮ砫쭮   㯫⭥   㬥襭  
       Ĵ
         C 30      30 x 8 = 240      30 x 2 = 60          180     
         A 10      10 x 8 =  80      10 x 3 = 30           50     
         D 5        5 x 8 =  40       5 x 4 = 20           20     
         F 10      10 x 8 =  80      10 x 4 = 40           40     
         B 20      20 x 8 = 160      20 x 2 = 40          120     
         E 25      25 x 8 = 200      25 x 2 = 50          150     
       
     ࢮ砫 ࠧ 䠩 : 100  - 800 ;
             ᦠ⮣ 䠩 :  30  - 240 ;

       240 - 30%  800 , ⠪   ᦠ  䠩  70%.

       쭮 ,  ⭮ 室  ⮬ 䠪,  
⠭ ࢮ砫쭮 䠩,      饥 ॢ,
⠪  ॢ  ࠧ  ࠧ 䠩 .  ⥫쭮   
࠭  ॢ      䠩 .  ॢ頥  ⮣  㢥祭
ࠧ஢ 室 䠩 .
      襩  ⮤  ᦠ      㧫 室 4  㪠⥫,
 ⮬,  ⠡  256  㤥 ਡ⥫쭮 1   .

      襬  ਬ    5 㧫  6 設 (   室
  ᨬ  ) , ᥣ 11 . 4    11  ࠧ - 44 . ᫨   ᫥
讥  ⢮  ⮢    ࠭  㧫   
⨪ -   ⠡  㤥 ਡ⥫쭮 50 ⮢ .
        30 ⠬ ᦠ⮩ ଠ樨, 50 ⮢ ⠡ 砥, 
     娢   䠩       80   .  뢠 , 
ࢮ砫쭠    䠩    ᬠਢ ਬ 뫠 100  - 
稫 20% ᦠ⨥ ଠ樨.
      .       ⢨⥫쭮 믮 - ࠭ ᨬ쭮
ASCII            ॡ騩  襥 ⢮  
ࠢ  ⠭.
         ⮬  ?
    ᬮਬ  ᨬ         ࠧ ࠧ來
  ⨬쭮 ॢ, ஥  ᨬ.
     稬    ⮫쪮 :
                 4 - 2 ࠧ來 ;
                 8 - 3 ࠧ來 ;
                16 - 4 ࠧ來 ;
                32 - 5 ࠧ來 ;
                64 - 6 ࠧ來 ;
               128 - 7 ࠧ來 ;

     室   8 ࠧ來 .
                 4 - 2 ࠧ來 ;
                 8 - 3 ࠧ來 ;
                16 - 4 ࠧ來 ;
                32 - 5 ࠧ來 ;
                64 - 6 ࠧ來 ;
               128 - 7 ࠧ來 ;
             --------
               254

     ⠪      ⮣     256  ࠧ  権  묨  
஢   .      権    2     ࠢ 8 ⠬.
᫨    ᫮  ᫮  ⮢    ।⠢,   ⮣ 稬
1554   195 ⮢.    ᨬ㬥 ,  ᦠ 256   195  33%,
⠪  ࠧ  ᨬ쭮  ஢ Huffman  ⨣ ᦠ
 33%  ᯮ  ஢  .
           ந   䨪  䬠 ..
,    ஢ 筮. ਬ  A - 01011 
 B - 0101 . ᫨  㤥    ⭮,  稢  0101
    ᬮ ᪠    稫 A  B , ⠪  ᫥騩 
      砫  ᫥饣  , ⠪  த ।饣.
     室  ,    祬  ஥ 䨪  㦨
筮  ୮  ॢ    ᫨ ⥫쭮 ᬮ ।騩 ਬ
  ஥  ॢ ,    㡥 ,      砥    ⠬
䨪.
       ᫥  ਬ砭 -   䬠 ॡ  室
䠩   ,   ࠧ      宦  ᨬ , 㣮  ࠧ
ந ।⢥ ஢.

P.S.               "稪"  饬 ண  Running.
----    ⠢  ଠ  Huffman ஢ 㬠
         ⥬,   襬 ୮ ॢ    257
        ⨪.

 :
------------
1)  ᠭ 娢 Narc   Infinity Design Concepts, Inc.;
2)   ,'⨥ ', " ",N2 1991;

{$A+,B-,D+,E+,F-,G-,I-,L+,N-,O-,R+,S+,V+,X-}
{$M 16384,0,655360}
{******************************************************}
{*          㯫⭥   ⮤       *}
{*                     䬠.                       *}
{******************************************************}
Program Hafman;

Uses Crt,Dos,Printer;

Type    PCodElement = ^CodElement;
        CodElement = record
                      NewLeft,NewRight,
                      P0, P1 : PCodElement;   { 室騩 ६}
                      LengthBiteChain : byte; {  ᨢ , ।  ॢ }
                      BiteChain : word;
                      CounterEnter : word;
                      Key : boolean;
                      Index : byte;
                     end;

        TCodeTable = array [0..255] of PCodElement;

Var     CurPoint,HelpPoint,
        LeftRange,RightRange : PCodElement;
        CodeTable : TCodeTable;
        Root : PCodElement;
        InputF, OutputF, InterF : file;
        TimeUnPakFile : longint;
        AttrUnPakFile : word;
        NumRead, NumWritten: Word;
        InBuf  : array[0..10239] of byte;
        OutBuf : array[0..10239] of byte;
        BiteChain : word;
        CRC,
        CounterBite : byte;
        OutCounter : word;
        InCounter : word;
        OutWord : word;
        St : string;
        LengthOutFile, LengthArcFile : longint;
        Create : boolean;
        NormalWork : boolean;
        ErrorByte : byte;
        DeleteFile : boolean;
{-------------------------------------------------}

procedure ErrorMessage;
{ --- 뢮 ᮮ饭  訡 --- }
begin
 If ErrorByte <> 0 then
  begin
   Case ErrorByte of
    2 : Writeln('File not found ...');
    3 : Writeln('Path not found ...');
    5 : Writeln('Access denied ...');
    6 : Writeln('Invalid handle ...');
    8 : Writeln('Not enough memory ...');
   10 : Writeln('Invalid environment ...');

   11 : Writeln('Invalid format ...');
   18 : Writeln('No more files ...');
   else Writeln('Error #',ErrorByte,' ...');
   end;
   NormalWork:=False;
   ErrorByte:=0;
  end;
end;

procedure ResetFile;
{ --- ⨥ 䠩  娢樨 --- }
Var St : string;
begin
  Assign(InputF, ParamStr(3));
  Reset(InputF, 1);
  ErrorByte:=IOResult;
  ErrorMessage;
  If NormalWork then Writeln('Pak file : ',ParamStr(3),'...');
end;

procedure ResetArchiv;
{ --- ⨥ 䠩 娢,   ᮧ --- }
begin
  St:=ParamStr(2);
  If Pos('.',St)<>0 then Delete(St,Pos('.',St),4);
  St:=St+'.vsg';
  Assign(OutputF, St);
  Reset(OutPutF,1);
  Create:=False;
  If IOResult=2 then
   begin
    Rewrite(OutputF, 1);
    Create:=True;
   end;
  If NormalWork then
   If Create then Writeln('Create archiv : ',St,'...')
    else Writeln('Open archiv : ',St,'...')
end;

procedure SearchNameInArchiv;
{ ---  쭥襬 -   䠩  娢 --- }
begin
 Seek(OutputF,FileSize(OutputF));
 ErrorByte:=IOResult;
 ErrorMessage;
end;

procedure DisposeCodeTable;
{ --- 㭨⮦  ⠡  । --- }
Var I : byte;
begin
 For I:=0 to 255 do Dispose(CodeTable[I]);
end;

procedure ClosePakFile;
{ --- ⨥ 娢㥬 䠩 --- }
Var I : byte;
begin
 If DeleteFile then Erase(InputF);

 Close(InputF);
end;

procedure CloseArchiv;
{ --- ⨥ 娢 䠩 --- }
begin
 If FileSize(OutputF)=0 then Erase(OutputF);
 Close(OutputF);
end;

procedure InitCodeTable;
{ --- 樠 ⠡ ஢ --- }
Var I : byte;
begin
 For I:=0 to 255 do
  begin
    New(CurPoint);
    CodeTable[I]:=CurPoint;
    With CodeTable[I]^ do
     begin
      P0:=Nil;
      P1:=Nil;
      LengthBiteChain:=0;
      BiteChain:=0;
      CounterEnter:=1;
      Key:=True;
      Index:=I;
     end;
  end;
 For I:=0 to 255 do
  begin
   If I>0 then CodeTable[I-1]^.NewRight:=CodeTable[I];
   If I<255 then CodeTable[I+1]^.NewLeft:=CodeTable[I];
  end;
 LeftRange:=CodeTable[0];
 RightRange:=CodeTable[255];
 CodeTable[0]^.NewLeft:=Nil;
 CodeTable[255]^.NewRight:=Nil;
end;

procedure SortQueueByte;
{ --- 쪮 ஢  ⠭ --- }
Var Pr1,Pr2 : PCodElement;
begin
 CurPoint:=LeftRange;
 While CurPoint <> RightRange do
  begin
   If CurPoint^.CounterEnter > CurPoint^.NewRight^.CounterEnter then
    begin
     HelpPoint:=CurPoint^.NewRight;
     HelpPoint^.NewLeft:=CurPoint^.NewLeft;
     CurPoint^.NewLeft:=HelpPoint;
     If HelpPoint^.NewRight<>Nil then HelpPoint^.NewRight^.NewLeft:=CurPoint;
     CurPoint^.NewRight:=HelpPoint^.NewRight;
     HelpPoint^.NewRight:=CurPoint;
     If HelpPoint^.NewLeft<>Nil then HelpPoint^.NewLeft^.NewRight:=HelpPoint;
     If CurPoint=LeftRange then LeftRange:=HelpPoint;
     If HelpPoint=RightRange then RightRange:=CurPoint;
     CurPoint:=CurPoint^.NewLeft;

     If CurPoint = LeftRange then CurPoint:=CurPoint^.NewRight
      else CurPoint:=CurPoint^.NewLeft;
    end
    else CurPoint:=CurPoint^.NewRight;
  end;
end;

procedure CounterNumberEnter;
{ ---   宦 ⮢   --- }
Var C : word;
begin
 For C:=0 to NumRead-1 do
  Inc(CodeTable[(InBuf[C])]^.CounterEnter);
end;

function SearchOpenCode : boolean;
{ ---   ।    Key  祭 --- }
begin
 CurPoint:=LeftRange;
 HelpPoint:=LeftRange;
 HelpPoint:=HelpPoint^.NewRight;
 While not CurPoint^.Key do
  CurPoint:=CurPoint^.NewRight;
 While (not (HelpPoint=RightRange)) and (not HelpPoint^.Key) do
  begin
   HelpPoint:=HelpPoint^.NewRight;
   If (HelpPoint=CurPoint) and (HelpPoint<>RightRange) then
    HelpPoint:=HelpPoint^.NewRight;
  end;
 If HelpPoint=CurPoint then SearchOpenCode:=False else SearchOpenCode:=True;
end;

procedure CreateTree;
{ --- ᮧ ॢ  宦 --- }
begin
 While SearchOpenCode do
  begin
   New(Root);
   With Root^ do
    begin
     P0:=CurPoint;
     P1:=HelpPoint;
     LengthBiteChain:=0;
     BiteChain:=0;
     CounterEnter:=P0^.CounterEnter + P1^.CounterEnter;
     Key:=True;
     P0^.Key:=False;
     P1^.Key:=False;
    end;
   HelpPoint:=LeftRange;
   While (HelpPoint^.CounterEnter < Root^.CounterEnter) and
    (HelpPoint<>Nil) do HelpPoint:=HelpPoint^.NewRight;
   If HelpPoint=Nil then {    }
    begin
     Root^.NewLeft:=RightRange;
     RightRange^.NewRight:=Root;
     Root^.NewRight:=Nil;
     RightRange:=Root;
    end

   else
    begin { ⠢ । HelpPoint }
     Root^.NewLeft:=HelpPoint^.NewLeft;
     HelpPoint^.NewLeft:=Root;
     Root^.NewRight:=HelpPoint;
     If Root^.NewLeft<>Nil then Root^.NewLeft^.NewRight:=Root;
    end;
  end;
end;

procedure ViewTree( P : PCodElement );
{ --- ᬮ ॢ   ᢠ ஢ 楯  --- }
Var Mask,I : word;
begin
 Inc(CounterBite);
 If P^.P0<>Nil then ViewTree( P^.P0 );
 If P^.P1<>Nil then
  begin
   Mask:=(1 SHL (16-CounterBite));
   BiteChain:=BiteChain OR Mask;
   ViewTree( P^.P1 );
   Mask:=(1 SHL (16-CounterBite));
   BiteChain:=BiteChain XOR Mask;
  end;
 If (P^.P0=Nil) and (P^.P1=Nil) then
  begin
   P^.BiteChain:=BiteChain;
   P^.LengthBiteChain:=CounterBite-1;
  end;
 Dec(CounterBite);
end;

procedure CreateCompressCode;
{ --- 㫥 ६   ᬮ ॢ  設 --- }
begin
 BiteChain:=0;
 CounterBite:=0;
 Root^.Key:=False;
 ViewTree(Root);
end;

procedure DeleteTree;
{ --- 㤠 ॢ --- }
Var P : PCodElement;
begin
 CurPoint:=LeftRange;
 While CurPoint<>Nil do
  begin
   If (CurPoint^.P0<>Nil) and (CurPoint^.P1<>Nil) then
    begin
     If CurPoint^.NewLeft <> Nil then
      CurPoint^.NewLeft^.NewRight:=CurPoint^.NewRight;
     If CurPoint^.NewRight <> Nil then
      CurPoint^.NewRight^.NewLeft:=CurPoint^.NewLeft;
     If CurPoint=LeftRange then LeftRange:=CurPoint^.NewRight;
     If CurPoint=RightRange then RightRange:=CurPoint^.NewLeft;
     P:=CurPoint;
     CurPoint:=P^.NewRight;
     Dispose(P);
    end

   else CurPoint:=CurPoint^.NewRight;
  end;
end;

procedure SaveBufHeader;
{ ---     娢 --- }
Type
      ByteField = array[0..6] of byte;
Const
      Header : ByteField = ( $56, $53, $31, $00, $00, $00, $00 );
begin
 If Create then
  begin
   Move(Header,OutBuf[0],7);
   OutCounter:=7;
  end
 else
  begin
   Move(Header[3],OutBuf[0],4);
   OutCounter:=4;
  end;
end;

procedure SaveBufFATInfo;
{ ---    ᥩ ଠ樨  䠩 --- }
Var I : byte;
    St : PathStr;
    R : SearchRec;
begin
 St:=ParamStr(3);
 For I:=0 to Length(St)+1 do
  begin
   OutBuf[OutCounter]:=byte(Ord(St[I]));
   Inc(OutCounter);
  end;
 FindFirst(St,$00,R);
 Dec(OutCounter);
 Move(R.Time,OutBuf[OutCounter],4);
 OutCounter:=OutCounter+4;
 OutBuf[OutCounter]:=R.Attr;
 Move(R.Size,OutBuf[OutCounter+1],4);
 OutCounter:=OutCounter+5;
end;

procedure SaveBufCodeArray;
{ --- ࠭ ᨢ  宦  娢 䠩 --- }
Var I : byte;
begin
 For I:=0 to 255 do
  begin
   OutBuf[OutCounter]:=Hi(CodeTable[I]^.CounterEnter);
   Inc(OutCounter);
   OutBuf[OutCounter]:=Lo(CodeTable[I]^.CounterEnter);
   Inc(OutCounter);
  end;
end;

procedure CreateCodeArchiv;
{ --- ᮧ  ᦠ --- }
begin
 InitCodeTable;      { 樠  ⠡                      }
 CounterNumberEnter; {  ᫠ 宦                   }
 SortQueueByte;      { c஢  ⠭ ᫠ 宦          }
 SaveBufHeader;      { ࠭  娢                  }
 SaveBufFATInfo;     { ࠭ FAT ଠ  䠩                }
 SaveBufCodeArray;   { ࠭ ᨢ  宦  娢 䠩 }
 CreateTree;         { ᮧ ॢ                              }
 CreateCompressCode; { c  ᦠ                               }
 DeleteTree;         { 㤠 ॢ                              }
end;

procedure PakOneByte;
{ --- ᦠ⨥  뫪  室    --- }
Var Mask : word;
    Tail : boolean;
begin
 CRC:=CRC XOR InBuf[InCounter];
 Mask:=CodeTable[InBuf[InCounter]]^.BiteChain SHR CounterBite;
 OutWord:=OutWord OR Mask;
 CounterBite:=CounterBite+CodeTable[InBuf[InCounter]]^.LengthBiteChain;
 If CounterBite>15 then Tail:=True else Tail:=False;
 While CounterBite>7 do
  begin
   OutBuf[OutCounter]:=Hi(OutWord);
   Inc(OutCounter);
   If OutCounter=(SizeOf(OutBuf)-4) then
    begin
     BlockWrite(OutputF,OutBuf,OutCounter,NumWritten);
     OutCounter:=0;
    end;
   CounterBite:=CounterBite-8;
   If CounterBite<>0 then OutWord:=OutWord SHL 8 else OutWord:=0;
  end;
 If Tail then
  begin
   Mask:=CodeTable[InBuf[InCounter]]^.BiteChain SHL
   (CodeTable[InBuf[InCounter]]^.LengthBiteChain-CounterBite);
   OutWord:=OutWord OR Mask;
  end;
 Inc(InCounter);
 If (InCounter=(SizeOf(InBuf))) or (InCounter=NumRead) then
  begin
   InCounter:=0;
   BlockRead(InputF,InBuf,SizeOf(InBuf),NumRead);
  end;
end;

procedure PakFile;
{ --- 楤 ।⢥ ᦠ 䠩 --- }
begin
 ResetFile;
 SearchNameInArchiv;
 If NormalWork then
  begin
   BlockRead(InputF,InBuf,SizeOf(InBuf),NumRead);
   OutWord:=0;

   CounterBite:=0;
   OutCounter:=0;
   InCounter:=0;
   CRC:=0;
   CreateCodeArchiv;
   While (NumRead<>0) do PakOneByte;
   OutBuf[OutCounter]:=Hi(OutWord);
   Inc(OutCounter);
   OutBuf[OutCounter]:=CRC;
   Inc(OutCounter);
   BlockWrite(OutputF,OutBuf,OutCounter,NumWritten);
   DisposeCodeTable;
   ClosePakFile;
  end;
end;

procedure ResetUnPakFiles;
{ --- ⨥ 䠩  ᯠ --- }
begin
 InCounter:=7;
 St:='';
 repeat
  St[InCounter-7]:=Chr(InBuf[InCounter]);
  Inc(InCounter);
 until InCounter=InBuf[7]+8;
 Assign(InterF,St);
 Rewrite(InterF,1);
 ErrorByte:=IOResult;
 ErrorMessage;
 If NormalWork then
  begin
   WriteLn('UnPak file : ',St,'...');
   Move(InBuf[InCounter],TimeUnPakFile,4);
   InCounter:=InCounter+4;
   AttrUnPakFile:=InBuf[InCounter];
   Inc(InCounter);
   Move(InBuf[InCounter],LengthArcFile,4);
   InCounter:=InCounter+4;
  end;
end;

procedure CloseUnPakFile;
{ --- ⨥ 䠩  ᯠ --- }
begin
 If not NormalWork then Erase(InterF)
  else
   begin
    SetFAttr(InterF,AttrUnPakFile);
    SetFTime(InterF,TimeUnPakFile);
   end;
 Close(InterF);
end;

procedure RestoryCodeTable;
{ --- ᮧ  ⠡  娢 䠩 --- }
Var I : byte;
begin
 InitCodeTable;
 For I:=0 to 255 do

  begin
   CodeTable[I]^.CounterEnter:=InBuf[InCounter];
   CodeTable[I]^.CounterEnter:=CodeTable[I]^.CounterEnter SHL 8;
   Inc(InCounter);
   CodeTable[I]^.CounterEnter:=CodeTable[I]^.CounterEnter+InBuf[InCounter];
   Inc(InCounter);
  end;
end;

procedure UnPakByte( P : PCodElement );
{ --- ᯠ   --- }
Var Mask : word;
begin
 If (P^.P0=Nil) and (P^.P1=Nil) then
  begin
   OutBuf[OutCounter]:=P^.Index;
   Inc(OutCounter);
   Inc(LengthOutFile);
   If OutCounter = (SizeOf(OutBuf)-1) then
    begin
     BlockWrite(InterF,OutBuf,OutCounter,NumWritten);
     OutCounter:=0;
    end;
  end
 else
  begin
   Inc(CounterBite);
   If CounterBite=9 then
    begin
     Inc(InCounter);
     If InCounter = (SizeOf(InBuf)) then
      begin
       InCounter:=0;
       BlockRead(OutputF,InBuf,SizeOf(InBuf),NumRead);
      end;
     CounterBite:=1;
    end;
   Mask:=InBuf[InCounter];
   Mask:=Mask SHL (CounterBite-1);
   Mask:=Mask OR $FF7F; { ⠭  ⮢ ஬ 襣 }
   If Mask=$FFFF then UnPakByte(P^.P1)
    else UnPakByte(P^.P0);
  end;
end;

procedure UnPakFile;
{ --- ᯠ  䠩 --- }
begin
 BlockRead(OutputF,InBuf,SizeOf(InBuf),NumRead);
 ErrorByte:=IOResult;
 ErrorMessage;
 If NormalWork then ResetUnPakFiles;
 If NormalWork then
  begin
   RestoryCodeTable;
   SortQueueByte;
   CreateTree;                   { ᮧ ॢ  }
   CreateCompressCode;
   CounterBite:=0;

   OutCounter:=0;
   LengthOutFile:=0;
   While LengthOutFile<LengthArcFile do
    UnPakByte(Root);
   BlockWrite(InterF,OutBuf,OutCounter,NumWritten);
   DeleteTree;
   DisposeCodeTable;
  end;
 CloseUnPakFile;
end;

{ ------------------------- main text ------------------------- }
begin
 DeleteFile:=False;
 NormalWork:=True;
 ErrorByte:=0;
 WriteLn;
 WriteLn('ArcHaf version 1.0  (c) Copyright VVS Soft Group, 1992.');
 ResetArchiv;
 If NormalWork then
  begin
   St:=ParamStr(1);
   Case St[1] of
    'a','A' : PakFile;
    'm','M' : begin
               DeleteFile:=True;
               PakFile;
              end;
    'e','E' : UnPakFile;
    else ;
   end;
  end;
 CloseArchiv;
end.
