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,
   ComCtrls,
   ExtCtrls,
   ShellAPI,
   StdCtrls,
   iniFiles,
   Menus,
   Buttons,
   ImgList,
   FileCtrl,
   Clipbrd,
   Printers,

   ztvBase,
   ztvGbls,
   ztvConsts, {TCompressionMethod}
   ztvBlakHole,
   ztvMakeCab,
   ztvGZip,
   ztvJar,
   ztvLha,
   ztvTar,
   ztvZip,
   ztvRegister,
   ztvZipTV,
   ztvZipView,
   ztvZipCheck;

Type
   // ZipTV's CompBase event handlers
   TCompBase_EventHandlers = Class(TObject)
      Procedure ArcOnCompressBegin(Sender: TObject; FName: String; Count: Integer; Var
         Extract: Boolean);
      Procedure ArcOnCompressEnd(Sender: TObject; FName: String; CRC_PASS: Boolean);
      Procedure ArcOnCompressFileExists(Sender: TObject; FileName: String;
         FileDate: TDateTime; Var OverwriteMode: TOverwriteMode);
      Procedure ArcOnError(Sender: TObject; FileName, ExtendedMsg,
         VolumeID: String; ECode: Integer);
      Procedure ArcOnGetPassword(Sender: TObject; FName: String;
         Var Password: String; Var TryAgain: Boolean);
      Procedure ArcOnProgress(Sender: TObject; ProgressByFile,
         ProgressByArchive: Byte);
      Procedure ArcOnRenameDupeFile(Sender: TObject; OldFilename: String;
         Var NewFileName: String; Var Rename: Boolean);
      Procedure ArcOnReplaceFile(Sender: TObject; FileName, NewFileName:
         AnsiString; Date, NewDate: TDateTime; FileSize, NewFileSize:
         Int64; Attr, NewAttr: Integer; Var Replace: Boolean);
      Procedure ArcOnRecurseDir(Sender: TObject; Directory: String);
      Procedure ArcOnScanStatus(Sender: TObject; FileName: AnsiString; FilesCount:
         Longint; FilesSize: Int64);
   End;

   TForm1 = Class(TForm)
      Edit1: TEdit;
      Edit2: TEdit;
      Label1: TLabel;
      Label2: TLabel;
      Label3: TLabel;
      Label4: TLabel;
      Label5: TLabel;
      Label6: TLabel;
      Label7: TLabel;
      Label8: TLabel;
      Label9: TLabel;
      Panel1: TPanel;
      Panel2: TPanel;
      Panel3: TPanel;
      pnlStatus: TPanel;
      pbxLed: TPaintBox;
      imgLed: TImage;
      BitBtn1: TBitBtn;
      ZipTV1: TZipTV;
      ZipView1: TZipView;
      ZipCheck1: TZipCheck;
      MainMenu1: TMainMenu;
      File1: TMenuItem;
      Exit1: TMenuItem;
      TestArchive1: TMenuItem;
      N1: TMenuItem;
      CheckBox1: TCheckBox;
      ComboBox1: TComboBox;
      ComboBox2: TComboBox;
      ComboBox3: TComboBox;
      ComboBox4: TComboBox;
      StatusBar1: TStatusBar;
      OpenDialog1: TOpenDialog;
      ProgressBar1: TProgressBar;
      ProgressBar2: TProgressBar;
      Procedure FormActivate(Sender: TObject);
      Procedure FormCreate(Sender: TObject);
      Procedure pbxLedClick(Sender: TObject);
      Procedure pbxLedPaint(Sender: TObject);
      Procedure SetLedColor(lColor: TColor);
      Function SetComboBox2(ArcType: TArcType): Boolean;
      Procedure ZipTV1Error(Sender: TObject; FileName, ExtendedMsg,
         VolumeID: String; ECode: Integer);
      Procedure ZipTV1Read(Sender: TObject; Offset, Filenum: Integer);
      Procedure ZipTV1Totals(Sender: TObject; UnpackSize, PackSize: Int64;
         Ratio, NumFiles: Integer);
      Procedure ZipView1DroppedFiles(Sender: TObject; FileList: TStringList);
      Procedure ZipView1DroppedFilesEnd(Sender: TObject);
      Procedure ZipView1DroppedFilesStart(Sender: TObject; Var FileSpec: String);
      Procedure Exit1Click(Sender: TObject);
      Procedure BitBtn1Click(Sender: TObject);
      Procedure TestArchive1Click(Sender: TObject);
   Private
   Public
   End;

Var
   Form1: TForm1;
   fCompBase: TCompBASE;

Implementation

{$R *.DFM}

Uses
   Unit2;

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

Function TForm1.SetComboBox2(ArcType: TArcType): Boolean;
Begin
   Result := True;
   // Change the Archive Type combo-box
   Case ArcType Of
      atBh: ComboBox2.ItemIndex := 0;
      atCab: ComboBox2.ItemIndex := 1;
      atGZip: ComboBox2.ItemIndex := 2;
      atJar: ComboBox2.ItemIndex := 3;
      atLha: ComboBox2.ItemIndex := 4;
      atTar: ComboBox2.ItemIndex := 5;
      atZip: ComboBox2.ItemIndex := 6;
   Else
      Begin
         ComboBox2.ItemIndex := -1;
         Result := False;
      End;
   End;
End;
//-------------------------------------------------------------

