unit1.pas

ziptv为delphi控件

Unit Unit1;

Interface

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

Uses
   Windows,
   Messages,
   SysUtils,
   Classes,
   Graphics,
   Controls,
   Forms,
   Dialogs,
   StdCtrls,
   Buttons,
   ExtCtrls,
   ComCtrls,
   FileCtrl,
   Menus,
   ztvRegister,
   ztvBase,
   ztvGbls,
   ztvZipTV,
   ztvZip,
   ztvJar,
   ztvArc2Arc,
   Err_Msgs;

Type
   TForm1 = Class(TForm)
      Arc2Arc1: TArc2Arc;
      pnlStatus: TPanel;
      pbxLed: TPaintBox;
      imgLed: TImage;
      StatusBar1: TStatusBar;
      OpenDialog1: TOpenDialog;
      Panel1: TPanel;
      Panel2: TPanel;
      Panel3: TPanel;
      Label1: TLabel;
      Label2: TLabel;
      Label3: TLabel;
      Edit1: TEdit;
      Edit2: TEdit;
      MainMenu1: TMainMenu;
      BitBtn1: TBitBtn;
      btnSelectDir: TBitBtn;
      btnOK: TBitBtn;
      btnClose: TBitBtn;
      ListBox1: TListBox;
      CheckBox1: TCheckBox;
      ComboBox1: TComboBox;
      ProgressBar1: TProgressBar;
      ProgressBar2: TProgressBar;
      RadioGroup1: TRadioGroup;
      RadioGroup2: TRadioGroup;
      Bevel1: TBevel;
      File1: TMenuItem;
      Open1: TMenuItem;
      N1: TMenuItem;
      Exit1: TMenuItem;
      Procedure ApplicationBusy;
      Procedure ApplicationWaiting;
      Procedure btnSelectDirClick(Sender: TObject);
      Procedure BitBtn1Click(Sender: TObject);
      Procedure btnOKClick(Sender: TObject);
      Procedure EditChange(Sender: TObject);
      Procedure pbxLedPaint(Sender: TObject);
      Procedure pbxLedClick(Sender: TObject);
      Procedure SetLedColor(lColor: TColor);
      Procedure Arc2Arc1FileExists(Sender: TObject; FileName: String;
         Var OverwriteMode: TOverwriteMode);
      Procedure Arc2Arc1Error(Sender: TObject; FileName, MsgEx, VolumeID: String;
         ECode: Integer);
      Procedure Arc2Arc1GetPassword(Sender: TObject; FileName: String;
         Var Password: String; Var TryAgain: Boolean);
      Procedure Arc2Arc1CompressBegin(Sender: TObject; FileName: String;
         RecNum: Integer; Var Extract: Boolean);
      Procedure Arc2Arc1ExtractBegin(Sender: TObject; FileName: String;
         RecNum: Integer; Var Extract: Boolean);
      Procedure Arc2Arc1ExtractEnd(Sender: TObject; FileName: String;
         CRC_PASS: Boolean);
      Procedure Arc2Arc1CompressEnd(Sender: TObject; FileName: String;
         CRC_PASS: Boolean);
      Procedure Arc2Arc1NextVolume(Sender: TObject; Var VolumeName: String;
         VolumeID: Integer; FExists: Boolean; Var Cancel: Boolean);
      Procedure Arc2Arc1CompressActivate(Sender: TObject);
      Procedure Arc2Arc1CompressDeactivate(Sender: TObject);
      Procedure Arc2Arc1ExtractActivate(Sender: TObject);
      Procedure Arc2Arc1ExtractDeactivate(Sender: TObject);
      Procedure Arc2Arc1Progress(Sender: TObject; ProgressByFile,
      	ProgressByArchive: Byte);
      Procedure Arc2Arc1RemoveTempfile(Sender: TObject; FileName: String);
      Procedure Open1Click(Sender: TObject);
      Procedure Exit1Click(Sender: TObject);
      Procedure Arc2Arc1IntegrityBegin(Sender: TObject; FileName: String);
      Procedure Arc2Arc1IntegrityStatus(Sender: TObject; FileName: String; PassFail:
         Boolean);
      Procedure Arc2Arc1IntegrityActivate(Sender: TObject);
      Procedure Arc2Arc1IntegrityDeactivate(Sender: TObject);
      Procedure RadioGroup1Click(Sender: TObject);
      Procedure Arc2Arc1ElaspedTime(Sender: TObject; ElaspedTime: Real);
      Procedure FormCreate(Sender: TObject);
   Private
      { Private declarations }
   Public
      { Public declarations }
   End;

Var
   Form1: TForm1;

Implementation

{$R *.DFM}

