unit1.pas

ziptv为delphi控件

(*
   This source demonstrates the usage, properties, methods, and events of the
   TMakeSFX component.

   The purpose of the TMakeSFX component is to convert normal archives into
   SFX (SelF eXtractable) file.  An SFX archive can decompress and extract
   its files without the aid of support applications.

   IMPORTANT:
   The value of TMakeSFX's "SfxStubDir property" must be the directory
   where the support stub files (ztv_*.sfx) are located.  These stub files
   are not distributed with the ZipTV Components, but are freely downloadable
   from the ZipTV website www.ziptv.com.

   *)
Unit Unit1;

Interface

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

Type
   TForm1 = Class(TForm)
      Label1: TLabel;
      Label2: TLabel;
      Label3: TLabel;
      Label4: TLabel;
      Label5: TLabel;
      Label6: TLabel;
      Label7: TLabel;
      Panel1: TPanel;
      Panel2: TPanel;
      Panel3: TPanel;
      Edit1: TEdit;
      Edit2: TEdit;
      Button1: TButton;
      Button2: TButton;
      Button3: TButton;
      BitBtn1: TBitBtn;
      ListBox1: TListBox;
      MakeSFX1: TMakeSFX;
      ZipCheck1: TZipCheck;
      Procedure Button1Click(Sender: TObject);
      Procedure Button2Click(Sender: TObject);
      Procedure Button3Click(Sender: TObject);
      Procedure BitBtn1Click(Sender: TObject);
      Procedure Edit1Exit(Sender: TObject);
      Procedure Edit2Exit(Sender: TObject);
      Procedure Edit2Enter(Sender: TObject);
      Procedure FormActivate(Sender: TObject);
      Procedure MakeSFX1FileExists(Sender: TObject; FileName: String;
         FileDate: TDateTime; Var OverwriteMode: TOverwriteMode);
      Procedure MakeSFX1Error(Sender: TObject; FileName, MsgEx, VolumeID: String;
         ECode: Integer);
      Procedure ZipCheck1CorruptZipHeader(Sender: TObject; HeadFlag:
         THeaderTypeState; Var Cancel: Boolean);
      Procedure ZipCheck1Status(Sender: TObject; FileName: String;
         PassFail: Boolean);
      Procedure ZipCheck1GetPassword(Sender: TObject; FileName: String;
         Var Password: String; Var TryAgain: Boolean);
   Private
      { Private declarations }
   Public
      { Public declarations }
   End;

Var
   Form1: TForm1;

Implementation

{$R *.DFM}

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

(* "ArchiveFile" field selection button *)

Procedure TForm1.BitBtn1Click(Sender: TObject);
Var
   OpenDialog1: TOpenDialog;
Begin

   (* Create & free an OpenDialog.  Just to keep focus on only *)
   (* one component icon dropped on the form.  No other real	*)
   (* purpose.                                                 *)
   OpenDialog1 := TOpenDialog.Create(Form1);
   Try
      OpenDialog1.Options := [ofHideReadOnly, ofFileMustExist, ofPathMustExist];
      OpenDialog1.Title := 'Select an existing archive...';

      (* F_TZIPTV comes from err_msgs.pas *)
      OpenDialog1.Filter := LoadStr(F_TZIPTV);

      If OpenDialog1.Execute Then
      Begin
         Edit1.Text := OpenDialog1.FileName;
         //Edit2.Text := ChangeFileExt( Edit1.Text, FileExt[ RadioGroup1.ItemIndex ] );
      End;
   Finally
      OpenDialog1.Free();
   End;
End;
//------------------------------------------------------------

(* "Convert" button
 Assign MakeSfx's properties and call its CreateSfx method.
*)

Procedure TForm1.Button1Click(Sender: TObject);
Begin
   MakeSFX1.ArchiveFile := Edit1.Text;

   {$ifdef debug_proj}
   MakeSFX1.SfxStubDir := 'd:\600\sfx\sfx640\english\';
   {$endif}

   MakeSFX1.TargetFile := Edit2.Text;
   Button3.Enabled := MakeSFX1.CreateSFX(); //create the SFX
End;
//------------------------------------------------------------

(* "Test SFX" button *)

