unit1.pas

ziptv为delphi控件

         rbTar.Enabled := IsArcCompressable(atTar);
         rbZip.Enabled := IsArcCompressable(atZip);
         rbZipSplitter.Enabled := IsArcCompressable(atZipMV);
         {$IFDEF use_zlib}
         rbZLib.Enabled := IsArcCompressable(atZLib);
         {$ENDIF use_zlib}
         rbZoo.Enabled := IsArcCompressable(atZoo);
      End;

      Ext := UpperCase(ExtractFileExt(frmMain.OpenDialog1.FileName));

      (* Check file extensions first to associate archive type       	*)
      (* To speed the process, check for position in cEXT instead of		*)
      (* comparing strings.                                             *)
      Case Pos(Ext, cExt) Of
         1: DefineCompressorClick(rbBh);
         5: DefineCompressorClick(rbCab);
         9, 13: DefineCompressorClick(rbLha);
         17: DefineCompressorClick(rbZipSplitter {rbZip});  // use the new TZipSplitter component by default for .zip files
         21: DefineCompressorClick(rbZoo);
         25: DefineCompressorClick(rbGZip);
         29: DefineCompressorClick(rbTar);
         33: DefineCompressorClick(rbJar);
         37: DefineCompressorClick(rbZLib);
      Else
         (* Use tag stored in frmMain (default=BH) *)
         DefineCompressorClick(frmMain);
      End;

   End
   Else
   Begin

      rbArj.Enabled := False;
      rbBh.Enabled := False;
      rbCab.Enabled := False;
      rbGZip.Enabled := False;
      rbLha.Enabled := False;
      rbJar.Enabled := False;
      rbTar.Enabled := False;
      rbZip.Enabled := False;
      rbZipSplitter.Enabled := False;
      rbZLib.Enabled := False;
      rbZoo.Enabled := False;

      // If archive has previously been
      // open then ArcType is retained
      Case frmMain.ZipTV1.ArcType Of

         atBh:
            Begin
               DefineCompressorClick(rbBh);
               rbBh.Enabled := True;
            End;

         atCab:
            Begin
               DefineCompressorClick(rbCab);
               rbCab.Enabled := True;
            End;

         atGZip:
            Begin
               DefineCompressorClick(rbGZip);
               rbGZip.Enabled := True;
            End;

         atJar:
            Begin
               DefineCompressorClick(rbJar);
               rbJar.Enabled := True;
            End;

         atLha,
            atLzh:
            Begin
               DefineCompressorClick(rbLha);
               rbLha.Enabled := True;
            End;

         atTar:
            Begin
               DefineCompressorClick(rbTar);
               rbTar.Enabled := True;
            End;

         //atZip:
         //   Begin
         //      DefineCompressorClick(rbZip);
         //      rbZipSplitter.Enabled := True;
         //      rbZip.Enabled := True;
         //   End;

         atZipMV:                       // multi-volume archives
            Begin
               DefineCompressorClick(rbZipSplitter);
               rbZipSplitter.Enabled := True;
               //rbZip.Enabled := True;
            End;

         {$IFDEF use_zlib}
         atZLib:
            Begin
               DefineCompressorClick(rbZLib);
               rbZLib.Enabled := True;
            End;
         {$ENDIF}
         atZoo:
            Begin
               DefineCompressorClick(rbZoo);
               rbZoo.Enabled := True;
            End;
      Else
         Exit;
      End;

   End;

   (* Enable/disable the DeflateType option buttons *)
   rgDeflateType.Enabled := CompressComponent.CompressMethod = cmDeflate;
   If lstFileSpec.Items.Count = 0 Then
   Begin
   	// ********************************
    	// testing of different FileSpec(s)
      // ********************************
		//edtFileSpec.Text := 'd:\windows\system32\a*.exe';
		//lstFileSpec.Items.Add('d:\windows\system32\w*.exe');
   End;

   // ********************
   // for testing purposes
   // ********************
   //If lstExcludeSpec.Items.Count = 0 Then
   //Begin
   //	lstExcludeSpec.Items.Add( 't*.*' );
   //	lstExcludeSpec.Items.Add( 'c*.exe' );
   //	lstExcludeSpec.Items.Add( 'net.exe' );
   //	lstExcludeSpec.Items.Add( 'uninst.exe' );
   //	lstExcludeSpec.Items.Add( 'n6uninst.exe' );
   //	lstExcludeSpec.Items.Add( 'drvspace.exe' );
   //End;

   edtFileSpec.SetFocus();
   edtFileSpec.SelStart := 0;
   edtFileSpec.SelLength := Length(edtFileSpec.Text);
End;
//-------------------------------------------------------------

Function TfrmAddFiles.AddToList: Boolean;
Var
   Dir: String;
