unit1.pas

ziptv为delphi控件

Unit Unit1;

Interface

Uses
   Windows,
   SysUtils,
   Classes,
   Controls,
   Forms,
   Dialogs,
   StdCtrls,
   ComCtrls,
   Graphics,
   Buttons,
   ExtCtrls,
   Menus,
   ztvBase,
   ztvGbls,
   ztvHeaders,
   ztvStreams,
   Err_Msgs,
   ztvZip,
   ztvConsts;

{$I ZipTV.inc}                          // for FROZEN1_SUPPORT conditional define
{$IFDEF DEL6_OR_HIGHER}
{$WARN UNIT_PLATFORM OFF}
{$ENDIF}

Type
   TfrmAddFiles = Class(TForm)
      Label1: TLabel;
      Label2: TLabel;
      Label3: TLabel;
      Label4: TLabel;
      Label5: TLabel;
      Label6: TLabel;
      Label7: TLabel;
      Panel1: TPanel;
      Panel2: TPanel;
      Panel3: TPanel;
      Panel4: TPanel;
      Panel5: TPanel;
      Panel6: TPanel;
      Panel7: TPanel;
      Panel8: TPanel;
      Panel9: TPanel;
      CheckBox1: TCheckBox;
      ComboBox1: TComboBox;
      ComboBox2: TComboBox;
      ComboBox3: TComboBox;
      ComboBox4: TComboBox;
      GroupBox1: TGroupBox;
      GroupBox2: TGroupBox;
      lstFileSpec: TListBox;
      lstExcludeSpec: TListBox;
      edtFileSpec: TEdit;
      edtDefaultDir: TEdit;
      btnRemove: TButton;
      btnPassword: TButton;
      BitBtn1: TBitBtn;
      btnOK: TBitBtn;
      btnClose: TBitBtn;
      btnSelectDir: TBitBtn;
      rbBh: TRadioButton;
      rbArj: TRadioButton;
      rbGZip: TRadioButton;
      rbLha: TRadioButton;
      rbZip: TRadioButton;
      rbZipSplitter: TRadioButton;
      rbTar: TRadioButton;
      rbZoo: TRadioButton;
      rbCab: TRadioButton;
      rbJar: TRadioButton;
      rbZLib: TRadioButton;
      rgSwitch: TRadioGroup;
      rgEditList: TRadioGroup;
      rgDeflateType: TRadioGroup;
      OpenDialog1: TOpenDialog;

      (* Menu *)
      MainMenu1: TMainMenu;
      File1: TMenuItem;
      SelectFiles1: TMenuItem;
      Close1: TMenuItem;

      (* Popup Menu *)
      PopupMenu1: TPopupMenu;
      RemoveSelected1: TMenuItem;
      RemoveAll1: TMenuItem;

      cbArchive: TCheckBox;
      cbArchiveEx: TCheckBox;
      cbDirectory: TCheckBox;
      cbDirectoryEx: TCheckBox;
      cbEncryptHeaders: TCheckBox;
      cbHidden: TCheckBox;
      cbHiddenEx: TCheckBox;
      cbReadOnly: TCheckBox;
      cbReadOnlyEx: TCheckBox;
      cbSysFile: TCheckBox;
      cbSysFileEx: TCheckBox;
      cbZeroAttr: TCheckBox;
      cbZeroAttrEx: TCheckBox;
      cbRecurseDirs: TCheckBox;
      cbIncludeHiddenDirs: TCheckBox;
      cbEncrypted: TCheckBox;
      cbEncryptedEx: TCheckBox;

      Procedure FormActivate(Sender: TObject);
      Procedure InitializeNewCompressComponent;
      Procedure SetAttributeCtls;
      Procedure SetCompressMethodState;
      Procedure btnOKClick(Sender: TObject);
      Procedure btnCloseClick(Sender: TObject);
      Procedure btnAddFilesClick(Sender: TObject);
      Procedure btnPasswordClick(Sender: TObject);
      Procedure btnSelectDirClick(Sender: TObject);
      Procedure PopupMenu1Popup(Sender: TObject);
      Procedure MethodButtonsClick(Sender: TObject);
      Procedure DefineCompressorClick(Sender: TObject);
      Procedure edtFileSpecKeyPress(Sender: TObject; Var Key: Char);
      //Procedure edtDirFileSpecExit( Sender: TObject );
      Procedure edtFileSpecEnter(Sender: TObject);
      Procedure btnRemoveMouseDown(Sender: TObject; Button: TMouseButton;
         Shift: TShiftState; x, y: Integer);
      Procedure lstFileSpecClick(Sender: TObject);
      Procedure edtFileSpecChange(Sender: TObject);
      Procedure ComboBox1Change(Sender: TObject);
      Procedure rgEditListClick(Sender: TObject);
      Procedure edtDefaultDirExit(Sender: TObject);
      Procedure rbZipSplitterDblClick(Sender: TObject);
   Private
      Function AddToList: Boolean;
   Public
   End;

