unit1.pas

ziptv为delphi控件

Unit Unit1;

Interface

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

{.$DEFINE THREADSAFE}//working on threading modal... not yet availale
{$DEFINE LISTVIEW}

Uses
   Windows,
   Messages,
   SysUtils,
   Classes,
   Graphics,
   Controls,
   Forms,
   Dialogs,
   StdCtrls,
   Buttons,
   FileCtrl,
   Err_Msgs,
   ComCtrls,
   ExtCtrls,
   Gauges,
   Menus,
   ztvBase,
   ztvGbls,
   ztvZipTV,
   ztvZipRun,
   ztvFindFile,
   ztvRegister,
   ztvZipView{$IFDEF THREADSAFE},
   MultiTasker{$ENDIF};

Type
   TfrmMain = Class(TForm)
      ZipRun1: TZipRun;
      FindFile1: TztvFindFile;
      MainMenu1: TMainMenu;
      File1: TMenuItem;
      File2: TMenuItem;
      Exit1: TMenuItem;
      ErrorMessages1: TMenuItem;
      ListView1: TListView;
      CheckBox1: TCheckBox;
      CheckBox2: TCheckBox;
      CheckBox3: TCheckBox;
      Panel1: TPanel;
      Panel2: TPanel;
      Panel3: TPanel;
      Panel4: TPanel;
      Panel5: TPanel;
      Panel6: TPanel;
      Panel7: TPanel;
      Panel8: TPanel;
      Panel9: TPanel;
      Panel10: TPanel;
      Label1: TLabel;
      Label2: TLabel;
      Label3: TLabel;
      Label4: TLabel;
      Label5: TLabel;
      edtArcMask: TEdit;
      edtDirMask: TEdit;
      edtSearchDir: TEdit;
      btnCancel: TButton;
      btnDir: TBitBtn;
      btnExit: TButton;
      btnOK: TButton;
      StatusBar1: TStatusBar;
      StatusBar2: TStatusBar;
      ProgressBar1: TProgressBar;
      ProgressBar2: TProgressBar;
      ZipView1: TZipView;
      Procedure btnOKClick(Sender: TObject);
      Procedure btnDirClick(Sender: TObject);
      Procedure btnCancelClick(Sender: TObject);
      Procedure CheckBox2Click(Sender: TObject);
      Procedure ErrorMessages1Click(Sender: TObject);
      Procedure Exit1Click(Sender: TObject);
      Procedure FormActivate(Sender: TObject);
      Procedure FormCreate(Sender: TObject);
      Procedure FormDestroy(Sender: TObject);
      Procedure FindFile1Progress(Sender: TObject; ProgressByFile, ProgressByArchive:
         Byte);
      Procedure FindFile1Error(Sender: TObject; FileName, MsgEx, VolumeID: String; ECode:
         Integer);
      Procedure FindFile1Activate(Sender: TObject);
      Procedure FindFile1Deactivate(Sender: TObject);
      Procedure FindFile1FoundFile(Sender: TObject);
      Procedure FindFile1GetPassword(Sender: TObject; FName: String; Var Password:
         String; Var TryAgain: Boolean);
      Procedure FindFile1ExtractBegin(Sender: TObject; FName: String; Count: Integer; Var
         Extract: Boolean);
      Procedure FindFile1ExtractEnd(Sender: TObject; FileName: String; CRC_PASS:
         Boolean);
      Procedure FindFile1CurrentDir(Sender: TObject; Dir: String);
      Procedure FindFile1CurrentFile(Sender: TObject; FileName: String);
      Procedure FindFile1ElapsedTime(Sender: TObject; ElapsedTime: Single);
      Procedure FindFile1NextVolume(Sender: TObject; Var Dir, FileName: String;
         VolumeID: String; FExists: Boolean; Var Cancel: Boolean);
      Procedure FindFile1CurrentArchive(Sender: TObject; ArchiveFile: String);
      Procedure ListView1DblClick(Sender: TObject);
      Procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn);
      Procedure Panel2MouseMove(Sender: TObject; Shift: TShiftState; x, y: Integer);

      Procedure MultiTasker1AllTaskFinished;
      Procedure MultiTasker1TaskFinished;
      Procedure MultiTasker1Error;
      Procedure MultiTasker1TaskLaunched;
      Procedure MultiTasker1Waiting;
   Private
   Public
      {$IFDEF THREADSAFE}
      MultiTasker1: TMultiTasker;
      {$ENDIF}
   End;

Var
   frmMain: TfrmMain;

Implementation

Uses Unit2;

{$R *.DFM}

//-------------------------------------------------------------
(* ztvFindFile OnError event *)

Procedure TfrmMain.FindFile1Error(Sender: TObject; FileName, MsgEx,
   VolumeID: String; ECode: Integer);
Const
   _SPACE = #32#32#32;
Var
   Msg: String;
