unit1.pas

ziptv为delphi控件

(*	TZipSplitter:

 The following properties are included in the TZipSplitter component,
   but are not present in the TZip compressor component:

   1. VolumeSizeNames: TStrings
      A string listing describing the set members in the PartType property.
      Used to fill a combobox with PartType names for user selection.

   2. PartType: TPartType

      TPartType =
         (vs1mb, vsFloppy_120mb, vsFloppy_144mb, vsFloppy_288mb,
         vsZipDisk_100mb, vsZipDisk_250mb, vsCDRom_650mb, vsCDRom_700mb,
         vsOtherSize, vsNoSplit);

      This property determines the sizes of output volume sizes.
   --> 	- If PartType = vsNoSplit, a normal zip archive is created
         - If PartType = vsOtherSize, the user can enter the desired size of
         the output volumes into the PartSize property.
         - If PartType equals any of the predefined size settings (for example
         vsFloppy_120mb), the PartSize property is automatically defined with
         a predetermined volume size.
         - All PartType settings automatically set the PartSize property with
         predefined sizes with the exception of vsOtherSize (user defined
         setting) and vsNoSplit (no archive split will take place).
         - The default = vsNoSplit

 3. PartSize: cardinal
         - This property is automatically assigned a volumesize if the PartType
         property (see PartType above) equals one of the predefined settings.
         Predefined settings are all PartType selections with the exception of
         the vsOtherSize and vsNoSplit members.

 4. CustomSizeType: TCustomSizeType
       TCustomSizeType = (stBytes, stKB, stMB);
         - This property is used only when the PartType property equals
         vsOtherSize.
         - CustomSizeType = stBytes, the value of the PartSize property is
         calculated in bytes. If CustomSizeType = stKB, the value of the
         PartSize property is calculated based on kbytes... etc.
   - The default = stBytes

   5. To activate compression use the "Compress" method (same as TZip).

   6. All properties available in the TZip component are also present in
      TZipSplitter with the exception of the Switch property.  At present
      files can not be added or deleted from a split archive.  Only the
      creation of split archives is supported.

  *)
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,
   ztvZipSplitter,
   ztvArchiveSplitter,
   ztvZipCheck;

Type
   TfrmMain = Class(TForm)
      OpenDialog1: TOpenDialog;
      ListBox1: TListBox;
      StatusBar1: TStatusBar;
      UnZip1: TUnZip;
      btnCompress: TBitBtn;
      btnExtract: TBitBtn;
      BitBtn1: TBitBtn;
      BitBtn2: TBitBtn;
      BitBtn3: TBitBtn;
      BitBtn4: TBitBtn;
      CheckBox1: TCheckBox;
      CheckBox3: TCheckBox;
      CheckBox2: TCheckBox;
      CheckBox4: TCheckBox;
      CheckBox5: TCheckBox;
      Edit1: TEdit;
      Edit2: TEdit;
      Edit3: TEdit;
      Edit4: TEdit;
      Edit5: TEdit;
      Gauge1: TGauge;
      Gauge2: TGauge;
      Label1: TLabel;
      Label2: TLabel;
      Label3: TLabel;
      Label4: TLabel;
      Label5: TLabel;
      pnlStatus: TPanel;
      Panel1: TPanel;
      Panel2: TPanel;
      Panel3: TPanel;
    ZipSplitter1: TZipSplitter;
      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 BitBtn4Click(Sender: TObject);
      Procedure UnZip1NextVolume(Sender: TObject; Var VolumeName: String;
         VolumeID: Integer; FExists: Boolean; Var Cancel: Boolean);
      Procedure UnZIP1FileExists(Sender: TObject; FileName: String;
         Var NewFileName: String; Var OverwriteMode: TOverwriteMode);
      Procedure ZipSplitter1Begin(Sender: TObject; FileName: String;
         Count: Integer; Var Extract: Boolean);
      Procedure ZipSplitter1Deactivate(Sender: TObject);
      Procedure ZipSplitter1Error(Sender: TObject; FileName, ExtendedMsg,
         VolumeID: String; ECode: Integer);
      Procedure ZipSplitter1GetPassword(Sender: TObject; FileName: String;
         Var Password: String; Var TryAgain: Boolean);
      Procedure ZipSplitter1SplitNewVolume(Sender: TObject; Index: Cardinal;
         NewVolumeName: String);
      Procedure ZipSplitter1SplitDeleteVolume(Sender: TObject;
         VolumeName: String; Var DeleteToRecycleBin: Boolean);
      Procedure ZipSplitter1Progress(Sender: TObject; ByFile, ByArchive: Byte);
      Procedure ZipSplitter1FileScanStatus(Sender: TObject; FileName: String;
         FilesCount: Integer; FilesSize: Int64);
      Procedure ZipSplitter1InsertDisk(Sender: TObject; VolumeName: String;
         Var Cancel: Boolean);
      Procedure ZipSplitter1NextVolume(Sender: TObject; Var VolumeName: String;
         VolumeID: Integer; FExists: Boolean; Var Cancel: Boolean);
      Procedure ZipSplitter1SplitBegin(Sender: TObject; archive,
         TempFileName: String; Var Cancel: Boolean);
    	Procedure ZipSplitter1SplitEnd(Sender: TObject;	VolumesCreated: Cardinal);
   Private
      { Private declarations }
   Public
      { Public declarations }
   End;