Var
   frmAddFiles: TfrmAddFiles;

Implementation

Uses
   Main,
   FileCtrl,
   Unit11
   ;

{$R *.DFM}

// values of tag properties in the TRadioButton controls.  They match the
// values in the tag properties already present in the TRadioButton controls.
// See the tag property for the TRadioButton controls via the Delphi object
// inspector.
Const
   cArj = 1;
   cBlakHole = 2;
   cCab = 3;
   cGZip = 4;
   cJar = 5;
   cLha = 6;
   cTar = 7;
   cZip = 8;
   cZipSplitter = 9;
   cZLib = 10;
   cZoo = 11;

Var
   Tagger: Integer;

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

Procedure TfrmAddFiles.btnOKClick(Sender: TObject);
Var
   i: Integer;
Begin
   If edtFileSpec.Text <> '' Then
      If lstFileSpec.Visible And (lstFileSpec.Items.IndexOf(edtFileSpec.Text) =
         -1) Then
      Begin
         lstFileSpec.Items.Insert(0, edtFileSpec.Text);
         lstFileSpec.ItemIndex := 0;
      End
      Else
         If lstExcludeSpec.Visible And
            (lstExcludeSpec.Items.IndexOf(edtFileSpec.Text) = -1) Then
         Begin
            lstExcludeSpec.Items.Insert(0, edtFileSpec.Text);
            lstExcludeSpec.ItemIndex := 0;
         End;

   edtFileSpec.Text := '';

   If lstFileSpec.Items.Count > 0 Then
   Begin

      With CompressComponent Do
      Begin
         DefaultDir := edtDefaultDir.Text;

         (* Set CompressComponents Attributes property by calling the *)
           (* SetAttribute Method with values from form controls *)
         SetAttribute(fsZeroAttr, cbZeroAttr.Checked);
         SetAttribute(fsArchive, cbArchive.Checked);
         SetAttribute(fsDirectory, cbDirectory.Checked);
         SetAttribute(fsHidden, cbHidden.Checked);
         SetAttribute(fsReadOnly, cbReadOnly.Checked);
         SetAttribute(fsSysFile, cbSysFile.Checked);
         SetAttribute(fsEncrypted, cbEncrypted.Checked);

         (* Set CompressComponents AttributesEx (exclude) property by calling *)
           (* the SetAttribute Method with values from form controls *)
         SetAttributeEx(fsZeroAttr, cbZeroAttrEx.Checked);
         SetAttributeEx(fsArchive, cbArchiveEx.Checked);
         SetAttributeEx(fsDirectory, cbDirectoryEx.Checked);
         SetAttributeEx(fsHidden, cbHiddenEx.Checked);
         SetAttributeEx(fsReadOnly, cbReadOnlyEx.Checked);
         SetAttributeEx(fsSysFile, cbSysFileEx.Checked);
         SetAttributeEx(fsEncrypted, cbEncryptedEx.Checked);

         EncryptHeaders := cbEncryptHeaders.Checked;
         RecurseDirs := cbRecurseDirs.Checked;
         TranslateOemChar := frmMain.CheckBox1.Checked;
         Switch := TSwitch(rgSwitch.ItemIndex);
         StoredDirNames := TStoredDirNames(ComboBox2.ItemIndex);
         DateAttribute := TDateAttribute(ComboBox3.ItemIndex);
         CompressionMethod := TCompressionMethod(ComboBox4.ItemIndex);
         DeflateType := TDeflateType(rgDeflateType.ItemIndex);
         FileSpec.Assign(lstFileSpec.Items);
         ExcludeSpec.Assign(lstExcludeSpec.Items);
         StoreEmptySubDirs := CheckBox1.Checked;
         IncludeHiddenDirs := cbIncludeHiddenDirs.Checked;

         // add archive extensions to the StoreFilesOfType property
         StoreFilesOfType.Clear();
         For i := 0 To MaxExtArray Do
            If ExtArray[i] <> '.TAR' Then
               StoreFilesOfType.Add(ExtArray[i]);

      End;

      ModalResult := mrOK;
   End;
End;
//-------------------------------------------------------------

Procedure TfrmAddFiles.btnCloseClick(Sender: TObject);
Begin
   ModalResult := mrCancel;