Procedure TForm1.FormCreate(Sender: TObject);
Begin
   ZipTV1.ShowEmptyDirs := True;

   // fill the ZipView1 control with archive contents
   If Length(Edit1.Text) > 0 Then
      With ZipTV1 Do
      Begin
         ZipView1.Items.BeginUpdate();

         ArchiveFile := Edit1.Text;
         FileSpec.Clear();
         FileSpec.Add('*.*');

         If IsArcValid(ArcType) And SetComboBox2(ArcType) Then
            Activate();                 // fill the listbox

         ZipView1.Items.EndUpdate();
      End;
End;
//-------------------------------------------------------------

Procedure TForm1.Exit1Click(Sender: TObject);
Begin
   Close();
End;
//-------------------------------------------------------------

Procedure TCompBase_EventHandlers.ArcOnCompressBegin(Sender: TObject; FName: String;
   Count:
   Integer; Var Extract: Boolean);
Var
   FileName: String;
Begin
   FileName := MinimizeName('Processing: ' + FName, Form1.StatusBar1.Canvas,
      Form1.StatusBar1.Width);
   With Form1 Do
   Begin
      StatusBar1.SimpleText := FileName;
      StatusBar1.Update();
   End;
End;
//-------------------------------------------------------------
// Intercepted compressor component's event

Procedure TCompBase_EventHandlers.ArcOnCompressEnd(Sender: TObject; FName: String;
   CRC_PASS: Boolean);
Begin
   With Form1 Do
   Begin
      StatusBar1.SimpleText := '';
      ProgressBar1.Update();
      ProgressBar2.Update();
   End;
End;
//-------------------------------------------------------------
// Intercepted compressor component's event

Procedure TCompBase_EventHandlers.ArcOnCompressFileExists(Sender: TObject; FileName:
   String;
   FileDate: TDateTime; Var OverwriteMode: TOverwriteMode);
Var
   Msg: String;
Begin
   Msg := 'Filename: ' + FileName + #13#13 + 'File already exists, overwrite?';

   If MessageDlg(Msg, mtInformation, [mbYes, mbNo], 0) = mrNo Then
      OverwriteMode := omSkip
   Else
      OverwriteMode := omOverwrite;

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

Procedure TCompBase_EventHandlers.ArcOnError(Sender: TObject; FileName, ExtendedMsg,
   VolumeID: String; ECode: Integer);
Begin
   // forward the error data to the ZipTV1 control's OnError event
   Form1.ZipTV1.OnError(Self, FileName, ExtendedMsg, VolumeID, ECode);
End;
//-------------------------------------------------------------
// Intercepted compressor component's event

Procedure TCompBase_EventHandlers.ArcOnGetPassword(Sender: TObject; FName: String;
   Var Password: String; Var TryAgain: Boolean);
Begin
End;
//-------------------------------------------------------------
// Intercepted compressor component's event

Procedure TCompBase_EventHandlers.ArcOnProgress(Sender: TObject; ProgressByFile,
   ProgressByArchive: Byte);
Begin
   With Form1 Do
   Begin
      ProgressBar1.Position := Integer(ProgressByFile);
      ProgressBar2.Position := Integer(ProgressByArchive);
      ProgressBar1.Update;
      ProgressBar2.Update;
   End;
End;
//-------------------------------------------------------------
// Intercepted compressor component's event

Procedure TCompBase_EventHandlers.ArcOnRenameDupeFile(Sender: TObject;
   OldFilename: String; Var NewFileName: String; Var Rename: Boolean);
Begin
   Rename := False;
End;
//-------------------------------------------------------------
// Intercepted compressor component's event

Procedure TCompBase_EventHandlers.ArcOnReplaceFile(Sender: TObject; FileName,
   NewFileName: AnsiString; Date, NewDate: TDateTime; FileSize, NewFileSize:
   Int64; Attr, NewAttr: Integer; Var Replace: Boolean);
Begin
   Replace := False;
End;
//-------------------------------------------------------------
// Intercepted compressor component's event

Procedure TCompBase_EventHandlers.ArcOnRecurseDir(Sender: TObject; Directory: String);
Begin
   With Form1 Do
      StatusBar1.SimpleText := 'Scanning dir: ' +
         MinimizeName(Directory, StatusBar1.Canvas, StatusBar1.Width);
End;
//-------------------------------------------------------------

Procedure TCompBase_EventHandlers.ArcOnScanStatus(Sender: TObject; FileName:
   AnsiString; FilesCount: Longint; FilesSize: Int64);
Begin
   With Form1 Do
   Begin
      StatusBar1.SimpleText := IntToStr(FilesCount) + ' ' + FileName;
      StatusBar1.Update();
   End;
End;
//-------------------------------------------------------------
// TZipTV: OnError event

Procedure TForm1.ZipTV1Error(Sender: TObject; FileName, ExtendedMsg,
   VolumeID: String; ECode: Integer);
Begin
   ShowMessage(FileName + #13#13 +
      'Error#: ' + IntToStr(ECode) + #13 +
      'Error: ' + LoadStr(ECode) + #13#13 +
      'Extended: ' + ExtendedMsg + #13#13 +
      'OnError event...');
End;
//-------------------------------------------------------------
// TZipTV: OnRead event

Procedure TForm1.ZipTV1Read(Sender: TObject; Offset, Filenum: Integer);
Var
   ZipCommon: TZipCommon;
   BuildString: AnsiString;             (* Long String *)
Begin

   (* ZipCommon is the parent class to all ZipTV components.			*)
   (* Typecast the 'Sender' parameter as type TZipCommon to share		*)
   (* properties with all components.											*)
   ZipCommon := TZipCommon(Sender);