home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 7 / 07.iso / c / c019 / 5.ddi / LZW.ZIP / LZWTEST.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1990-05-07  |  4.0 KB  |  135 lines
  1. PROGRAM PackTest;
  2.  
  3. USES CRT,DOS,DOUGPACK;
  4.  
  5.  
  6. { This is a very simple example program using the "Dougpack" unit.  All this
  7.    program does is allow you to compress 1 file, or decompress one file that
  8.    has been compressed using this program. }
  9.  
  10.  
  11.  
  12.  
  13. TYPE
  14.   Compression_Header_Type = RECORD                   { 21 bytes in size. }
  15.                                Name : String[12];
  16.                                COmpressed_Bytes : Longint;   { Doesn't include header.}
  17.                                Bits_Used : BYTE;
  18.                                Clear_After_Table_Full : BOOLEAN;
  19.                                CRC : WORD;
  20.                             END;
  21.  
  22.  
  23. VAR
  24.   Ch : Char;
  25.   Filename : String;
  26.   Dir : DirStr;
  27.   Name : NameStr;
  28.   Ext : ExtStr;
  29.   Header : Compression_Header_Type;
  30.   FoundFile : SearchRec;
  31.   Bytes_Written : Longint;
  32.   Input_File_Name : Array[1..80] OF Char;
  33.   INFile,OutFile,LZWFile : File;
  34.   X,NumRead : Word;
  35.  
  36.  
  37.  
  38.  
  39. Procedure DumpSyntax;
  40. BEGIN
  41.   CLRSCR;
  42.   GotoXY(5,3); Writeln('Dougpack 1.01 Copywrite 1990,   All rights reserved.');
  43.   GotoXY(5,5); Writeln('The correct syntax for this program is:');
  44.   GotoXY(8,7); Writeln('DOUGPACK <Filename>');
  45.   GotoXY(5,9); Writeln('If the file specified is not a DougPack file it will be compressed.');
  46.   GotoXY(5,10); Writeln('If it is a DougPack file it will be decompressed.');
  47. END;
  48.  
  49.  
  50.  
  51.  
  52.  
  53.  
  54.  
  55. {$F+}
  56.  
  57. Procedure GetBytesDisk(VAR Target; NBytes: WORD; VAR Bytes_Returned: WORD);
  58.      { For reading from a file called InFile}
  59.  
  60. BEGIN
  61.   Blockread(InFile,Target,NBytes,Bytes_Returned);
  62. END;
  63.  
  64.  
  65. Procedure PutBytesDisk(VAR Source; NBytes: WORD; VAR Bytes_Written: WORD);
  66. BEGIN
  67.   BlockWrite(OutFile,Source,NBytes,Bytes_Written);
  68. END;
  69.  
  70. {$F-}
  71.  
  72.  
  73.  
  74.  
  75.  
  76. BEGIN
  77.   IF Paramcount < 1 THEN
  78.     BEGIN
  79.       DumpSyntax;
  80.       HALT;
  81.     END;
  82.   Filename := ParamStr(1);
  83.   FSplit(Filename,Dir,Name,Ext);
  84.   FOR X := 1 TO 4 DO
  85.     Ext[X] := Upcase(Ext[X]);
  86.   IF (Ext <> '.DPK') AND (Ext <> '.') AND(Ext <> '') THEN     { Compress. }
  87.     BEGIN
  88.       Header.Name := Name + Ext;
  89.       Header.Bits_Used := Bits;
  90.       Header.Clear_After_Table_Full := FALSE;
  91.       Assign(Infile,Filename);
  92.       Assign(LZWFile,Name + '.DPK');
  93.       RESET(InFile,1);                { used for compression }
  94.       REwrite(LZWFile,1);
  95.       BlockWrite(LZWFile,Header,SizeOf(Header),NumRead);   { Save space for the header. }
  96.       Header.CRC := Compress(LZWFile,Bytes_Written,GetBytesDisk);
  97.       Header.Compressed_Bytes := Bytes_Written;
  98.       Header.Bits_Used := Bits;
  99.       Seek(LZWFile,0);
  100.       BlockWrite(LZWFile,Header,SizeOf(Header),NumRead);   { Write header with CRC value. }
  101.       Writeln('File compressed to ',100*Filesize(LZWFile) DIV FileSize(InFile),'% of original.');
  102.       Close(Infile);
  103.       Close(LZWfile);
  104.     END
  105.   ELSE                  { Decompress. }
  106.     BEGIN
  107.       Assign(LZWfile,Name + '.DPK');
  108.       RESet(LZWFile,1);
  109.       Blockread(LZWFile,Header,SizeOf(Header),Numread);
  110.       IF Header.Bits_Used > 14 THEN
  111.         BEGIN
  112.           Writeln('Cannot decompress this file.');
  113.           HALT;
  114.         END;
  115.       FindFirst(Header.Name,$27,Foundfile);    { See if the file to be decompressed }
  116.       If DOSError = 0 THEN                     { already exists.                    }
  117.         BEGIN
  118.           Writeln(Header.Name,' already exists, decompress anyway ? (Y/N)');
  119.           Ch := Readkey;
  120.           IF NOT (Ch IN ['y','Y']) THEN HALT;
  121.         END;
  122.       Assign(OutFile,Header.Name);
  123.       ReWrite(OutFile,1);                { used for decompression }
  124.       IF decompress(LZWFile,Header.Bits_Used,Header.Compressed_Bytes,PutBytesDisk) <> Header.CRC THEN
  125.         BEGIN                            { The arc file is corrupted! }
  126.           Writeln;
  127.           Writeln(#8,#8,#8);
  128.           Writeln('CRC Error');
  129.           Writeln('The Archive was corrupted in some way, the decompressed file');
  130.           Writeln(' is not the same one that was compressed.');
  131.         END;
  132.       Close(Outfile);
  133.       Close(LZWfile);
  134.     END;
  135. END.