unit1.pas

ziptv为delphi控件

(*

  Here's a small demo that includes compression & decompression of
  zip archives.

  *)
Unit Unit1;

Interface

{$I compiler.inc}
{$IFDEF DEL6_OR_HIGHER}
{$WARN UNIT_PLATFORM OFF}
{$ENDIF}

Uses
   Windows,
   SysUtils,
   Classes,
   Controls,
   Forms,
   Dialogs,
   StdCtrls,
   Buttons,
   ComCtrls,
   Gauges,
   ExtCtrls,
   FileCtrl,
   ztvRegister,
   ztvBase,
   ztvGbls,
   ztvConsts,
   ztvZip,
   ztvMakeCab,
   ztvUnZip,
   ztvUnCab,
   ztvHeaders,
   ztvFileIo;

Type
   TForm1 = Class(TForm)
      OpenDialog1: TOpenDialog;
      ListBox1: TListBox;
      StatusBar1: TStatusBar;

      BitBtn1: TBitBtn;
      BitBtn2: TBitBtn;
      BitBtn3: TBitBtn;
      btnCompress: TBitBtn;
      btnExtract: TBitBtn;

      Gauge1: TGauge;
      Gauge2: TGauge;

      pnlStatus: TPanel;
      Panel1: TPanel;
      Panel2: TPanel;
      Panel3: TPanel;

      Label1: TLabel;
      Label2: TLabel;
      Label3: TLabel;
      Label4: TLabel;
      Label5: TLabel;
      Label6: TLabel;

      Edit1: TEdit;
      Edit2: TEdit;
      Edit3: TEdit;
      Edit4: TEdit;
      Edit5: TEdit;

      CheckBox1: TCheckBox;
      CheckBox3: TCheckBox;
      CheckBox2: TCheckBox;
      CheckBox4: TCheckBox;

      Zip1: TZip;
      UnZip1: TUnZip;

      Procedure FormCreate(Sender: TObject);
      Procedure FormCloseQuery(Sender: TObject; Var CanClose: Boolean);

      Procedure btnCloseClick(Sender: TObject);
      Procedure btnCompressClick(Sender: TObject);
      Procedure btnExtractClick(Sender: TObject);

      Procedure BitBtn1Click(Sender: TObject);
      Procedure BitBtn2Click(Sender: TObject);
      Procedure BitBtn3Click(Sender: TObject);

      Procedure Zip1Begin(Sender: TObject; FName: String; Count: Integer;
         Var Extract: Boolean);
      Procedure Zip1Deactivate(Sender: TObject);
      Procedure Zip1Progress(Sender: TObject; ProgressByFile,
         ProgressByArchive: Byte);
      Procedure UnZIP1FileExists(Sender: TObject; FileName: String;
         Var NewFileName: String; Var OverwriteMode: TOverwriteMode);

   Private
      { Private declarations }
   Public
      { Public declarations }
   End;

Var
   Form1: TForm1;

Implementation

Uses Unit2;

{$R *.DFM}

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

Procedure TForm1.FormCreate(Sender: TObject);
Begin
   OpenDialog1.Filter := '*.ZIP';
   OpenDialog1.Options := [ofHideReadOnly, ofFileMustExist, ofPathMustExist];
End;
//-------------------------------------------------------------

Procedure TForm1.BitBtn1Click(Sender: TObject);
Begin
   If OpenDialog1.Execute() Then
   Begin
      Edit1.Text := OpenDialog1.FileName;
      ListBox1.Items.Clear();
   End;
End;
//-------------------------------------------------------------

Procedure TForm1.BitBtn2Click(Sender: TObject);
Begin
   If OpenDialog1.Execute() Then
   Begin
      Edit3.Text := OpenDialog1.FileName;
      ListBox1.Items.Clear();
   End;
End;
//-------------------------------------------------------------

// It is not necessary to set the values of all properties listed below.
// If you wish to use the default values, leave them out.
// Properties with "// default" are included just for this demonstration.

Procedure TForm1.btnCompressClick(Sender: TObject);
Var
   FilesCompressed: Integer;