End;
//-------------------------------------------------------------

          (* Add Files Button *)

Procedure TfrmAddFiles.btnAddFilesClick(Sender: TObject);
Var
   i: Integer;
Begin
   If edtFileSpec.Text <> '' Then
      OpenDialog1.FileName := ExtractFilename(edtFileSpec.Text)
   Else
      OpenDialog1.FileName := '*.*';

   OpenDialog1.Title := 'Select file(s) to add ( Ctrl+Click or Shift+Click )';

   If OpenDialog1.Execute() Then
      For i := 0 To OpenDialog1.files.Count - 1 Do
      Begin
         If lstFileSpec.Visible And
            (lstFileSpec.Items.IndexOf(OpenDialog1.files[i]) = -1) Then
         Begin
            lstFileSpec.Items.Insert(0, OpenDialog1.files[i]);
            lstFileSpec.ItemIndex := 0;
         End
         Else
            If lstExcludeSpec.Visible And
               (lstExcludeSpec.Items.IndexOf(OpenDialog1.files[i]) = -1) Then
            Begin
               lstExcludeSpec.Items.Insert(0, OpenDialog1.files[i]);
               lstExcludeSpec.ItemIndex := 0;
            End;
      End;

   btnOK.Enabled := lstFileSpec.Items.Count > 0;

   edtFileSpec.Text := '';
   edtFileSpec.SetFocus();
End;
//-------------------------------------------------------------

          (* Password Button *)

Procedure TfrmAddFiles.btnPasswordClick(Sender: TObject);
Var
   pw,
      FirstPW: String;
   Prompt,
      Caption: String;
   i: Integer;
   Protect: Boolean;
Begin

   Protect := True;
   (* Second loop is for verification 	*)
                     (*	for verification 						*)
   For i := 1 To 2 Do
   Begin

      If Protect Then
      Begin

         Case i Of
            1:
               Begin
                  Caption := 'Security Encryption...';
                  Prompt := 'Enter Password:';
               End;
            2:
               Begin
                  FirstPW := pw;
                  Caption := 'Verify Password...';
                  Prompt := 'Re-enter Password:';
               End;
         End;

         pw := '';
         While (pw = '') Do
            If Not InputQuery(Caption, Prompt, pw) Then
            Begin
               Protect := False;        (* Cancel selected *)
               Break;
            End;
      End;
   End;

   If Protect Then
      If CompareStr(FirstPW, pw) <> 0 Then
      Begin
         MessageDlg('Password verification failed.'#13#13 +
            'Please retry...', mtInformation, [mbOK], 0);
         Protect := False;
      End;

   If Protect Then
   Begin
      CompressComponent.Password := FirstPW; // assign password to component
      btnPassword.Caption := 'PROTECTED';
   End
   Else
   Begin
      CompressComponent.Password := '';
      btnPassword.Caption := '&Password';
   End;

End;
//-------------------------------------------------------------

