units/zlib/zlib_demo/Compress.dpr

   1 program Compress;\r
   2 {$APPTYPE CONSOLE}\r
   3 uses Windows, KolZLib, Kol;\r
   4 \r
   5 const\r
   6   STRM_ERROR = DWord (-1);\r
   7 \r
   8 // Cutted from Classes.TStream.CopyFrom with some small modifications...\r
   9 function StreamCopy (Dest, Source: PStream; Count: DWord): DWord;\r
  10 const\r
  11   MAXBUFSIZE = $80000;\r
  12 var\r
  13   BufSize: DWord;\r
  14   Readed: DWord;\r
  15   Buffer: PChar;\r
  16   Need: DWord;\r
  17 begin\r
  18   If Count=0 then begin\r
  19     Source.Position:=0;\r
  20     Count:=Source.Size;\r
  21   end;\r
  22   Result:=0;\r
  23   If Count>MAXBUFSIZE then BufSize:=MAXBUFSIZE else BufSize:=Count;\r
  24   GetMem(Buffer, BufSize);\r
  25   try // => try .. finally works for 'Exit' command even without Kol_Err.pas !\r
  26     repeat\r
  27       If Count>BufSize then Need:=BufSize else Need:=Count;\r
  28       Readed:=Source.Read (Buffer^, Need);\r
  29       If Readed=STRM_ERROR then Exit;\r
  30       If Dest.Write (Buffer^, Readed)=STRM_ERROR then Exit;\r
  31       Dec(Count, Readed);\r
  32       Inc (Result, Readed);\r
  33     until (Count=0) or (Readed=0) or (Readed=STRM_ERROR);\r
  34   finally\r
  35     // Exit brings us here...  \r
  36     FreeMem(Buffer, BufSize);\r
  37   end;\r
  38 end;\r
  39 \r
  40 var\r
  41   Source: PStream;\r
  42   Dest: PStream;\r
  43   Zipper: PStream;\r
  44   Error: Boolean;\r
  45   Size: DWord;\r
  46 begin\r
  47   If ParamCount<2 then begin\r
  48     WriteLn ('Usage: compress.exe InFile OutFile');\r
  49     WriteLn ('Press Enter to exit');\r
  50     ReadLn;\r
  51     Exit;\r
  52   end;\r
  53   Error:=False;\r
  54   Source:=NewReadFileStream (ParamStr(1));\r
  55   try\r
  56     If Source.Size=STRM_ERROR then Exit;\r
  57     Dest:=NewWriteFileStream (ParamStr(2));\r
  58     try\r
  59       If Dest.Size=STRM_ERROR then Exit;\r
  60       Size:=Source.Size;\r
  61       Dest.Write (Size, 4);\r
  62       If not NewZLibCStream (Zipper, clMax, Dest, nil) then Exit;\r
  63       Error:= not (StreamCopy (Zipper, Source, 0)=Source.Size);\r
  64       Zipper.Free;\r
  65     finally\r
  66       Dest.Free;\r
  67       If Error then DeleteFile (PChar (ParamStr (2)));\r
  68     end;\r
  69   finally\r
  70     Source.Free;\r
  71   end;\r
  72 end.\r