unit1.pas

ZIP压缩算法 delphi组件 含代码

(*
 This demo is a simulation of streaming an archive into the TZipTV control.

   Since we are unable to stream an archive via com port in this demo, an
   archive is opened from disk and copied into a memory stream.  The
   FileStream is then released nd the MemoryStream (same as if it were coming
   through a com port, is passed to the TZipTV component as
   ZipTV1.Activate(MemoryStream).
*)

Unit Unit1;

Interface

Uses
   Windows,
   Messages,
   SysUtils,
   Classes,
   Graphics,
   Controls,
   Forms,
   Dialogs,
   ztvRegister,
   ztvBase,
   ztvZipTV,
   ztvZipView,
   ztvStreams,
   StdCtrls,
   ExtCtrls,
   ComCtrls,
   Menus;

Type
   TForm1 = Class(TForm)
      ZipView1: TZipView;
      ZipTV1: TZipTV;
      Panel1: TPanel;
      Panel2: TPanel;
      Button1: TButton;
      MainMenu1: TMainMenu;
      mnuErrorMessages1: TMenuItem;
      Label2: TLabel;
      Panel3: TPanel;
      Label1: TLabel;
    Label3: TLabel;
    Edit1: TEdit;
      Procedure ZipTV1Read(Sender: TObject; Offset, Filenum: Integer);
      Procedure Button1Click(Sender: TObject);
      Procedure ZipTV1Error(Sender: TObject; FileName, ExtendedMsg,
         VolumeID: String; ECode: Integer);
      Procedure mnuErrorMessages1Click(Sender: TObject);
   Private
      { Private declarations }
   Public
      { Public declarations }
   End;

Var
   Form1: TForm1;

Implementation

Uses
   Unit2;

{$R *.DFM}

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

// ZipTV1 OnRead event
// All file info is passed through this event, one at a time

Procedure TForm1.ZipTV1Read(Sender: TObject; Offset, Filenum: Integer);
Var
   ZipCommon: TZipCommon;
   BuildString: AnsiString;             (* Long String *)
Begin

   (* ZipCommon is the parent class to all ZipTV components.			*)
   (* Typecast the 'Sender' parameter as type TZipCommon to share		*)
   (* properties with all components.											*)
   ZipCommon := TZipCommon(Sender);

   (* Delimiter is a property of the ZipListBox *)
   With ZipView1 Do                     (* for the Delimiter variable *)
   Begin

      BuildString :=
         ExtractFilename(ZipCommon.FileName) + Delimiter +

      (* Date property 			*)
      FormatDateTime('mm' + DateSeparator + 'dd' +
         DateSeparator + 'yy hh:mm', ZipCommon.Date) + Delimiter +
         // ...or...
      //DateTimeToStr(ZipCommon.Date) + Delimiter +

      IntToStr(ZipCommon.PackedSize) + Delimiter +
         IntToStr(ZipCommon.UnpackedSize) + Delimiter +
         IntToStr(ZipCommon.Ratio) + '%' + Delimiter +
         ZipCommon.sCompressionMethod + Delimiter +

      //..or
      //IntToStr( ZipCommon.wCompressionMethod ) + Delimiter +

      ZipCommon.FileAttrToString(ZipCommon.ExternalAttr, Byte('_')) +
         ' (' + IntToStr(ZipCommon.ExternalAttr) + ')' + Delimiter +

      ExtractFilePath(ZipCommon.FileName) + Delimiter +
         ZipCommon.GetFileType(ZipCommon.FileName) + Delimiter +

      //IntToStr( ZipCommon.CRC ) + Delimiter +
      //..or

      IntToHex(ZipCommon.CRC, 8) + Delimiter +
         IntToStr(Offset) + Delimiter;

      If ZipCommon.Encrypted Then
         BuildString := BuildString + 'Yes' + Delimiter
      Else
         BuildString := BuildString + 'No' + Delimiter;

      BuildString := BuildString + ZipCommon.VolumeName + Delimiter;
      BuildString := BuildString + StrPas(ZipCommon.FileComment);

      // add the string to the ZipView control
      ZipView1.Items.Add(BuildString);
   End;
End;
//-------------------------------------------------------------

// NOTE:
// 1. using ZipTV1.Activate(s: TStream32), do NOT set the
//    ArchiveFile property!  Set all other properties as normal.
// 2. The stream passed to the Activate(..) can not be a zero byte
//    stream.  It must be a valid stream containing uncompressed
//    data or text.

Procedure TForm1.Button1Click(Sender: TObject);
Var
   FileStream: TFileStream32;
   MemoryStream: TMemoryStream32;
Begin
   ZipView1.Items.BeginUpdate();
   ZipView1.Clear();

   If Edit1.Text = '' Then Exit;

   If Not FileExists(Edit1.Text) Then
   Begin
      ShowMessage('File not found: ' + Edit1.Text);
      Exit;
   End;

   ZipTV1.FileSpec.Clear();
   ZipTV1.FileSpec.Add('*.*');

   FileStream := TFileStream32.Create(Edit1.Text, fmOpenRead Or fmShareDenyWrite);
   If (FileStream.Handle < 0) Then
   Begin
      ShowMessage('Unable to open file: ' + Edit1.Text);
      Exit;
   End;

   // just for test purposes, the entire FileStream is copied to
   // MemoryStream and FileStream is free'd.  ZipTV1.Activate()
   // is called using a memory stream.
   MemoryStream := TMemoryStream32.Create();
   Try
      Try
         // copy the file from FileStream to MemoryStream
         MemoryStream.CopyFrom(FileStream, FileStream.Size);
      Finally
         // the entire file is now in a memory stream
         FileStream.Free();
      End;

      ZipTV1.Activate(MemoryStream);
   Finally
      MemoryStream.Free();
   End;

   ZipView1.Items.EndUpdate();
End;
//-------------------------------------------------------------

// OnError event

Procedure TForm1.ZipTV1Error(Sender: TObject; FileName, ExtendedMsg,
   VolumeID: String; ECode: Integer);
Var
   NewItem: TListItem;
Begin
   If Form2 <> Nil Then                 // has form been created?
   Begin
      NewItem := Form2.ListView1.Items.Insert(0); (* Create a new row *)
      With NewItem Do
      Begin
         Caption := LowerCase(Sender.Classname);
         With SubItems Do
         Begin
            Add(LowerCase(TZipCommon(Sender).ArchiveFile)); // archive FileName
            Add(LowerCase(ExtractFilename(FileName))); // FileName
            Add(IntToStr(ECode));       // convert error number to a string
            Add(LoadStr(ECode)); // Load error string from err_msgs.rc & err_msgs.pas
            Add(ExtendedMsg);           // Extended message such as required event params
         End;
      End;
      Form2.ShowModal();
   End;
End;
//-------------------------------------------------------------

Procedure TForm1.mnuErrorMessages1Click(Sender: TObject);
Begin
   Form2.Show();                        // Error messages form
End;
//-------------------------------------------------------------

End.