unit8.pas

ziptv为delphi控件

Unit Unit8;

Interface

Uses
   Windows,
   Messages,
   SysUtils,
   Classes,
   Graphics,
   Controls,
   Forms,
   Dialogs,
   StdCtrls,
   Buttons,
   ComCtrls,
   Gauges,
   ExtCtrls,
   Menus,
   ztvRegister,
   ztvBase,
   ztvGbls,
   Err_Msgs,
   ztvZipCheck;

Type
   TfrmTestArchive = Class(TForm)
      ZipCheck1: TZipCheck;
      Panel1: TPanel;
      Panel2: TPanel;
      Panel3: TPanel;
      pnlStatus: TPanel;
      Label1: TLabel;
      Label2: TLabel;
      Label3: TLabel;
      imgLed: TImage;
      pbxLed: TPaintBox;
      edtArchiveFile: TEdit;
      edtFileSpec: TEdit;
      StatusBar1: TStatusBar;
      Memo1: TMemo;
      btnOK: TBitBtn;
      btnClose: TBitBtn;
      Gauge1: TGauge;
      Gauge2: TGauge;
      CheckBox1: TCheckBox;
      Procedure FormActivate(Sender: TObject);
      Procedure btnOKClick(Sender: TObject);
      Procedure btnCloseClick(Sender: TObject);
      Procedure pbxLedPaint(Sender: TObject);
      Procedure SetLedColor(lColor: TColor);
      Procedure pbxLedClick(Sender: TObject);
      Procedure ZipCheck1Status(Sender: TObject; FN: String; PassFail: Boolean);
      Procedure ZipCheck1Error(Sender: TObject; FN, MsgEx, VolumeID: String;
      	ECode: Integer);
      Procedure ZipCheck1GetPassword(Sender: TObject; FileName: String;
      	Var Password: String; Var TryAgain: Boolean);
      Procedure ZipCheck1Begin(Sender: TObject; FileName: String; RecNum:
      	Integer; Var Extract: Boolean);
      Procedure ZipCheck1Activate(Sender: TObject);
      Procedure ZipCheck1Deactivate(Sender: TObject);
      Procedure ZipCheck1Progress(Sender: TObject; ProgressByFile,
      	ProgressByArchive: Byte);
      Procedure ZipCheck1NextVolume(Sender: TObject; Var VolumeName: String;
         VolumeID: Integer; FExists: Boolean; Var Cancel: Boolean);
      Procedure ZipCheck1CorruptZipHeader(Sender: TObject; HeadFlag:
         THeaderTypeState; Var Cancel: Boolean);
      Procedure ZipCheck1GetZipFirstDisk(Sender: TObject; Var Cancel: Boolean);
      Procedure ZipCheck1GetZipNextDisk(Sender: TObject; VolumeName: String;
         Var Cancel: Boolean);
      Procedure ZipCheck1GetZipLastDisk(Sender: TObject; Var Cancel: Boolean);
      Procedure ZipCheck1NestedTarFile(Sender: TObject; FileName: String;
      	Var DoUnTar: Boolean);
      Procedure ZipCheck1FileExists(Sender: TObject; FileName: String;
         Var NewFileName: String; Var OverwriteMode: TOverwriteMode);
      Procedure edtFileSpecKeyPress(Sender: TObject; Var Key: Char);
      Procedure ZipCheck1ChangeArchive(Sender: TObject; ArchiveName: String;
         ArcType: TArcType);
      Procedure ZipCheck1ElapsedTime(Sender: TObject; ElapsedTime: Single);
   Private
      { Private declarations }
   Public
      { Public declarations }
   End;

Var
   frmTestArchive: TfrmTestArchive;

Implementation

Uses
   Main;

{$R *.DFM}
{$I defines.inc} //use our TZipView or Delphi's slow TListView control?

Var
   Busy: Boolean = False;

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

Procedure TfrmTestArchive.FormActivate(Sender: TObject);
Const
   SepChar = ',';
   (* Column Headers *)
   COLUMN_FILENAME = 0;
   COLUMN_FOLDER = 7;
   COLUMN_VOLUMENAME = 12;
