unit8.pas

ziptv为delphi控件

(* TZipCheck OnError event *)

Procedure TfrmTestArchive.ZipCheck1Error(Sender: TObject; FN, MsgEx,
   VolumeID: String; ECode: Integer);
Begin
   frmMain.ZipTV1Error(Sender, FN, MsgEx, VolumeID, ECode);
End;
//-------------------------------------------------------------
(* TZipCheck OnGetPassword event - request password from user *)

Procedure TfrmTestArchive.ZipCheck1GetPassword(Sender: TObject; FileName: String;
   Var Password: String; Var TryAgain: Boolean);
Begin
   frmMain.UnZIP1GetPassword(Sender, FileName, Password, TryAgain);
End;
//-------------------------------------------------------------
(* TZipCheck OnBegin event - activated prior to verifing a compressed file *)

Procedure TfrmTestArchive.ZipCheck1Begin(Sender: TObject; FileName: String;
   RecNum: Integer; Var Extract: Boolean);
Begin
   StatusBar1.SimpleText := 'Verifying:  ' + FileName;
   StatusBar1.Update();
End;
//-------------------------------------------------------------
(* OnActivate event - activated prior to verification of any compressed files *)

Procedure TfrmTestArchive.ZipCheck1Activate(Sender: TObject);
Begin
   SetLedColor(clRed);
End;
//-------------------------------------------------------------
(* OnDeactivate event - activated after all files have been verified *)

Procedure TfrmTestArchive.ZipCheck1Deactivate(Sender: TObject);
Begin
   SetLedColor(clGreen);
   If ZipCheck1.Cancel Then
      StatusBar1.SimpleText := 'User canceled...'
   Else
      StatusBar1.SimpleText := '';

   edtArchiveFile.Text := ZipCheck1.ArchiveFile;
End;
//-------------------------------------------------------------
(* OnProgress event - activated in increments of ProgressNotify property *)

Procedure TfrmTestArchive.ZipCheck1Progress(Sender: TObject; ProgressByFile,
   ProgressByArchive: Byte);
Begin
   Gauge1.Progress := ProgressByFile;
   Gauge2.Progress := ProgressByArchive;
   Application.ProcessMessages;
End;
//-------------------------------------------------------------
(* Little light in right corner of form *)

Procedure TfrmTestArchive.pbxLedPaint(Sender: TObject);
Begin
   With Sender As TPaintBox Do
      Canvas.Draw((Width - imgLed.Width) Div 2,
         (Height - imgLed.Height) Div 2, imgLed.Picture.Graphic);
End;
//-------------------------------------------------------------
(* Change colors of little light in corner of form *)

Procedure TfrmTestArchive.SetLedColor(lColor: TColor);
Begin
   With imgLed.Canvas Do
   Begin
      Brush.Color := lColor;
      FloodFill(6, 6, Pixels[6, 6], fsSurface);
   End;
   pbxLed.Repaint();
End;
//-------------------------------------------------------------
(* Cancel operation on current archive - see note at top of module *)

Procedure TfrmTestArchive.pbxLedClick(Sender: TObject);
Begin
   StatusBar1.SimpleText := 'Aborting...';
   frmMain.pbxLedClick(Sender);
   //ZipCheck1.Cancel := TRUE;
