home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / t / tplzh025.zip / LZ.PAS < prev    next >
Pascal/Delphi Source File  |  1993-02-24  |  3KB  |  117 lines
  1. program LZH_Test;
  2. {$A+,B-,D+,E+,F+,I-,L-,N-,R-,S-,V-}
  3. {$M 1024,60000,60000}
  4. {$IFDEF LZOVL}
  5. uses
  6.   overlay,LZH;
  7. {$ELSE}
  8. uses
  9.   LZH;
  10. {$ENDIF}
  11.  
  12.  
  13. var
  14.   infile,outfile: file;
  15.   s: String[60];
  16.   Hufmode : boolean;
  17.  
  18.   procedure Error (msg: String);
  19.   begin
  20.     writeln(msg);
  21.     HALT(1)
  22.   end;
  23.  
  24. {$F+}
  25.  
  26.   procedure ReadNextBlock; {This routine handles reading of input data}
  27.  
  28.   begin
  29.     If Hufmode then write(LZHMem^.textsize,#13);
  30.     {    LZHMem^.inptr:= 0;  }
  31.     BlockRead(infile,LZHMem^.inbuf,sizeof(LZHMem^.inbuf),LZHMem^.inend);
  32.     if IoResult>0 then Error('! Error reading input file');
  33.   end;
  34.  
  35.   procedure WriteNextBlock; {This routine handles reading of output data}
  36.   var
  37.     wr: word;
  38.   begin
  39.     BlockWrite(outfile,LZHMem^.outbuf,LZHMem^.outptr,wr);
  40.     If Not Hufmode then write(LZHMem^.count,#13);
  41.     if (IoResult>0) or (wr<LZHMem^.outptr) then
  42.        Error('! Error writing output file');
  43. {    LZHMem^.outptr:= 0;}
  44.   end;
  45.  
  46.   procedure OpenInput (fn: String);
  47.   begin
  48.     assign(infile,fn); reset(infile,1);
  49.     if IoResult>0 then Error('! Can''t open input file');
  50.   end;
  51.  
  52.   procedure OpenOutput (fn: String);
  53.   begin
  54.  
  55.     assign(outfile,fn); rewrite(outfile,1);
  56.     if IoResult>0 then Error('! Can''t open output file');
  57.     LZHMem^.outend:= sizeof(LZHMem^.Outbuf);
  58.     {LZHMem^.outptr:= 0;}
  59.   end;
  60.  
  61. Var
  62.    test : Word;
  63.    RData  : Byte;
  64.  
  65. begin
  66. {$IFDEF LZOVL}
  67.  
  68.      {Read only, deny none}
  69.      OVRFilemode := 64;
  70.      S := ParamStr(0);
  71.      Delete (S,Length(S)-2,3);
  72.      S := S+'OVR';
  73.      OvrInit(s);
  74. {$ENDIF}
  75.      Hufmode := false;
  76. {$IFDEF LZOVL}
  77.      Writeln ('Huffman Compression Engine v',EngineVer,'{$O+}');
  78.  
  79. {$ELSE}
  80.      Writeln ('Huffman Compression Engine v',EngineVer);
  81. {$ENDIF}
  82.      if ParamCount<>3 then begin
  83.         writeln('Usage: lz e(ncode)|d(ecode) infile outfile');
  84.         HALT(1);
  85.      end;
  86.      WriteFromBuffer:= WriteNextBlock;
  87.      ReadToBuffer:= ReadNextBlock;
  88.      InitLZH;    {This routine should be called before any LZHMem calls}
  89.      OpenInput(ParamStr(2));
  90.      OpenOutput(ParamStr(3));
  91.      s:= ParamStr(1);
  92.      case s[1] of
  93.           'e','E': Begin
  94.                         Hufmode := true;
  95.                         LZHMem^.Ebytes:= filesize(infile);
  96.                         Writeln (LZHMem^.Ebytes);
  97.                         Encode;     {Call black box routine to compress}
  98.                         Writeln ('input:  ', LZHMem^.textsize, ' bytes');
  99.                         Writeln ('output: ', LZHMem^.codesize, ' bytes');
  100.                         Writeln ('relative output: ', LZHMem^.codesize*100 div LZHMem^.textsize, '%');
  101.  
  102. {                        writeln('input:  ',LZHMem^.textsize,' bytes');
  103.                         writeln('output: ',LZHMem^.codesize,' bytes');
  104.                         writeln('compression: ',LZHMem^.textsize*100 DIV LZHMem^.codesize,'%');}
  105.  
  106.                         End;
  107.      'd','D': Decode   {Call routine to decompress}
  108.    else
  109.      Error('! Use [D] for Decode or [E] for Encode')
  110.    end;
  111.    close(infile); if IoResult>0 then Error('! Error closing input file');
  112.    close(outfile); if IoResult>0 then Error('! Error closing output file');
  113.    DInitLZH;
  114.  
  115.  
  116.    end.
  117.