unit1.pas

ZIP压缩算法 delphi组件 含代码

// ==========================================
//Note: This demo requires Delphi 6 or higher
// ==========================================
Unit Unit1;

Interface

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

Type
   TForm1 = Class(TForm)
      Label1: TLabel;
      Label2: TLabel;
      Button1: TButton;
      Memo1: TMemo;
      edCompressed: TEdit;
      edOrigin: TEdit;
      Button2: TButton;
      Button3: TButton;
      Procedure Button1Click(Sender: TObject);
      Procedure FormCreate(Sender: TObject);
      Procedure Button2Click(Sender: TObject);
      Procedure Button3Click(Sender: TObject);
   Private
      { Private declarations }
   Public
      { Public declarations }
   End;

Var
   Form1: TForm1;

Implementation

{$R *.DFM}

Uses
   ztvRegister,
   ztvConsts,
   ztvStreams,
   ztvInflate,
   ztvDeflate,
   ztvUnZip;

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

Procedure TForm1.FormCreate(Sender: TObject);
Begin
   // prefix the file names with the path of the program
   edOrigin.Text := ExtractFilePath(Application.ExeName) + edOrigin.Text;
   edCompressed.Text := ExtractFilePath(Application.ExeName) + edCompressed.Text;
End;
//-------------------------------------------------------------

// Compress (one way)
Procedure TForm1.Button1Click(Sender: TObject);
Var
   Rate: Integer;
   Level: TDeflateType;
   comprStream: TCompressStream;
   aStreamSrce, aStreamDest: TFileStream32;
Begin
   aStreamSrce := TFileStream32.Create(edOrigin.Text, fmOpenRead);
   aStreamDest := TFileStream32.Create(edCompressed.Text, fmCreate);
   Try
      // =======================================================
      // set the compression level
      // =======================================================
      // 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;
      // =======================================================

      // create the compression stream object, using aStreamDest as the
      // stream to write the compressed data to.
      comprStream :=
         TCompressStream.Create(aStreamDest, Level, _MAX_WBITS);

      Try
         // copy the compressed data to the compressed stream object,
           // using aStreamSrce as the stream to read from.
         comprStream.CopyFrom(aStreamSrce, aStreamSrce.Size);
      Finally
         // free the compressed stream
         comprStream.Free();

         Rate := comprStream.CompressionRate;  // get compression ration (must follow the Free() method)
         //...Or...
         //Rate := comprStream.Crc;  // get crc  (must follow the Free() method)
      End;

      ShowMessage(
         'uncompressed size: ' + IntToStr(aStreamSrce.Size) + #13 +
         'compressed size: ' + IntToStr(aStreamDest.Size) + #13 +
         'compress ratio: ' + IntToStr(Rate) + '%');

      aStreamDest.Position := 0;
      Memo1.Lines.LoadFromStream(aStreamDest);
   Finally
      aStreamSrce.Free();
      aStreamDest.Free();
   End;
End;
//-------------------------------------------------------------

// Compress (another way)
Procedure TForm1.Button2Click(Sender: TObject);
Var
   CRC: u_long;
   Level: TDeflateType;
   aStreamSrce, aStreamDest: TFileStream32;
Begin
   aStreamSrce := TFileStream32.Create(edOrigin.Text, fmOpenRead);
   aStreamDest := TFileStream32.Create(edCompressed.Text, fmCreate);
   Try
      // =======================================================
      // set the compression level
      // =======================================================
      // 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;
      // =======================================================

      CRC :=
         ztvCompress_StreamToStream(
         		aStreamSrce, aStreamDest, aStreamSrce.Size, Level);

      aStreamDest.Seek(0, soFromBeginning);
      ShowMessage(
         'uncompressed size: ' + IntToStr(aStreamSrce.Size) + #13 +
         'compressed size: ' + IntToStr(aStreamDest.Size) + #13 +
         'crc value: ' + IntToStr(CRC));
      Memo1.Lines.LoadFromStream(aStreamDest);
   Finally
      aStreamSrce.Free();
      aStreamDest.Free();
   End;
End;
//-------------------------------------------------------------

// Decompress
Procedure TForm1.Button3Click(Sender: TObject);
Var
   CRC: ULONG;
   aStreamDest: TMemoryStream32;
   aStreamSrce: TFileStream32;
Begin
   aStreamSrce := TFileStream32.Create(edCompressed.Text, fmOpenRead);
   aStreamDest := TMemoryStream32.Create();
   Try
      CRC :=
         ztvInflate.ztvDecompress_StreamToStream(aStreamSrce,
         	aStreamDest, aStreamSrce.Size);

      aStreamDest.Seek(0, soFromBeginning);
      Memo1.Lines.LoadFromStream(aStreamDest);

      ShowMessage(
         'uncompressed size: ' + IntToStr(aStreamSrce.Size) + #13 +
         'compressed size: ' + IntToStr(aStreamDest.Size) + #13 +
         'crc value: ' + IntToStr(CRC));
   Finally
      aStreamSrce.Free();
      aStreamDest.Free();
   End;
End;
//-------------------------------------------------------------

End.