home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 September / Chip_2002-09_cd1.bin / zkuste / vbasic / Data / Utils / XZipComp.exe / XceedZip.Cab / F112521_FileStream.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-11-17  |  6.0 KB  |  204 lines
  1. unit FileStream;
  2. {------------------------------------------------------------------------------}
  3. { Stream Compression sample using The Xceed Zip Compression Library 4          }
  4. { For Delphi 3, 4 and 5                                                        }
  5. { Copyright (c) 1999 Xceed Software Inc.                                       }
  6. {------------------------------------------------------------------------------}
  7.  
  8. interface
  9.  
  10. uses
  11.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  12.   OleCtrls, XceedZipLib_TLB, StdCtrls;
  13.  
  14. type
  15.   TfrmFileStream = class(TForm)
  16.     GroupBox1: TGroupBox;
  17.     Label1: TLabel;
  18.     Label2: TLabel;
  19.     edtCompSrc: TEdit;
  20.     Label3: TLabel;
  21.     edtCompDest: TEdit;
  22.     btCompress: TButton;
  23.     xComp: TXceedCompression;
  24.     GroupBox2: TGroupBox;
  25.     Label4: TLabel;
  26.     edtUncompSrc: TEdit;
  27.     Label5: TLabel;
  28.     edtUncompDest: TEdit;
  29.     btUncompress: TButton;
  30.     procedure edtCompSrcChange(Sender: TObject);
  31.     procedure edtCompDestChange(Sender: TObject);
  32.     procedure btCompressClick(Sender: TObject);
  33.     procedure btUncompressClick(Sender: TObject);
  34.   private
  35.     { Private declarations }
  36.   public
  37.     { Public declarations }
  38.   end;
  39.  
  40. var
  41.   frmFileStream: TfrmFileStream;
  42.  
  43. implementation
  44.  
  45. {$R *.DFM}
  46.  
  47. procedure TfrmFileStream.edtCompSrcChange(Sender: TObject);
  48. begin
  49.   edtUncompDest.Text := edtCompSrc.Text + '.Restored';
  50. end;
  51.  
  52. procedure TfrmFileStream.edtCompDestChange(Sender: TObject);
  53. begin
  54.   edtUncompSrc.Text := edtCompDest.Text;
  55. end;
  56.  
  57. procedure TfrmFileStream.btCompressClick(Sender: TObject);
  58. var
  59.   fsRead : TFileStream;
  60.   fsWrite : TFileStream;
  61.   lRead : LongInt;
  62.   lToWrite : LongInt;
  63.   lWritten : LongInt;
  64.   pData : Pointer;
  65.   vaSource : OleVariant;
  66.   vaDest : OleVariant;
  67.   xErr : xcdCompressionError;
  68. begin
  69.   try
  70.     fsRead  := TFileStream.Create( edtCompSrc.Text, fmOpenRead );
  71.     fsWrite := TFileStream.Create( edtCompDest.Text, fmCreate );
  72.  
  73.     if Assigned( fsRead ) and Assigned( fsWrite )then
  74.     begin
  75.       vaSource := VarArrayCreate( [0, 4095], varByte );
  76.  
  77.       repeat
  78.         { Read some bytes from source file }
  79.         pData := VarArrayLock( vaSource );
  80.         lRead := fsRead.Read( pData^, 4096 );
  81.         VarArrayUnlock( vaSource );
  82.  
  83.         if lRead > 0 then
  84.         begin
  85.           { Watch out for the trap: You may have read less than 4096, but the
  86.             variant is still reporting to hold 4096 bytes. Make sure to reduce
  87.             the size if applicable (why not always!) }
  88.           VarArrayRedim( vaSource, lRead-1 );
  89.           
  90.           { Compress this block. The method may return less than the
  91.             compressed buffer, as it keeps some data in bank in order to
  92.             compress even better (rewind and recompress) }
  93.  
  94.           xErr  := xComp.Compress( vaSource, vaDest, false );
  95.         end
  96.         else
  97.         begin
  98.           { Just call compress with an empty source, to tell the compression
  99.             engine to flush remaining compressed data }
  100.           VarClear( vaSource );
  101.           xErr  := xComp.Compress( vaSource, vaDest, true );
  102.         end;
  103.  
  104.         if xErr = xceSuccess then
  105.         begin
  106.           lToWrite  := VarArrayHighBound( vaDest, 1 )
  107.                      - VarArrayLowBound( vaDest, 1 ) + 1;
  108.  
  109.           pData := VarArrayLock( vaDest );
  110.           lWritten  := fsWrite.Write( pData^, lToWrite );
  111.           VarArrayUnlock( vaDest );
  112.  
  113.           if lWritten <> lToWrite then
  114.           begin
  115.             ShowMessage( 'Could not write all the data to the destination file.' );
  116.             lRead := 0;
  117.           end;
  118.         end
  119.       until ( lRead = 0 ) or ( xErr <> xceSuccess );
  120.  
  121.       ShowMessage( xComp.GetErrorDescription( xErr ) );
  122.     end;
  123.  
  124.     fsRead.Free;
  125.     fsWrite.Free;
  126.   except
  127.     ShowMessage( 'Unhandled exception' );
  128.   end;
  129. end;
  130.  
  131. procedure TfrmFileStream.btUncompressClick(Sender: TObject);
  132. var
  133.   fsRead : TFileStream;
  134.   fsWrite : TFileStream;
  135.   lRead : LongInt;
  136.   lToWrite : LongInt;
  137.   lWritten : LongInt;
  138.   pData : Pointer;
  139.   vaSource : OleVariant;
  140.   vaDest : OleVariant;
  141.   xErr : xcdCompressionError;
  142. begin
  143.   { As you can see, uncompressing is quite similar as compressing! }
  144.   try
  145.     fsRead  := TFileStream.Create( edtUncompSrc.Text, fmOpenRead );
  146.     fsWrite := TFileStream.Create( edtUncompDest.Text, fmCreate );
  147.  
  148.     if Assigned( fsRead ) and Assigned( fsWrite )then
  149.     begin
  150.       vaSource := VarArrayCreate( [0, 4095], varByte );
  151.  
  152.       repeat
  153.         { Read some bytes from source file }
  154.         pData := VarArrayLock( vaSource );
  155.         lRead := fsRead.Read( pData^, 4096 );
  156.         VarArrayUnlock( vaSource );
  157.  
  158.         if lRead > 0 then
  159.         begin
  160.           { Again, wtahc out for the Variant size trap! }
  161.           VarArrayRedim( vaSource, lRead-1 );
  162.           
  163.           { Uncompress this block. The method may return less than the
  164.             uncompressed buffer, as it requires some other bytes ahead to
  165.             unscramble these. }
  166.           xErr  := xComp.Uncompress( vaSource, vaDest, false );
  167.         end
  168.         else
  169.         begin
  170.           { Just call compress with an empty source, to tell the compression
  171.             engine that it holds the last bytes }
  172.           VarClear( vaSource );
  173.           xErr  := xComp.Uncompress( vaSource, vaDest, true );
  174.         end;
  175.  
  176.         if xErr = xceSuccess then
  177.         begin
  178.           lToWrite  := VarArrayHighBound( vaDest, 1 )
  179.                      - VarArrayLowBound( vaDest, 1 ) + 1;
  180.  
  181.           pData := VarArrayLock( vaDest );
  182.           lWritten  := fsWrite.Write( pData^, lToWrite );
  183.           VarArrayUnlock( vaDest );
  184.  
  185.           if lWritten <> lToWrite then
  186.           begin
  187.             ShowMessage( 'Could not write all the data to the destination file.' );
  188.             lRead := 0;
  189.           end;
  190.         end
  191.       until ( lRead = 0 ) or ( xErr <> xceSuccess );
  192.  
  193.       ShowMessage( xComp.GetErrorDescription( xErr ) );
  194.     end;
  195.  
  196.     fsRead.Free;
  197.     fsWrite.Free;
  198.   except
  199.     ShowMessage( 'Unhandled exception' );
  200.   end;
  201. end;
  202.  
  203. end.
  204.