Procedure TForm1.Button3Click(Sender: TObject);
Begin
   If (Button3.Caption = '&Test ''Target Exe''') Then
   Begin
      If FileExists(MakeSFX1.TargetFile) Then
      Begin
         Button1.Enabled := False;
         Button2.Enabled := False;
         Button3.Caption := '&Ok';
         Panel2.Visible := False;
         ListBox1.Enabled := True;

         ListBox1.Items.Clear();
         ZipCheck1.ArchiveFile := MakeSFX1.TargetFile;
         ZipCheck1.FileSpec.Clear();
         ZipCheck1.FileSpec.Add('*.*');
         ZipCheck1.Activate();
         Button3.SetFocus();
      End
      Else
         Button3.Enabled := False;
   End
   Else
   Begin
      Button1.Enabled := True;
      Button2.Enabled := True;
      Button3.Caption := '&Test ''Target Exe''';
      ListBox1.Enabled := False;
      Panel2.Visible := True;
   End;
End;
//------------------------------------------------------------

Procedure TForm1.FormActivate(Sender: TObject);
Begin
   Edit1.Text := MakeSFX1.ArchiveFile;
   If Edit1.Text <> '' Then
      Edit2.Text := MakeSFX1.TargetFile;
End;
//------------------------------------------------------------

(* ZipCheck1's OnGetPassword event.
 Default value for the TryAgain parameter = True
   *)

Procedure TForm1.ZipCheck1GetPassword(Sender: TObject; FileName: String;
   Var Password: String; Var TryAgain: Boolean);
Begin
   (* InputQuery is a Delphi function *)
   If Not InputQuery('Enter password...',
      LowerCase(ExtractFilename(FileName)),
      Password) Then

      TryAgain := False;
End;
//------------------------------------------------------------

(* ZipCheck1's OnCorruptZipHeader event *)

Procedure TForm1.ZipCheck1CorruptZipHeader(Sender: TObject; HeadFlag:
   THeaderTypeState; Var Cancel: Boolean);
Begin
   ListBox1.Items.Add('====================================');
   ListBox1.Items.Add('OnCorruptZipHeader Event (start)');
   ListBox1.Items.Add('====================================');

   If Not (htLocal In HeadFlag) Then    // defined in ztvGbls.pas
      ListBox1.Items.Add('*Local* header missing or corrupt...');

   If Not (htCentral In HeadFlag) Then  // defined in ztvGbls.pas
      ListBox1.Items.Add('*Central* header missing or corrupt...');

   If Not (htEnding In HeadFlag) Then   // defined in ztvGbls.pas
      ListBox1.Items.Add('*Ending* header missing or corrupt...');

   ListBox1.Items.Add('');
   ListBox1.Items.Add('"Cancel" parameter set to false, continuing...');
   ListBox1.Items.Add('====================================');
   ListBox1.Items.Add('OnCorruptZipHeader Event (end)');
   ListBox1.Items.Add('====================================');

   Cancel := False;
End;
//------------------------------------------------------------

(* ZipCheck1's OnStatus event *)

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

   ListBox1.Items.Add(s);
End;
//------------------------------------------------------------

(* MakeSFX1's OnFileExists event *)

Procedure TForm1.MakeSFX1FileExists(Sender: TObject; FileName: String;
   FileDate: TDateTime; Var OverwriteMode: TOverwriteMode);
Var
   Msg: String;
Begin
   Msg := FileName + ' already exists, overwrite?' + #13#13'OnFileExists Event...';
   If MessageDlg(Msg, mtInformation, [mbYes, mbNo], 0) = mrNo Then
      OverwriteMode := omSkip
   Else
      OverwriteMode := omOverwrite;
End;
//------------------------------------------------------------

(* MakeSFX1's OnError event *)

Procedure TForm1.MakeSFX1Error(Sender: TObject; FileName, MsgEx,
   VolumeID: String; ECode: Integer);
Begin
   ShowMessage('Filename: ' + FileName +
      #13'Error: ' + IntToStr(ECode) +
      #13 + MsgEx +
      #13 + LoadStr(ECode));
End;
//------------------------------------------------------------

Procedure TForm1.Edit1Exit(Sender: TObject);
Begin
   If Edit1.Text <> '' Then
      Edit2.Text := ChangeFileExt(Edit1.Text, '.exe')
   Else
      Edit2.Text := '';
End;
//------------------------------------------------------------

Procedure TForm1.Edit2Enter(Sender: TObject);
Begin
   Button3.Enabled := False;
   If Edit2.Text <> '' Then
   Begin
      Edit2.SelStart := 0;
      Edit2.SelLength := Length(ExtractFilePath(Edit2.Text));
   End;
End;
//------------------------------------------------------------

Procedure TForm1.Edit2Exit(Sender: TObject);
Begin
   If Edit2.Text <> '' Then
      Edit2.Text := ChangeFileExt(Edit2.Text, '.exe');
End;
//------------------------------------------------------------

(* "Cancel" button *)

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

End.