Huffman Compression Engine
LHA/LZH is a freeware compression utility and associated file format

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategória: KMP (Klub mladých programátorov)

Program: Lzh.pas
Súbor exe: Lzh.exe
Potrebné: Lzhasm.objLz.pasLzo.pasTestlzo.pasTplzh.docLzh.zip

Huffman Compression Engine
LHA/LZH is a freeware compression utility and associated file format. It was created in 1988 by Haruyasu Yoshizaki (Yoshizaki Haruyasu?), and originally named LHarc. A complete rewrite of LHarc, tentatively named LHx, was eventually released as LH. It was then renamed to LHA to avoid conflicting with the then-new MS-DOS 5.0 LH ("load high") command. According to early documentation, LHA is pronounced like La.
LHA/LZH on wikipedia
{ LZ.PAS                                                               }
{ LHA/LZH is a freeware compression utility and associated file format.}
{ It was created in 1988 by Haruyasu Yoshizaki (Yoshizaki Haruyasu?),  }
{ and originally named LHarc. A complete rewrite of LHarc, tentatively }
{ named LHx, was eventually released as LH. It was then renamed to LHA }
{ to avoid conflicting with the then-new MS-DOS 5.0 LH ("load high")   }
{ command. According to early documentation, LHA is pronounced like La.}
{                                                                      }
{ Datum: 31.07.1993                              http://www.trsek.com  }
 
program LZH_Test;
{$A+,B-,D+,E+,F+,I-,L-,N-,R-,S-,V-}
{$M 1024,60000,60000}
{$IFDEF LZOVL}
uses
  overlay,LZH;
{$ELSE}
uses
  LZH;
{$ENDIF}
 
 
var
  infile,outfile: file;
  s: String[60];
  Hufmode : boolean;
 
  procedure Error (msg: String);
  begin
    writeln(msg);
    HALT(1)
  end;
 
{$F+}
 
  procedure ReadNextBlock; {This routine handles reading of input data}
 
  begin
    If Hufmode then write(LZHMem^.textsize,#13);
    {    LZHMem^.inptr:= 0;  }
    BlockRead(infile,LZHMem^.inbuf,sizeof(LZHMem^.inbuf),LZHMem^.inend);
    if IoResult>0 then Error('! Error reading input file');
  end;
 
  procedure WriteNextBlock; {This routine handles reading of output data}
  var
    wr: word;
  begin
    BlockWrite(outfile,LZHMem^.outbuf,LZHMem^.outptr,wr);
    If Not Hufmode then write(LZHMem^.count,#13);
    if (IoResult>0) or (wr<LZHMem^.outptr) then
       Error('! Error writing output file');
{    LZHMem^.outptr:= 0;}
  end;
 
  procedure OpenInput (fn: String);
  begin
    assign(infile,fn); reset(infile,1);
    if IoResult>0 then Error('! Can''t open input file');
  end;
 
  procedure OpenOutput (fn: String);
  begin
 
    assign(outfile,fn); rewrite(outfile,1);
    if IoResult>0 then Error('! Can''t open output file');
    LZHMem^.outend:= sizeof(LZHMem^.Outbuf);
    {LZHMem^.outptr:= 0;}
  end;
 
Var
   test : Word;
   RData  : Byte;
 
begin
{$IFDEF LZOVL}
 
     {Read only, deny none}
     OVRFilemode := 64;
     S := ParamStr(0);
     Delete (S,Length(S)-2,3);
     S := S+'OVR';
     OvrInit(s);
{$ENDIF}
     Hufmode := false;
{$IFDEF LZOVL}
     Writeln ('Huffman Compression Engine v',EngineVer,'{$O+}');
 
{$ELSE}
     Writeln ('Huffman Compression Engine v',EngineVer);
{$ENDIF}
     if ParamCount<>3 then begin
        writeln('Usage: lz e(ncode)|d(ecode) infile outfile');
        HALT(1);
     end;
     WriteFromBuffer:= WriteNextBlock;
     ReadToBuffer:= ReadNextBlock;
     InitLZH;    {This routine should be called before any LZHMem calls}
 
     OpenInput(ParamStr(2));
     OpenOutput(ParamStr(3));
     s:= ParamStr(1);
     case s[1] of
          'e','E': Begin
                        Hufmode := true;
                        LZHMem^.Ebytes:= filesize(infile);
                        Writeln (LZHMem^.Ebytes);
                        Encode;     {Call black box routine to compress}
                        Writeln ('input:  ', LZHMem^.textsize, ' bytes');
                        Writeln ('output: ', LZHMem^.codesize, ' bytes');
                        Writeln ('relative output: ', LZHMem^.codesize*100 div LZHMem^.textsize, '%');
 
                        End;
     'd','D': Decode   {Call routine to decompress}
   else
     Error('! Use [D] for Decode or [E] for Encode')
   end;
   close(infile); if IoResult>0 then Error('! Error closing input file');
   close(outfile); if IoResult>0 then Error('! Error closing output file');
   DInitLZH;
 
   end.