End;
//-------------------------------------------------------------
(* OnNextVolume event ( for multi-volume archives *)

Procedure TfrmTestArchive.ZipCheck1NextVolume(Sender: TObject; Var VolumeName: String;
   VolumeID: Integer; FExists: Boolean; Var Cancel: Boolean);
Begin
   // use main.pas OnNextVolume event
	frmMain.ZipTV1NextVolume(Sender, VolumeName, VolumeID, FExists, Cancel);
   edtArchiveFile.Text := VolumeName;
End;
//-------------------------------------------------------------
(* OnCorruptZipHeader event 																	  *)
(* Only problem headers in zip archives will ever call this event               *)
(*                                                                              *)
(*                                                                              *)
(* HeadFlag parameter:                                                          *)
(*       (there are other possible combinations not listed below)               *)
(*                                                                              *)
(*    HeadFlag And htLocal > 0                                                  *)
(*       (local zip header was found)                                           *)
(*                                                                              *)
(*    HeadFlag And htCentral > 0                                                *)
(*       (central zip header was found)                                         *)
(*                                                                              *)
(*    HeadFlag And htEnding > 0                                                 *)
(*       (ending zip header was found)                                          *)
(*                                                                              *)
(*    HeadFlag And (htLocal + htCentral) > 0                                    *)
(*       (ending zip header is missing/corrupt)                                 *)
(*                                                                              *)
(*    HeadFlag And (htCentral + htEnding) > 0                                   *)
(*       (local zip header is missing)                                          *)
(*                                                                              *)
(*    HeadFlag And (htLocal + htCentral + htEnding) > 0                         *)
(*       (all zip headers were found)                                           *)
(*                                                                              *)
(* Set "cancel" as true to interrupt processing of a bad archive... otherwise   *)
(* processing continues with data recovery functionss 								  *)

Procedure TfrmTestArchive.ZipCheck1CorruptZipHeader(Sender: TObject; HeadFlag:
   THeaderTypeState; Var Cancel: Boolean);
Begin
   Memo1.Lines.Add('--> OnCorruptZipHeader Event <--');

   If Not (htLocal In HeadFlag) Then
      Memo1.Lines.Add('LOCAL header missing or corrupt...');

   If Not (htCentral In HeadFlag) Then
      Memo1.Lines.Add('CENTRAL header missing or corrupt...');

   If Not (htEnding In HeadFlag) Then
      Memo1.Lines.Add('ENDING header missing or corrupt...');

   //If Not ( (htCentral In HeadFlag) And (htEnding In HeadFlag)) Then
   //   Memo1.Lines.Add( 'Header error... (missing or corrupt)' );

   Memo1.Lines.Add('--------------------------------');
   Memo1.Lines.Add('');
   Cancel := False; //setting this to true will terminate the active process
End;
//-------------------------------------------------------------

Procedure TfrmTestArchive.ZipCheck1GetZipFirstDisk(Sender: TObject; Var Cancel: Boolean);
Begin
   frmMain.ZipTV1GetZipFirstDisk(Sender, Cancel);
End;
//-------------------------------------------------------------

Procedure TfrmTestArchive.ZipCheck1GetZipNextDisk(Sender: TObject;
   VolumeName: String; Var Cancel: Boolean);
Begin
   frmMain.ZipTV1GetZipNextDisk(Sender, VolumeName, Cancel);
End;
//-------------------------------------------------------------

Procedure TfrmTestArchive.ZipCheck1GetZipLastDisk(Sender: TObject; Var Cancel: Boolean);
Begin
   frmMain.ZipTV1GetZipLastDisk(Sender, Cancel);
End;
//-------------------------------------------------------------
(* OnNestedTarFile event *)

Procedure TfrmTestArchive.ZipCheck1NestedTarFile(Sender: TObject; FileName: String; Var
   DoUnTar: Boolean);
Var
   CR, CRCR: String;
Begin
   CR := #13;
   CRCR := CR + CR;

   If MessageDlg('OnNestedTarFile Event (unit8.pas)' + CRCR +
      'File: ' + FileName + CR +
      'Compressed file is a tar archive.' + CRCR +
      'Decompress and verify this archive?',
      mtInformation, [mbYes, mbNo], 0) = mrYes Then
      DoUnTar := True;

End;
//-------------------------------------------------------------
(* OnFileExists event *)

Procedure TfrmTestArchive.ZipCheck1FileExists(Sender: TObject; FileName: String;
   Var NewFileName: String; Var OverwriteMode: TOverwriteMode);
Begin
   frmMain.UnZIP1FileExists(Sender, FileName, NewFileName, OverwriteMode);
End;
//-------------------------------------------------------------

Procedure TfrmTestArchive.edtFileSpecKeyPress(Sender: TObject; Var Key: Char);
Begin
   If (Key = #13) And (edtFileSpec.Text <> '') Then
   Begin
      btnOKClick(Sender);
      edtFileSpec.SetFocus();
      edtFileSpec.SelStart := 0;
      edtFileSpec.SelLength := Length(edtFileSpec.Text);
   End;
End;
//-------------------------------------------------------------
(* TUnGZip's OnChangeArchive Event *)

Procedure TfrmTestArchive.ZipCheck1ChangeArchive(Sender: TObject;
   ArchiveName: String; ArcType: TArcType);
Begin
   frmMain.UnGZIP1ChangeArchive(Sender, ArchiveName, ArcType);
   edtArchiveFile.Text := ArchiveName;
   ZipCheck1.ArchiveFile := ArchiveName;
End;
//-------------------------------------------------------------

Procedure TfrmTestArchive.ZipCheck1ElapsedTime(Sender: TObject;
   ElapsedTime: Single);
Begin
   frmMain.UnZIP1ElapsedTime(Sender, ElapsedTime);
End;
//-------------------------------------------------------------

End.