Begin
   Msg := LowerCase(TZipCommon(Sender).ArchiveFile) + ':' +
      _SPACE +
      LowerCase(FileName) +
      _SPACE;

   Case ECode Of

      E_BASE..E_WIN32:                  (* All error codes *)

         Msg := Msg + 'Error#: ' + IntToStr(ECode) + _SPACE +
            ': ' + LoadStr(ECode);

      M_BASE..M_DIRNOTEXIST:            (* All message codes *)
         Begin

            Msg := Msg + 'Message#: ' + IntToStr(ECode) + _SPACE +
               ': ' + LoadStr(ECode);

         End;
   Else
      Exit;                             (* <- no msg *)
   End;

   Msg := Msg + _SPACE + MsgEx;
   frmErrorMsgs.ListBox1.Items.Insert(0, Msg);
End;

(* **************************************************** *)
(* ztvFindFile OnFoundFile event								*)
(* All properties available in the TZipTV component's  	*)
(* OnRead event are also available here.  See help for 	*)
(* more info  														*)
(* **************************************************** *)
(* Add found filenames to the listbox 						*)
(* **************************************************** *)
(* OnFoundFile event *)

Procedure TfrmMain.FindFile1FoundFile(Sender: TObject);
Var
   ZipTV: TZipTV;
   {$IFDEF ListView}
   NewItem: TListItem;
   {$ELSE}
   BuildString: AnsiString;             (* Long String *)
   {$ENDIF}
Begin
   ZipTV := TZipTV(Sender);

   {$IFDEF ListView}
   NewItem := ListView1.Items.Add;      (* Create a new row 			*)

   NewItem.Caption := ZipTV.FileName;   (* Filename property 		*)
   NewItem.SubItems.Add(                (* Date property 				*)
      FormatDateTime('mm' + DateSeparator +
      'dd' + DateSeparator +
      'yy hh:mm', ZipTV.Date));

   NewItem.SubItems.Add(                (* UnpackedSize property	*)
      IntToStr(ZipTV.UnpackedSize));

   If Not FindFile1.RecurseDirs Then    (* ArchiveFile property		*)
      NewItem.SubItems.Add(ExtractFilename(ZipTV.ArchiveFile))
   Else
      NewItem.SubItems.Add(ZipTV.ArchiveFile);

   NewItem.SubItems.Add(FindFile1.ParentArchive);

   {$ELSE}                              // use Delphi's ListView component

   With ZipView1 Do                     (* for the Delimiter variable *)
   Begin

      BuildString :=
         ZipTV.FileName + Delimiter +

      (* Date / Time Column *)
      FormatDateTime('mm' + DateSeparator + 'dd' + DateSeparator + 'yy hh:mm', ZipTV.Date)
         + Delimiter +

      (* Size Column	*)
      IntToStr(ZipTV.UnpackedSize) + Delimiter +

      (* Archive Column	*)
      ExtractFilename(ZipTV.ArchiveFile) + Delimiter +

      (* ParentArchive Column	*)
      ExtractFilename(FindFile1.ParentArchive);
      ZipView1.Items.Add(BuildString);
   End;

   {$ENDIF}
End;
//-------------------------------------------------------------
(* Ok button click event *)

Procedure TfrmMain.btnOKClick(Sender: TObject);
Const
   SepChars: Set Of Char = [' ', ',', ';', #0];
   //Var
   //	i, j: Integer;
Begin

   btnOK.Enabled := False;              // while working, turn off
   btnExit.Enabled := False;

   Try
      If (Not DirExists(edtSearchDir.Text)) Then
      Begin
         ShowMessage('Can''t find directory...');
         Exit;
      End;

      FindFile1.RootDir := edtSearchDir.Text;

      FindFile1.FileSpec.Clear();
      If edtArcMask.Text = '' Then
         FindFile1.FileSpec.Add('*.*')
      Else
      Begin

         // ParseStrToTStrings is ztvGbls.pas.  Convert a string of wildcards,
         // seperated by space, comma, or a semi-colon into TStrings items.
         StrToTStrings(Pchar(edtArcMask.Text), FindFile1.FileSpec);

         (* test with multiple FileSpec strings *)
         //FindFile1.FileSpec.Add( '*.exe' );
         //FindFile1.FileSpec.Add( '*.txt' );
         //FindFile1.FileSpec.Add( '*.doc' );
      End;

      FindFile1.RecurseDirs := CheckBox1.Checked;
      FindFile1.RecurseNestedArchives := CheckBox2.Checked;
      {$IFDEF THREADSAFE}
      FindFile1.DirSpec := edtDirMask.Text;
      MultiTasker1.LaunchTask(FindFile1.Execute);
      {$ELSE}
      FindFile1.DirSpec := edtDirMask.Text;
      FindFile1.Find {( edtDirMask.Text )};
      {$ENDIF}

   Finally
      btnOK.Enabled := True;
      btnExit.Enabled := True;
   End;
End;
//-------------------------------------------------------------
(* Directory select button *)

Procedure TfrmMain.btnDirClick(Sender: TObject);
Var
   Dir: String;
Begin
   Dir := edtSearchDir.Text;
   If SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt], -1) Then