Var
   frmMain: TfrmMain;

Implementation

Uses
   Unit2,                               // frmOverwrite
   Unit3,                               // frmTestArchive
   Unit4,                               // frmErrorMsgs
   Unit5;                               // frmSplitArchive

{$R *.DFM}


Var
	Working: Boolean;


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

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

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

Procedure TfrmMain.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 TfrmMain.btnCompressClick(Sender: TObject);
Var
	DeleteOption: TDeleteOptions;
   FilesCompressed: Integer;
Begin
	If Working Then Exit;

   Working := True;
   Try

      Cursor := crHourGlass;
      ListBox1.Clear();

      // clear any previous error messges
      frmErrorMsgs.ListView1.Items.Clear();

      If FileExists(Edit1.Text) Then
      Begin
         DeleteOption := doAllowUndo;
         If MessageDlg(
               'Archive exists... overwrite?'#13#13 +
               'No = add files matching FileSpec', mtConfirmation,
               [mbYes, mbNo], 0) = mrYes Then
         Begin

            // move to recycle bin
            If Not EraseFile(Edit1.Text, DeleteOption) Then // EraseFile is in ztvBase.pas
            Begin
               If DeleteOption = doFinal Then
                  ShowMessage('Unable to delete file.. close and retry');
               Exit;
            End;
         End;
      End;

      ZipSplitter1.ArchiveFile := Edit1.Text; // archive filename
      ZipSplitter1.DateAttribute := daFileDate;  // default value - assigned here just for demo
      ZipSplitter1.StoredDirNames := sdRelative;  // default value - assigned here just for demo
      ZipSplitter1.CompressMethod := {cmStore; //} cmDeflate;  // default value - assigned here just for demo
      ZipSplitter1.RecurseDirs := CheckBox2.Checked; // default = False
      ZipSplitter1.Switch := swAdd;        // default value - assigned here just for demo
      ZipSplitter1.StoreEmptySubDirs := False; // default value - assigned here just for demo
      ZipSplitter1.EncryptHeaders := CheckBox1.Checked; // default = False

      ZipSplitter1.ExcludeSpec.Clear();
      ZipSplitter1.FileSpec.Clear();
      ZipSplitter1.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.
      // ****************************************************************

      // Include files with attribute
      // See the Attributes property in the object inspector
      // Set ZipSplitter1 Attributes property by calling the SetAttribute method
      ZipSplitter1.SetAttribute(fsZeroAttr, True); // default - assigned here for demo
      ZipSplitter1.SetAttribute(fsArchive, True); // default - assigned here for demo
      ZipSplitter1.SetAttribute(fsDirectory, True); // default = False
      ZipSplitter1.SetAttribute(fsHidden, True); // default = False
      ZipSplitter1.SetAttribute(fsReadOnly, True); // default - assigned here for demo
      ZipSplitter1.SetAttribute(fsSysFile, True); // default = False

      // Exclude files with attributes
      // See the AttributesEx property in the object inspector
      // Set the AttributesEx property by calling the SetAttributeEx method.
      // Exclude none
      ZipSplitter1.SetAttributeEx(fsZeroAttr, False); // default - assigned here for demo
      ZipSplitter1.SetAttributeEx(fsArchive, False); // default - assigned here for demo
      ZipSplitter1.SetAttributeEx(fsDirectory, False); // default - assigned here for demo
      ZipSplitter1.SetAttributeEx(fsHidden, False); // default - assigned here for demo
      ZipSplitter1.SetAttributeEx(fsReadOnly, False); // default - assigned here for demo
      ZipSplitter1.SetAttributeEx(fsSysFile, False); // default - assigned here for demo

      pnlStatus.Visible := True;
      Try
         // ==========================================================
         // Call Compress() method
         // ==========================================================
         FilesCompressed := ZipSplitter1.Compress();

         ShowMessage('Files Compressed: ' + IntToStr(FilesCompressed));
      Finally
         pnlStatus.Visible := False;

         // clear out the gauges
         Gauge1.Progress := 0;
         Gauge2.Progress := 0;
      End;
   Finally
   	Working := False;

      // if any errors show them
      If frmErrorMsgs.ListView1.Items.Count > 0 Then
         frmErrorMsgs.ShowModal();

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

Procedure TfrmMain.btnExtractClick(Sender: TObject);
Var
   FilesExtracted: Integer;
Begin
	If Working Then Exit;
   Working := True;