unit1.pas

ZIP压缩算法 delphi组件 含代码

(*

   ZipTV components for data compression.
   Microchip Data Systems, Carl Bunton
   http://www.ziptv.com
   [e-mail]

  Demo application source for the TUnSFX component in the ZipTV compression
   component suite for Delphi.

   Converts several SFX archives types back to their original archive state
   prior to adding the executable stub.

  *)
Unit Unit1;

Interface

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

Type
   TForm1 = Class(TForm)
      UnSfx1: TUnSFX;
      ZipCheck1: TZipCheck;
      StatusBar1: TStatusBar;
      OpenDialog1: TOpenDialog;
      Panel1: TPanel;
      Panel2: TPanel;
      Label1: TLabel;
      Label2: TLabel;
      Label3: TLabel;
      Label4: TLabel;
      Edit1: TEdit;
      Edit2: TEdit;
      Edit3: TEdit;
      btnOpenArchive: TBitBtn;
      BitBtn1: TBitBtn;
      BitBtn2: TBitBtn;
      Button3: TButton;
      ListBox1: TListBox;
      Procedure btnOpenArchiveClick(Sender: TObject);
      Procedure BitBtn1Click(Sender: TObject);
      Procedure BitBtn2Click(Sender: TObject);
      Procedure Button3Click(Sender: TObject);
      Procedure Edit1Change(Sender: TObject);
      Procedure UnSfx1Error(Sender: TObject; FN, MsgEx, VolumeID: String; ECode: Integer);  (* Ok button *)
      Procedure UnSfx1FileExists(Sender: TObject; FN: String;
         FileDate: TDateTime; Var OverwriteMode: TOverwriteMode);
      Procedure ZipCheck1Status(Sender: TObject; FileName: String; PassFail: Boolean);
   Private
      { Private declarations }
   Public
      { Public declarations }
   End;

Var
   Form1: TForm1;

Implementation

{$R *.DFM}

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

(* Open button *)

Procedure TForm1.btnOpenArchiveClick(Sender: TObject);
Begin
   OpenDialog1.Options := [ofFileMustExist, ofPathMustExist, ofHideReadOnly];

   If OpenDialog1.Execute() Then
   Begin
      ListBox1.Clear();
      Edit1.Text := OpenDialog1.FileName;
   End;
End;
//-------------------------------------------------------------

(* Ok button *)

Procedure TForm1.BitBtn1Click(Sender: TObject);
Begin
   UnSfx1.ArchiveFile := Edit1.Text;
   UnSfx1.OutFilename := Edit2.Text;
   UnSfx1.Activate();

   If (UnSfx1.OverwriteMode = omOverwrite) Then
      If FileExists(Edit2.Text) Then
      Begin
         MessageDlg('Finished', mtInformation, [mbOK], 0);
         Button3.Enabled := True;
      End;
End;
//-------------------------------------------------------------

(* Test archive button *)

Procedure TForm1.Button3Click(Sender: TObject);
Begin
   If (Button3.Caption = '&Test Archive') Then
   Begin
      If FileExists(UnSfx1.OutFilename) Then
      Begin
         BitBtn1.Enabled := False;
         BitBtn2.Enabled := False;
         Button3.Caption := '&Ok';

         ListBox1.Enabled := True;
         ListBox1.Items.Clear();

         ZipCheck1.ArchiveFile := UnSfx1.OutFilename;

         // the ArcType property is assigned internally when ArchiveFile is
         // assigned a filename (above)
         //
         // Verify_ArcType is defined in ztvGbls.pas.  It's set members
         // define which archive types are supported by TZipCheck.
         If ZipCheck1.ArcType In Verify_ArcType Then
         Begin
            ZipCheck1.FileSpec.Clear();
            ZipCheck1.FileSpec.Add('*.*');
            ZipCheck1.Activate();       // activate the archive verification
         End
         Else
            ShowMessage('Selected is not supported by the TZipCheck component');

         Button3.SetFocus();
      End
      Else
         Button3.Enabled := False;
   End
   Else
   Begin
      BitBtn1.Enabled := True;
      BitBtn2.Enabled := True;
      Button3.Caption := '&Test Archive';
      ListBox1.Enabled := False;
   End;
End;
//-------------------------------------------------------------

(* TZipCheck.OnStatus property *)

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;
//------------------------------------------------------------

Procedure TForm1.Edit1Change(Sender: TObject);
Begin
   If FileExists(Edit1.Text) Then
   Begin
      UnSfx1.ArchiveFile := Edit1.Text;
      If UnSfx1.ArcType In UnSFX_ArcType Then
      Begin
         Edit1.Text := UnSfx1.ArchiveFile;
         Edit2.Text := AppendDirTail(Edit3.Text) + ExtractFilename(UnSfx1.OutFilename);
         BitBtn1.Enabled := True;       // convert
      End
      Else
         BitBtn1.Enabled := False;      // convert

   End
   Else
   Begin
      BitBtn1.Enabled := False;         // convert
      Button3.Enabled := False;         // test archive
   End;
End;
//------------------------------------------------------------

(* TUnSfx.OnFileExists event *)

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

(* Exit button *)

Procedure TForm1.BitBtn2Click(Sender: TObject);
Begin
   Exit;
End;
//-------------------------------------------------------------

(* TUnSfx.OnError event *)

Procedure TForm1.UnSfx1Error(Sender: TObject; FN, MsgEx, VolumeID: String;
   ECode: Integer);
Begin
   ShowMessage(LoadStr(ECode));
End;
//-------------------------------------------------------------

End.