Var
   i: Integer;
   TempFileSpec: String;
Begin
   Memo1.Clear();
   Gauge1.Progress := 0;
   Gauge2.Progress := 0;
   TempFileSpec := '';

   (* Add all selected rows to edtFileSpec.Text property *)
   {$ifdef ListView}
   With frmMain.ListView1 Do
   Begin
      For i := 0 To Pred(frmMain.ListView1.Items.Count) Do
         If Items[i].Selected Then
            AppendStr(TempFileSpec,
               SepChar +
               Items[i].SubItems[COLUMN_FOLDER - 1] +
               Items[i].Caption);
   End;
   {$else}
   With frmMain.ZipView1 Do
      For i := 0 To Items.Count - 1 Do
         If Selected[i] Then
            AppendStr(TempFileSpec, SepChar +
               Column[i, COLUMN_FOLDER] +
               Column[i, COLUMN_FILENAME]);
   {$endif ListView}

   If Length(TempFileSpec) > 1 Then
      edtFileSpec.Text := Copy(TempFileSpec, 2, Length(TempFileSpec));

   If edtFileSpec.Text = '' Then
      edtFileSpec.Text := frmMain.ZipTV1.FileSpec[0];

   edtArchiveFile.Text := frmMain.ZipTV1.ArchiveFile;
   edtFileSpec.SetFocus();
End;
//-------------------------------------------------------------
(* Ok button click event *)

Procedure TfrmTestArchive.btnOKClick(Sender: TObject);
Var
   ArchiveFileName: String;
Begin
   If Busy Then
      Exit;

   Memo1.Clear();
   Memo1.Cursor := crHourGlass;
   Memo1.Lines.BeginUpdate();
   Gauge1.Progress := 0;
   Gauge2.Progress := 0;

   Busy := True;
   btnOK.Enabled := False;
   btnClose.Enabled := False;
   ArchiveFileName := edtArchiveFile.Text;
   Try
      ZipCheck1.FileSpec.Clear();

      //ZipCheck1.FileSpec.Add( edtFileSpec.Text );

      // convert a list of strings (separated by comma's) into
      // a TStrings and add list to the FileSpec property
      If edtFileSpec.Text <> '' Then
         ztvGbls.StrToTStrings(Pchar(edtFileSpec.Text), ZipCheck1.FileSpec);

      ZipCheck1.RecurseDirs := CheckBox1.Checked;
      ZipCheck1.ArchiveFile := edtArchiveFile.Text;

      // boolean value from demo's main.pas CheckBox1 control
      ZipCheck1.TranslateOemChar := frmMain.CheckBox1.Checked;  // ...foreign language chars

      (* Set local cancel pointer to correct component *)
      DoCancel := ZipCheck1.SetCancel;

      If ZipCheck1.IsArcDecompressable(ZipCheck1.ArcType) Then
         // ====================
         ZipCheck1.Activate()           // activate the validation check
         // ====================
      Else
         ShowMessage(LoadStr(E_INVALIDARC));

   Finally
      Memo1.Cursor := crDefault;
      Memo1.Lines.EndUpdate();
      edtFileSpec.SetFocus;
      btnOK.Enabled := True;
      btnClose.Enabled := True;
      Busy := False;
      edtArchiveFile.Text := ArchiveFileName;
   End;
End;
//-------------------------------------------------------------

Procedure TfrmTestArchive.btnCloseClick(Sender: TObject);
Begin
   Close;
End;
//-------------------------------------------------------------
(* TZipCheck OnStatus Event - display validation pass/fail *)

Procedure TfrmTestArchive.ZipCheck1Status(Sender: TObject; FN: String; PassFail:
   Boolean);
Var
   s: String;
Begin
   If PassFail Then
      s := FN + ' ...Ok'
   Else
      s := FN + ' ...Failed';

   Memo1.Lines.Add(s);
End;
//-------------------------------------------------------------