Begin
   Result := True;

   If edtFileSpec.Text <> '' Then
   Begin

      If lstFileSpec.Visible Then
      Begin

         (* if edtFileSpec edit control has dir... use this *)
         (* of the value of the edtDefaultDir edit control     *)
         Dir := ExtractFileDir(edtFileSpec.Text);

         If Dir = '' Then
            Dir := edtDefaultDir.Text;

         If Dir = '' Then
            Dir := GetCurrentDir();

         (* append dir slash '\' *)
         Dir := AppendDirTail(Dir);

         edtFileSpec.Text := Dir + ExtractFilename(edtFileSpec.Text);

         lstFileSpec.Items.Insert(0, edtFileSpec.Text);
         lstFileSpec.ItemIndex := 0;
         btnOK.Enabled := True;
      End
      Else
      Begin                             //lstExcludeSpec control is visible
         lstExcludeSpec.Items.Insert(0, edtFileSpec.Text);
         lstExcludeSpec.ItemIndex := 0;
      End;

      edtFileSpec.Text := '';

   End
   Else
      Result := False;

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

Procedure TfrmAddFiles.btnSelectDirClick(Sender: TObject);
Var
   Dir: String;
Begin
   Dir := edtDefaultDir.Text;
   If SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt], -1) Then
   Begin
      SetCurrentDir(Dir);
      edtDefaultDir.Text := Dir;
   End;
End;
//-------------------------------------------------------------

Procedure TfrmAddFiles.edtFileSpecKeyPress(Sender: TObject; Var Key: Char);
Begin
   If Key = #13 Then
      If AddToList() Then
      Begin
         edtFileSpec.Text := '';
         edtFileSpec.SetFocus();
      End;
End;
//-------------------------------------------------------------

Procedure TfrmAddFiles.PopupMenu1Popup(Sender: TObject);
Const
   REM_SELECTED = 0;
   REM_ALL = 1;
Var
   i, j: Integer;
Begin

   Case TMenuItem(Sender).MenuIndex Of

      REM_SELECTED:
         Begin
            j := 0;
            If lstFileSpec.Visible Then
            Begin
               For i := 1 To lstFileSpec.Items.Count Do
                  If lstFileSpec.Selected[j] Then
                     lstFileSpec.Items.Delete(j)
                  Else
                     Inc(j);
            End
            Else
               For i := 1 To lstExcludeSpec.Items.Count Do
                  If lstExcludeSpec.Selected[j] Then
                     lstExcludeSpec.Items.Delete(j)
                  Else
                     Inc(j);
         End;

      REM_ALL:
         If MessageDlg('Clear all?', mtConfirmation, [mbYes, mbNo],
            0) = mrYes Then
            If lstFileSpec.Visible Then
               lstFileSpec.Clear()
            Else
               lstExcludeSpec.Clear();

   End;

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

   edtFileSpec.SetFocus();
End;
//-------------------------------------------------------------
(** Assign the CompressMethod property **)

Procedure TfrmAddFiles.MethodButtonsClick(Sender: TObject);
Var
   CompressMethodIndex: Byte;
Begin
   CompressMethodIndex := TRadioButton(Sender).Tag;

   // TCompressMethod is defined in ztvBase.pas
   CompressComponent.CompressMethod := TCompressMethod(CompressMethodIndex);
End;
//-------------------------------------------------------------
(* Assign the variable CompressComponent (type TCompBase) the
   desired compression component dropped on the form

   All radio buttons 'tag property' hold a stored value that
   this routine checks to verify which was selected.

   If 'New' is selected from the main form (frmMain), retrieve
   the previous archive type used from the stored value in
   frmMain's tag property... else retreive the value of the
   tag property from the radio button selected on this form.

   After radio button is selected, store the selected buttons
   tag value in frmMain.tag property so the last archive type
   used can be set automatically when this form is once again
   activated.

*)
Var
   r: Boolean = False;