Begin
   Cursor := crHourGlass;
   ListBox1.Clear();

   If FileExists(Edit1.Text) Then
      If MessageDlg(
         'Archive exists... overwrite?',
         mtConfirmation,
         [mbYes, mbNo],
         0) = mrYes Then
         // move to recycle bin
         EraseFile(Edit1.Text, doAllowUndo) // EraseFile is in ztvBase.pas
      Else
         Exit;

   Zip1.ArchiveFile := Edit1.Text;      // archive filename
   Zip1.DateAttribute := daFileDate;    // default value
   Zip1.StoredDirNames := sdRelative;   // default value
   Zip1.CompressMethod := cmDeflate;    // default value
   Zip1.RecurseDirs := CheckBox2.Checked; // default = False
   Zip1.Switch := swAdd;                // default value
   Zip1.StoreEmptySubDirs := False;     // default value
   Zip1.EncryptHeaders := CheckBox1.Checked; // default = False

   Zip1.ExcludeSpec.Clear();
   Zip1.FileSpec.Clear();
   Zip1.FileSpec.Add(Edit2.Text);       // test with c:\windows\*.txt

   // ****************************************************************
   // NOTE: for a better understanding of how the Attributes property
   // works with file attributes see demo demos\filescan\fs_demo.dpr.
   // ****************************************************************

   // See the Attributes property in the object inspector
   // Set Zip1 Attributes property by calling the SetAttribute method
   Zip1.SetAttribute(fsZeroAttr, True); // default
   Zip1.SetAttribute(fsArchive, True);  // default
   Zip1.SetAttribute(fsDirectory, True); // default = False
   Zip1.SetAttribute(fsHidden, True);   // default = False
   Zip1.SetAttribute(fsReadOnly, True); // default
   Zip1.SetAttribute(fsSysFile, True);  // default = False

   // See the AttributesEx property in teh object inspector
   // Set the AttributesEx property by calling the SetAttributeEx method.
   // Exclude none
   Zip1.SetAttributeEx(fsZeroAttr, False); // default
   Zip1.SetAttributeEx(fsArchive, False); // default
   Zip1.SetAttributeEx(fsDirectory, False); // default
   Zip1.SetAttributeEx(fsHidden, False); // default
   Zip1.SetAttributeEx(fsReadOnly, False); // default
   Zip1.SetAttributeEx(fsSysFile, False); // default

   FilesCompressed := Zip1.Compress();
   ShowMessage('Files Compressed: ' + IntToStr(FilesCompressed));

   Cursor := crDefault;
End;
//-------------------------------------------------------------

Procedure TForm1.btnExtractClick(Sender: TObject);
Var
   FilesExtracted: Integer;
Begin
	UnZip1.OverwriteMode := omOverwrite;
   UnZip1.ArchiveFile := Edit3.Text;    // archive filename
   UnZip1.ConfirmOverwrites := CheckBox3.Checked; // default = False
   UnZip1.RecurseDirs := CheckBox4.Checked; // default = False
   UnZip1.FileSpec.Clear();             //
   UnZip1.FileSpec.Add(Edit4.Text);     // *.* = extract all
   UnZip1.ExtractDir := Edit5.Text;     //
   If DirectoryExists(Edit5.Text) Then  // if the directory exists then extract
   Begin
      FilesExtracted := UnZip1.Extract();
      ShowMessage('Files Extracted: ' + IntToStr(FilesExtracted));
   End
   Else
   Begin
      ShowMessage('Extract dir not defined');
      Exit;
   End;
End;
//-------------------------------------------------------------

Procedure TForm1.btnCloseClick(Sender: TObject);
Begin
   Close;
End;
//-------------------------------------------------------------

Procedure TForm1.FormCloseQuery(Sender: TObject; Var CanClose: Boolean);
Begin
   Zip1.Cancel := True;
   UnZip1.Cancel := True;
End;
//-------------------------------------------------------------

Procedure TForm1.BitBtn3Click(Sender: TObject);
Var
   Dir: String;
Begin
   Dir := Edit5.Text;
   If SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt], 0) Then
      Edit5.Text := Dir;
End;
//-------------------------------------------------------------

Procedure TForm1.Zip1Begin(Sender: TObject; FName: String; Count: Integer;
   Var Extract: Boolean);
Begin
   ListBox1.Items.Add(FName);
   StatusBar1.SimpleText := FName;
End;
//-------------------------------------------------------------

Procedure TForm1.Zip1Deactivate(Sender: TObject);
Begin
   //Gauge1.Progress := 0;
   //Gauge2.Progress := 0;
   StatusBar1.SimpleText := '';
End;
//-------------------------------------------------------------

Procedure TForm1.Zip1Progress(Sender: TObject; ProgressByFile,
   ProgressByArchive: Byte);
Begin
   Gauge1.Progress := ProgressByFile;
   Gauge2.Progress := ProgressByArchive;
   Application.ProcessMessages();
End;
//-------------------------------------------------------------

Procedure TForm1.UnZIP1FileExists(Sender: TObject; FileName: String;
   Var NewFileName: String; Var OverwriteMode: TOverwriteMode);
Var
   FormResult: TModalResult;
Begin

   With frmOverwrite, Edit1 Do
   Begin
      Text := FileName;                 //set the frmOverwrite.Edit1 control text
      FormResult := ShowModal();        //show the frmOverwrite form
      NewFileName := Text;              //assign the NewFilename parameter
   End;

   Case FormResult Of
      mrNo: OverwriteMode := omSkip;
      mrYes: OverwriteMode := omOverwrite;
      mrCancel: TZipCommon(Sender).Cancel := True;
   End;

   TZipCommon(Sender).ConfirmOverwrites := Not frmOverwrite.CheckBox1.Checked;
End;
//-------------------------------------------------------------

End.