home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 7 / 07.iso / c / c019 / 5.ddi / LZH.ZIP / LZHTEST.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1993-05-08  |  2.7 KB  |  131 lines
  1. Program LZHTest;
  2.  
  3.  
  4. { This is a demo program to illstrate the use of the LZH unit.
  5.   it implements a very simple 1 file at a time compressor program.
  6.  
  7.  
  8.   Author : Douglas P. Webb
  9. }
  10.  
  11.  
  12. uses LZH;
  13.  
  14. CONST
  15.   MaxBuf = 4096;     { Must be bigger than the biggest chunk being asked for. }
  16.  
  17.  
  18. Type
  19.   BufType = Array[1..MaxBuf] OF BYTE;
  20.   BufPtr = ^BufType;
  21.  
  22.  
  23. VAR
  24.   InBuf,OutBuf : BufPtr;
  25.   infile,Outfile : FILE;
  26.   s : STRING;
  27.   Bytes_Written : LongInt;
  28.   Size : LongInt;
  29.   Temp : WORD;
  30.  
  31.  
  32. {$F+}
  33.  
  34. Procedure GetBlock(VAR Target; NoBytes:Word; VAR Actual_Bytes:Word);
  35. CONST
  36.   Posn : Word = 1;
  37.   Buf : Word = 0;
  38.  
  39. VAR
  40.   Temp:Word;
  41.  
  42. BEGIN
  43.   IF (Posn > Buf) OR (Posn + NoBytes > SUCC(Buf)) THEN
  44.     BEGIN
  45.       IF Posn > Buf THEN
  46.         BEGIN
  47.           BlockRead(InFile,InBuf^,MaxBuf,Buf);
  48.           Write('+');
  49.         END
  50.       ELSE
  51.         BEGIN
  52.           Move(InBuf^[Posn],InBuf^[1],Buf-Posn);
  53.           BlockRead(InFile,InBuf^[Buf-Posn],MaxBuf-(Buf-Posn),Temp);
  54.           Buf := Buf-Posn+Temp;
  55.           Write('+');
  56.         END;
  57.       IF Buf = 0 THEN
  58.         BEGIN
  59.           Actual_Bytes := 0;
  60.           Writeln;
  61.           Exit;
  62.         END;
  63.       Posn := 1;
  64.     END;
  65.   Move(InBuf^[Posn],Target,NoBytes);
  66.   INC(Posn,NoBytes);
  67.   IF Posn > SUCC(Buf) THEN
  68.     Actual_Bytes := NoBytes -(Posn-SUCC(Buf))
  69.   ELSE Actual_Bytes := NoBytes;
  70. END;
  71.  
  72.  
  73. Procedure PutBlock(VAR Source; NoBytes:Word; VAR Actual_Bytes:Word);
  74. CONST
  75.   Posn : Word= 1;
  76.  
  77. VAR
  78.   Temp:Word;
  79.  
  80. BEGIN
  81.   If NoBytes = 0 THEN    { Flush condition }
  82.     BEGIN
  83.       BlockWrite(OutFile,OutBuf^,PRED(Posn),Temp);
  84.       EXIT;
  85.     END;
  86.   IF (Posn > MaxBuf) OR (Posn + NoBytes > SUCC(MaxBuf)) THEN
  87.     BEGIN
  88.       BlockWrite(OutFile,OutBuf^,PRED(Posn),Temp);
  89.       Posn := 1;
  90.     END;
  91.   Move(Source,OutBuf^[Posn],NoBytes);
  92.   INC(Posn,NoBytes);
  93.   Actual_Bytes := NoBytes;
  94. END;
  95.  
  96.  
  97. {$F-}
  98.  
  99. BEGIN
  100.   IF (paramcount <> 3) THEN
  101.     BEGIN
  102.       Writeln('Usage:lzhuf e(compression)|d(uncompression) infile outfile');
  103.       halt(1);
  104.     END;
  105.   s := paramstr(1);
  106.   IF NOT (s[1] IN ['D','E','d','e']) THEN
  107.     Halt(1);
  108.   Assign(infile,paramstr(2));
  109.   reset(infile,1);
  110.   Assign(outfile,Paramstr(3));
  111.   Rewrite(outfile,1);
  112.   New(InBuf);
  113.   New(OutBuf);
  114.   IF (upcase(s[1]) = 'E') THEN
  115.     BEGIN
  116.        Size := Filesize(InFile);
  117.        BlockWrite(OutFile,Size,Sizeof(LongInt));
  118.        LZHPack(Bytes_Written,GetBlock,PutBlock);
  119.        PutBlock(Size,0,Temp);
  120.     END
  121.   ELSE
  122.     BEGIN
  123.       BlockRead(Infile,Size,Sizeof(LongInt));
  124.       LZHUnPack(Size,GetBlock,PutBlock);
  125.       PutBlock(Size,0,Temp);
  126.     END;
  127.   Dispose(OutBuf);
  128.   Dispose(InBuf);
  129.   Close(Infile);
  130.   Close(OutFile);
  131. END.