Procedure TfrmAddFiles.DefineCompressorClick(Sender: TObject);
Begin

   If r Then
      Exit;
   r := True;

   If (Sender Is TRadioButton) Then
      Tagger := TRadioButton(Sender).Tag // clicked a radio button
   Else
      Tagger := TForm(Sender).Tag;      // called from FormActivate event

   Try
      Case Tagger Of
         //cArj 		:;		// Component to be added in future versions
         cBlakHole:
            Begin
               CompressComponent := frmMain.BlakHole1;
               rbBh.Checked := True;
            End;
         cCab:
            Begin
               CompressComponent := frmMain.MakeCab1;
               rbCab.Checked := True;
            End;
         cGZip:
            Begin
               CompressComponent := frmMain.GZip1;
               rbGZip.Checked := True;
               ShowMessage(
                  'All files matching the "File(s):" field'#13 +
                  'on this form, will be compressed as single'#13 +
                  'files in "Default Dir:" '
                  );
            End;
         cJar:
            Begin
               CompressComponent := frmMain.Jar1;
               rbJar.Checked := True;
            End;
         cLha:
            Begin
               CompressComponent := frmMain.Lha1;
               rbLha.Checked := True;
            End;

         cTar:
            Begin
               CompressComponent := frmMain.Tar1;
               rbTar.Checked := True;
            End;

         cZip:
            Begin
               CompressComponent := frmMain.Zip1;
               rbZip.Checked := True;
            End;

         cZipSplitter:
            Begin
               CompressComponent := frmMain.ZipSplitter1;
               rbZipSplitter.Checked := True;
            End;

         {$IFDEF use_zlib}
         cZLib:
            Begin
               CompressComponent := frmMain.ZLib1;
               rbZLib.Checked := True;
            End;
         {$ENDIF}
         //cZoo     :;		// Component to be added in future versions
      Else

         (* Default *)
         CompressComponent := frmMain.BlakHole1;
         rbBh.Checked := True;
         Tagger := rbBh.Tag;

      End;

      (* Reset form controls to match compression components properties *)
      InitializeNewCompressComponent();

   Finally
      frmMain.Tag := Tagger;            // Store the tag in frmMain
      r := False;
   End;

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

{Procedure TfrmAddFiles.edtDirFileSpecExit( Sender: TObject );
Begin
   If edtDirFileSpec.Text = '' Then edtDirFileSpec.Text := '*.*';
End;}
//-------------------------------------------------------------

Procedure TfrmAddFiles.edtFileSpecEnter(Sender: TObject);
Begin
   edtFileSpec.SelStart := 0;
   edtFileSpec.SelLength := Length(edtFileSpec.Text);
End;
//-------------------------------------------------------------

Procedure TfrmAddFiles.btnRemoveMouseDown(Sender: TObject;
   Button: TMouseButton; Shift: TShiftState; x, y: Integer);
Var
   MousePos: TPoint;
Begin
   GetCursorPos(MousePos);
   PopupMenu1.AutoPopup := False;
   PopupMenu1.Popup(MousePos.x, MousePos.y);
End;
//-------------------------------------------------------------

Procedure TfrmAddFiles.lstFileSpecClick(Sender: TObject);
Begin
   If lstFileSpec.Visible Then
      edtFileSpec.Text := lstFileSpec.Items[lstFileSpec.ItemIndex]
   Else
      edtFileSpec.Text := lstExcludeSpec.Items[lstExcludeSpec.ItemIndex]
End;
//-------------------------------------------------------------
(** Assign the CompressMethod property **)

Procedure TfrmAddFiles.ComboBox1Change(Sender: TObject);
Var
   i, bIndex: Byte;
Const
   CompressedTypeName: Array[Ord(cmStore)..Ord(cmTarGzip)] Of String =
      (
      'Store',
      'Deflate',
      'Fuse',
      {$IFDEF FROZEN1_SUPPORT}
      'Frozen1',
      {$ENDIF}
      'Frozen5',
      'Frozen6',
      //'Frozen7',
      'MsZip',
      'Lzx',
      'Quantum',
      'UUEncode',
      'XXEncode',
      'Base64',
      'Tarred',
      'TarGzip'
      );
Begin

   (* Compare text in the combobox with one of the strings in the	*)
   (* above array.  This comparison is case sensitive. 				*)
   bIndex := 0;
   For i := Ord(cmStore) To Ord(cmTarGzip) Do
      If ComboBox1.Items[ComboBox1.ItemIndex] = CompressedTypeName[i] Then
      Begin
         bIndex := i;
         Break;
      End;

   CompressComponent.CompressMethod := TCompressMethod(bIndex);
   rgDeflateType.Enabled := CompressComponent.CompressMethod = cmDeflate;
End;
//-------------------------------------------------------------

Procedure TfrmAddFiles.edtFileSpecChange(Sender: TObject);
Begin
   btnOK.Enabled := (lstFileSpec.Items.Count > 0) Or
      ((edtFileSpec.Text <> ''));
End;
//-------------------------------------------------------------

Procedure TfrmAddFiles.rgEditListClick(Sender: TObject);
Begin
   lstFileSpec.Visible := lstFileSpec.Visible Xor True;
   lstExcludeSpec.Visible := lstExcludeSpec.Visible Xor True;
   edtFileSpec.SetFocus();
End;
//-------------------------------------------------------------

Procedure TfrmAddFiles.edtDefaultDirExit(Sender: TObject);
Begin
   SetCurrentDir(edtDefaultDir.Text);
End;
//-------------------------------------------------------------

// rbZipSplitter (radio button) OnDblClick event.  Activate the
// OnClick event.

Procedure TfrmAddFiles.rbZipSplitterDblClick(Sender: TObject);
Begin
   DefineCompressorClick(Sender);
End;
//-------------------------------------------------------------

End.