Procedure TfrmAddFiles.InitializeNewCompressComponent;
Begin

   CompressComponent.ArchiveFile := frmMain.OpenDialog1.FileName;

   SetAttributeCtls();                  // set Attributes checkbox controls
   SetCompressMethodState();            // set compression method checkbox controls
   cbRecurseDirs.Checked := CompressComponent.RecurseDirs;

   ComboBox2.ItemIndex := Ord(CompressComponent.StoredDirNames);
   ComboBox3.ItemIndex := Ord(CompressComponent.DateAttribute);
   ComboBox4.ItemIndex := Ord(cmTempFile); //or cmInMemory

   If CompressComponent.Switch > swMove Then // index of active switch
      CompressComponent.Switch := swAdd;

   rgSwitch.ItemIndex := Ord(CompressComponent.Switch);

   (* Assign ListBox control active components FileSpec/ExcludeSpec properties *)
   //lstFileSpec.Items.Assign( CompressComponent.FileSpec );
   lstExcludeSpec.Items.Assign(CompressComponent.ExcludeSpec);

   btnOK.Enabled := lstFileSpec.Items.Count > 0; // disable OK if ListBox is blank
   edtFileSpec.SetFocus();

   (* If component supports password encryption, *)
   (* set button's enabled property accordingly *)
   With CompressComponent Do
   Begin
      btnPassword.Enabled := IsPasswordSupported(ArcType);
      cbEncryptHeaders.Enabled := (ArcType In [atZip, atZipMV]);
   End;

End;
//-------------------------------------------------------------

Procedure TfrmAddFiles.SetAttributeCtls;
Begin
   (* Check/uncheck Attributes selections *)
   cbArchive.Checked := (fsArchive In CompressComponent.Attributes);
   cbDirectory.Checked := (fsDirectory In CompressComponent.Attributes);
   cbHidden.Checked := (fsHidden In CompressComponent.Attributes);
   cbReadOnly.Checked := (fsReadOnly In CompressComponent.Attributes);
   cbSysFile.Checked := (fsSysFile In CompressComponent.Attributes);
   cbEncrypted.Checked := (fsEncrypted In CompressComponent.Attributes);

   (* Check/uncheck AttributesExclude selections *)
   cbArchiveEx.Checked := (fsArchive In CompressComponent.AttributesEx);
   cbDirectoryEx.Checked := (fsDirectory In CompressComponent.AttributesEx);
   cbHiddenEx.Checked := (fsHidden In CompressComponent.AttributesEx);
   cbReadOnlyEx.Checked := (fsReadOnly In CompressComponent.AttributesEx);
   cbSysFileEx.Checked := (fsSysFile In CompressComponent.AttributesEx);
   cbEncryptedEx.Checked := (fsEncrypted In CompressComponent.AttributesEx);
End;
//-------------------------------------------------------------

Procedure TfrmAddFiles.SetCompressMethodState;
Begin

   ComboBox1.Clear;
   With CompressComponent (* CompressMethodState *), ComboBox1.Items (* Add *) Do
   Begin
      If (cmStore In CompressMethodState) Then
         Add('Store');
      If (cmDeflate In CompressMethodState) Then
         Add('Deflate');
      If (cmFuse In CompressMethodState) Then
         Add('Fuse');
      {$IFDEF FROZEN1_SUPPORT}
      If (cmFrozen1 In CompressMethodState) Then
         Add('Frozen1');
      {$ENDIF}
      If (cmFrozen5 In CompressMethodState) Then
         Add('Frozen5');
      If (cmFrozen6 In CompressMethodState) Then
         Add('Frozen6');
      //IF ( cmFrozen7	IN CompressMethodState ) THEN Add( 'Frozen7' );
      If (cmMsZip In CompressMethodState) Then
         Add('MsZip');
      If (cmQuantum In CompressMethodState) Then
         Add('Quantum');
      If (cmLzx In CompressMethodState) Then
         Add('Lzx');
      If (cmTarred In CompressMethodState) Then
         Add('Tarred');
      If (cmTarGzip In CompressMethodState) Then
         Add('TarGzip');
   End;

   (* Set ComboBox1.ItemIndex to selected *)
   With ComboBox1 (* ItemIndex, Items *) Do
      Case CompressComponent.CompressMethod Of
         cmStore: ItemIndex := Items.IndexOf('Store');
         cmDeflate: ItemIndex := Items.IndexOf('Deflate');
         cmFuse: ItemIndex := Items.IndexOf('Fuse');
         cmFrozen5: ItemIndex := Items.IndexOf('Frozen5');
         cmFrozen6: ItemIndex := Items.IndexOf('Frozen6');
         //cmFrozen7: ItemIndex := Items.IndexOf( 'Frozen7' );
         cmMsZip: ItemIndex := Items.IndexOf('MsZip');
         cmQuantum: ItemIndex := Items.IndexOf('Quantum');
         cmLzx: ItemIndex := Items.IndexOf('Lzx');
         cmTarred: ItemIndex := Items.IndexOf('Tarred');
         cmTarGzip: ItemIndex := Items.IndexOf('GzipTar');
      End;

End;
//-------------------------------------------------------------

Procedure TfrmAddFiles.FormActivate(Sender: TObject);
Const
   cExt = '.BH .CAB.LHA.LZH.ZIP.ZOO.GZ .TAR.JAR.ZLIB';
Var
   Ext: String;
Begin
   lstFileSpec.Items.Clear();
   lstExcludeSpec.Items.Clear();
   rgEditList.ItemIndex := 0;
   rgSwitch.ItemIndex := 0;

   Caption := frmMain.OpenDialog1.FileName;
   edtDefaultDir.Text := GetCurrentDir();

   If (CompressComponent = Nil) Or
      (CompressComponent.ArchiveFile = '') Then
   Begin

      (* Enable/disable archive type radio buttons *)
      With CompressComponent (* IsArcCompressable *) Do
      Begin
         rbArj.Enabled := IsArcCompressable(atArj);
         rbCab.Enabled := IsArcCompressable(atCab);
         rbBh.Enabled := IsArcCompressable(atBh);
         rbGZip.Enabled := IsArcCompressable(atGZip);
         rbJar.Enabled := IsArcCompressable(atJar);
         rbLha.Enabled := IsArcCompressable(atLha);