home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 September / Chip_2002-09_cd1.bin / zkuste / vbasic / Data / Utils / XZipComp.exe / XceedZip.Cab / F112526_MsgStack.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-11-17  |  4.2 KB  |  153 lines
  1. unit MsgStack;
  2. {------------------------------------------------------------------------------}
  3. { Memory 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.   StdCtrls, OleCtrls, XceedZipLib_TLB;
  13.  
  14. type
  15.   PCompressedMessage = ^TCompressedMessage;
  16.   TCompressedMessage = record
  17.     vaCompressed : OleVariant;
  18.     pNext : PCompressedMessage;
  19.   end;
  20.  
  21.   TfrmMessageStack = class(TForm)
  22.     Label1: TLabel;
  23.     Label2: TLabel;
  24.     mmoAdd: TMemo;
  25.     btAdd: TButton;
  26.     Label3: TLabel;
  27.     edtCount: TEdit;
  28.     btRemove: TButton;
  29.     Label4: TLabel;
  30.     mmoRemoved: TMemo;
  31.     xComp: TXceedCompression;
  32.     procedure btAddClick(Sender: TObject);
  33.     procedure btRemoveClick(Sender: TObject);
  34.   private
  35.     { Private declarations }
  36.     pHeadMessage : PCompressedMessage;
  37.     nCount : Integer;
  38.   public
  39.     { Public declarations }
  40.     constructor Create( AOwner: TComponent ); override;
  41.     destructor  Destroy; override;
  42.   end;
  43.  
  44. var
  45.   frmMessageStack: TfrmMessageStack;
  46.  
  47. implementation
  48.  
  49. {$R *.DFM}
  50.  
  51. constructor TfrmMessageStack.Create( AOwner: TComponent );
  52. begin
  53.   inherited Create( AOwner );
  54.   pHeadMessage  := nil;
  55.   nCount        := 0;
  56. end;
  57.  
  58. destructor TfrmMessageStack.Destroy;
  59. var
  60.   pCurrent : PCompressedMessage;
  61. begin
  62.   while Assigned( pHeadMessage ) do
  63.   begin
  64.     pCurrent  := pHeadMessage;
  65.     pHeadMessage  := pHeadMessage^.pNext;
  66.  
  67.     Dispose( pCurrent );
  68.   end;
  69.  
  70.   nCount  := 0;
  71.   inherited Destroy;
  72. end;
  73.  
  74. procedure TfrmMessageStack.btAddClick(Sender: TObject);
  75. var
  76.   nOrigSize : LongInt;
  77.   nCompSize : LongInt;
  78.   pNew : PCompressedMessage;
  79.   vaSource : OleVariant;
  80.   xResult : xcdCompressionError;
  81. begin
  82.   { If you assign a string to an OleVariant object, it will convert the
  83.     string to a WIDE string. The best thing to use is a variant array. }
  84.   nOrigSize := mmoAdd.GetTextLen + 1; { for the null char }
  85.   vaSource := VarArrayCreate( [0,nOrigSize-1], varByte );
  86.   mmoAdd.GetTextBuf( VarArrayLock( vaSource ), nOrigSize );
  87.   VarArrayUnlock( vaSource );
  88.  
  89.   { Allocate a stack item }
  90.   New( pNew );
  91.  
  92.   { To compress, we need to feed the compressor a variant array of bytes or
  93.     a variant string (BSTR). It will always yield a variant array of bytes }
  94.   xResult := xComp.Compress( vaSource, pNew^.vaCompressed, true );
  95.  
  96.   if xResult = xceSuccess then
  97.   begin
  98.     pNew^.pNext := pHeadMessage;
  99.     pHeadMessage  := pNew;
  100.     Inc( nCount );
  101.     edtCount.Text := IntToStr( nCount );
  102.     btRemove.Enabled := true;
  103.  
  104.     nCompSize := VarArrayHighBound( pNew^.vaCompressed, 1 )
  105.                - VarArrayLowBound( pNew^.vaCompressed, 1 ) + 1;
  106.                
  107.     ShowMessage( 'Compressed a ' + IntToStr( nOrigSize ) + ' byte(s) message ' +
  108.                  'to a ' + IntToStr( nCompSize ) + ' bytes blob.' ); 
  109.   end
  110.   else
  111.   begin
  112.     Dispose( pNew );
  113.     ShowMessage( xComp.GetErrorDescription( xResult ) );
  114.   end;
  115. end;
  116.  
  117. procedure TfrmMessageStack.btRemoveClick(Sender: TObject);
  118. var
  119.   pCurrent : PCompressedMessage;
  120.   vaDest : OleVariant;
  121.   xResult : xcdCompressionError;
  122. begin
  123.   if Assigned( pHeadMessage ) then
  124.   begin
  125.     pCurrent := pHeadMessage;
  126.     pHeadMessage  := pHeadMessage^.pNext;
  127.  
  128.     { To uncompress, we need to feed the compressor the original data as a
  129.       variant array of bytes. It will always yield in vaDest a variant array
  130.       of bytes }
  131.     xResult := xComp.Uncompress( pCurrent^.vaCompressed, vaDest, true );
  132.  
  133.     { Dispose of item before analysing result }
  134.     Dec( nCount );
  135.     Dispose( pCurrent );
  136.     edtCount.Text := IntToStr( nCount );
  137.     btRemove.Enabled := ( nCount > 0 );
  138.  
  139.     if xResult = xceSuccess then
  140.     begin
  141.       mmoRemoved.SetTextBuf( VarArrayLock( vaDest ) );
  142.       VarArrayUnlock( vaDest );
  143.     end
  144.     else
  145.     begin
  146.       mmoRemoved.Text := '';
  147.       ShowMessage( xComp.GetErrorDescription( xResult ) );
  148.     end;
  149.   end;
  150. end;
  151.  
  152. end.
  153.