Const
   FileExt: Array[0..6] Of String[7] =
      ('.BH'#0, '.CAB'#0, '.LHA'#0, '.ZIP'#0, '.TAR'#0, '.TAR.GZ', '.JAR'#0);

   //-------------------------------------------------------------
   (* OnError Event -
       See Err_Msgs.PAS & Err_Msgs.RC for error codes *)

Procedure TForm1.Arc2Arc1Error(Sender: TObject; FileName, MsgEx,
   VolumeID: String; ECode: Integer);
Begin
   ShowMessage(
      FileName + #13#13 +
      'Error#: ' + IntToStr(ECode) + #13 +
      'Error: ' + LoadStr(ECode) + #13#13 +
      'Extended: ' + MsgEx + #13#13 +
      'OnError event...');
End;
//-------------------------------------------------------------
(* OnGetPassword - Event *)

Procedure TForm1.Arc2Arc1GetPassword(Sender: TObject; FileName: String;
   Var Password: String; Var TryAgain: Boolean);
Begin
   (* InputQuery is a Delphi function *)
   If Not InputQuery('Encrypted file...', 'Enter password', Password) Then
      TryAgain := False;
End;
//-------------------------------------------------------------
(* OnCompressActivate - Event *)

Procedure TForm1.Arc2Arc1CompressActivate(Sender: TObject);
Begin
   If Arc2Arc1.OutArcMethod = amCreateNew Then
      ListBox1.Items.Add('New Archive --> ' + Arc2Arc1.NewArchive)
   Else
      ListBox1.Items.Add('Add to Archive --> ' + Arc2Arc1.NewArchive);
End;
//-------------------------------------------------------------
(* OnCompressBegin - Event *)

Procedure TForm1.Arc2Arc1CompressBegin(Sender: TObject; FileName: String;
   RecNum: Integer; Var Extract: Boolean);
Var
   LocalFileName: String;
Begin
   LocalFileName := MinimizeName('Compressing: ' + FileName, StatusBar1.Canvas,
      StatusBar1.Width);
   StatusBar1.SimpleText := LocalFileName;
   StatusBar1.Update();
   ListBox1.Items.Add('(' + IntToStr(RecNum) + ') Compressing: ' + FileName);
End;
//-------------------------------------------------------------
(* OnCompressEnd - Event *)

Procedure TForm1.Arc2Arc1CompressEnd(Sender: TObject; FileName: String;
   CRC_PASS: Boolean);
Begin
   StatusBar1.SimpleText := '';
   ProgressBar1.Update();
   ProgressBar2.Update();
End;
//-------------------------------------------------------------
(* OnCompressDeactivate - Event *)

Procedure TForm1.Arc2Arc1CompressDeactivate(Sender: TObject);
Begin
   ListBox1.Items.Add('--> FINISHED <--');
End;
//-------------------------------------------------------------
(* OnExtractActivate - Event *)

Procedure TForm1.Arc2Arc1ExtractActivate(Sender: TObject);
Begin
   ListBox1.Items.Add('TempDir --> ' + Arc2Arc1.TempDir);
   ListBox1.Items.Add('ArchiveFile --> ' + Arc2Arc1.ArchiveFile);
End;
//-------------------------------------------------------------
(* OnExtractBegin - Event *)

Procedure TForm1.Arc2Arc1ExtractBegin(Sender: TObject; FileName: String;
   RecNum: Integer; Var Extract: Boolean);
Var
   LocalFileName: String;
Begin
   LocalFileName := MinimizeName('Extracting: ' + FileName, StatusBar1.Canvas,
      StatusBar1.Width);

   StatusBar1.SimpleText := LocalFileName;
   StatusBar1.Update();

   ListBox1.Items.Add(
      '(' + IntToStr(RecNum + 1) + ') Extracting: ' + FileName
      );
End;
//-------------------------------------------------------------
(* OnExtractEnd - Event *)

Procedure TForm1.Arc2Arc1ExtractEnd(Sender: TObject; FileName: String;
   CRC_PASS: Boolean);
Begin
   (* reset visual values *)
   StatusBar1.SimpleText := '';
   ProgressBar1.Position := 0;
   ProgressBar1.Update();
   ProgressBar2.Position := 0;
   ProgressBar2.Update();

   If Not CRC_PASS Then
      ShowMessage(FileName + #13'Extract failed'#13#13'OnExtractEnd Event...');
End;
//-------------------------------------------------------------
(* OnExtractDeactivate - Event *)

Procedure TForm1.Arc2Arc1ExtractDeactivate(Sender: TObject);
Begin
   ListBox1.Items.Add('--> FINISHED <--');
End;
//-------------------------------------------------------------
(* OnProgress - Event *)

Procedure TForm1.Arc2Arc1Progress(Sender: TObject; ProgressByFile, ProgressByArchive:
   Byte);
Begin
   ProgressBar1.Position := Integer(ProgressByFile);
   ProgressBar2.Position := Integer(ProgressByArchive);
   ProgressBar1.Update();
   ProgressBar2.Update();
End;
//-------------------------------------------------------------
(* OnNextVolume - Event *)

Procedure TForm1.Arc2Arc1NextVolume(Sender: TObject; Var VolumeName: String;
   VolumeID: Integer; FExists: Boolean; Var Cancel: Boolean);
Var
   NewFile, Prompt, Caption: String;
Begin
   Cancel := False;                     (* Default value = true *)