unit1.pas

ZIP压缩算法 delphi组件 含代码

(*
 This application is to demonstrate how to
    1. compress a non compressed buffer (Buffer) to a second buffer (CompressBuf)

         Using memo controls, the text is taken from the first memo (Memo1)
         and compressed.  The compressed data is then placed in the second
         memo (Memo2).  The contents of the first memo (Memo1) is cleared.

      2. decompress a compressed buffer (Buffer) to a second buffer (DecompressBuf)

         Using memo controls, the compressed data is taken from the second
         memo (Memo2) and decompressed.  The decompressed text is then placed
         back into first memo (Memo1).  The contents of the second memo (Memo2)
         is cleared.

   *)
Unit Unit1;

Interface

Uses
   Windows,
   Messages,
   SysUtils,
   Classes,
   Graphics,
   Controls,
   Forms,
   Dialogs,
   ExtCtrls,
   StdCtrls,
   ztvConsts;

Type
   TForm1 = Class(TForm)
      Memo1: TMemo;
      Memo2: TMemo;
      Panel3: TPanel;
      Panel4: TPanel;
      Panel7: TPanel;
      Panel8: TPanel;
      Label3: TLabel;
      Label4: TLabel;
      Button1: TButton;
      Button2: TButton;
      Procedure Button1Click(Sender: TObject);
      Procedure Button2Click(Sender: TObject);
   Private
      { Private declarations }
   Public
      { Public declarations }
   End;

Var
   Form1: TForm1;

Implementation

{$R *.DFM}

Uses
   ztvBase,
   ztvGbls,
   ztvStreams,
   ztvInflate,
   ztvDeflate;

//-------------------------------------------------------------

// convert a string to a buffer

Procedure StrToBuf(Buf: Pointer; Str: String);
Begin
   Move(Str[1], Buf^, Length(Str));
End;
//-------------------------------------------------------------

// convert a buffer to a string

Function BufToStr(Buf: Pointer; Size: Integer): String;
Begin
   SetLength(Result, Size);
   Move(Buf^, Result[1], Size);
End;
//-------------------------------------------------------------

// Compress

Procedure TForm1.Button1Click(Sender: TObject);
Var
   Level: TDeflateType;
   Buffer, CompressBuf: Pointer;
   BufSize, CompressBufSize: Integer;
Begin
   BufSize := Length(Memo1.Text);       {Get length of Memo1 text}

   GetMem(Buffer, BufSize + 1);
   Try
      StrToBuf(Buffer, Memo1.Text);     //put Memo1.Text into Buffer}

      // =======================================================
      // Possible values for level:
      //   dtDeflateS: Stored (no compression - fastest speed)
      //   dtDeflateF: Fast (less compression, increased speed)
      //   dtDeflateN: Normal (medium compression - medium speed)
      //   dtDeflateX: eXtra (most compression - less speed)
      // =======================================================
      Level := dtDeflateN;              {define the compression level}
      ztvCompress_BufToBuf(Buffer, BufSize, CompressBuf, CompressBufSize, Level);  {compress the buffer into CompressBuf}
      Try
         Memo2.Text := BufToStr(CompressBuf, CompressBufSize);
      Finally
         {ALWAYS free the CompressBuf (allocated in ztvCompressBuf)}
         FreeMem(CompressBuf, CompressBufSize);
      End;
   Finally
      FreeMem(Buffer, BufSize + 1);
      Memo1.Text := '';                 {clear Memo1}
   End;
End;
//-------------------------------------------------------------

// decompress

Procedure TForm1.Button2Click(Sender: TObject);
Var
   Buffer, DecompressBuf: Pointer;
   BufSize, DecompressBufSize: Integer;
Begin
   If Length(Memo2.Text) = 0 Then
      Exit;

   BufSize := Length(Memo2.Text);       {Get length of Memo2 compressed data}

   GetMem(Buffer, BufSize + 1);
   Try
      StrToBuf(Buffer, Memo2.Text);     {put Memo2.Text into Buffer}
      ztvDecompress_BufToBuf(Buffer, BufSize, DecompressBuf, DecompressBufSize, 0);
      Try
         Memo1.Text := BufToStr(DecompressBuf, DecompressBufSize);  {copy contents of compressed data (DecompressBuf) to Memo1}
      Finally
         {ALWAYS free the DecompressBuf (allocated in ztvDecompressBuf)}
         FreeMem(DecompressBuf, DecompressBufSize);
      End;
   Finally
      FreeMem(Buffer, BufSize + 1);
      Memo2.Text := '';                 {clear Memo2}
   End;
End;
//-------------------------------------------------------------

End.