main.pas

ziptv为delphi控件

(*

   This is a demonstration on how to build an archive utility
   using multiple compression / decompression components from the
   ZipTV component package for the Delphi development language.

   The amount of code contained in this demo is very little when
   realized that this demo actually preforms the same fuctionality
   as 16 separate applications!  It may take a little time to
   understand the concept of ZipTV's object hierarchy when using
   multiple compression / decompression components, but once
   understood it becomes rather simple.

   ************************************************************

   There are no restrictions placed on the use of the code contained
   herein.  We have not attempted to build a full archive utility in
   this demonstration, only to provide the basic shell to prime ideas.

   ************************************************************

   Click on light when RED, to cancel the current operation.
   Click on column headers to sort.

   ************************************************************

   ZipTV COMPONENTS OBJECT HIERARCHY

   The most important feature on which to focus when using multiple
   compression / decompression components in ZipTV is the packages
   object hierarchy.

   *The TZipTV component is the "visual" front end archive manager.
   TCompBase & TUnBASE (parent classes for the compression /
   decompression components) do the actual work.

   The object heirarchy of ZipTV components is as follows:

   TZipCommon - | - TZipTV
                | - TZipSearch
                | - TTurboSearch
                | - TZipCheck
                | - TUnSFX
                | - TArc2Arc
                | - TztvFindFile
                |
                | - TUnBase  - |  ( all decompression / decode components )
                |              |
                |              | - TZipKey
                |              | - TZipRun
                |              |
                |              | - TUnBh
                |              | - TUnZip
                |				    | - TUnArj
                |				    | - TUUDecode
                |				    | - ...etc.
                |
                |
                |- TCompBase - |  ( all compression / encode components )
                |              |
                |              | - TBlakHole
                |              | - TZip       - TArchiveSplitter - |
                |              |                                   |
                |              | - TLha
                |				    | - TMakeCab
                |				    | - TUUEncode
                |              | - ...etc.
                |
                | - ...etc

   To use all decompression components as a single component, assign
   the decompression components as type TUnBase as demonstrated in
   this program (with the use of the variable 'ExtractComponent').

   When assigning the ArchiveFile property a filename (in any component),
   the ArcType and LengthOfFile properties are automatically defined
   internally.  In the mnuExtract1Click procedure below, we demonstrate
   how to use the ArcType property to type cast the desired decompression
   component as type TUnBase.

   ************************************************************

   HOW THIS DEMO WORKS WITH MULTIPLE DECOMPRESSION COMPONENTS

   The first thing of course is to open an archive (or create a new one).

   The 'Open' menu's OnClick event assigns the ArchiveFile property of
   the ZipTV1 component a filename (Open1Click procedure).  Internally,
   when the ArchiveFile property is assigned, the ArcType property is
   automatically defined as the type of archive the file is (ie..atZip,
   atBh,atArj...etc).

   To extract files from the opened archive the 'Extract' menu's
   'OnClick event' calls to the 'Extract1Click' procedure.  In the
   Extract1Click procedure, we use the ArcType property to determine
   which decompression component to use.  (ie.. if ArcType = atZIP then
   we want to use the UnZip1 component that was dropped on the form).  By
   typecasting the component as type 'TUnBase' (parent object to all
   decompression components), we eliminate continuous repeatitive coding.

   Follow the variable 'ExtractComponent' (of type TUnBase) for an
   understanding of typecasting the decompression components.

   ************************************************************

   HOW THIS DEMO WORKS WITH MULTIPLE COMPRESSION COMPONENTS

   Compression support works the same as decompression described
   above.  The base class for all compression components is TCompBase.

   In this demo we use the variable 'CompressComponent' (of type TCompBase)
   to assign the proper compression component with the type of archive
   either in currently in use or the archive type we wish to create.

   When adding (or deleting) files to an already opened archive, we use
   the ZipTV's ArcType property to determine the desired compression
   component to assign to variable CompressComponent (of type TCompBase).

   When creating a new archive, form 'frmAddFiles' contains an option to
   select which archive type to create.  Clicking on one of these option
   buttons, we typecast 'CompressComponent' as the proper compression
   component to use.

   ************************************************************

   **TLISTVIEW / TZipVIEW:
   To use Delphi's TListView control, set the $define in the "defines.inc" file:
   {$define ListView}.  ZipTV's TZipView control (much much faster than
   TListview), remove this define.
*)
Unit Main;

Interface

{$I compiler.inc}                       // Delphi / C++ Builder version conditionals.
{$I defines.inc} // if your IDE stops here, append the dir where ZipTV was
// installed.  Select Tools:Options, go to "Library Path".

{$IFDEF DEL6_OR_HIGHER}
{$WARN UNIT_PLATFORM OFF}
{$ENDIF DEL6_OR_HIGHER}

Uses
   Windows,
   Messages,
   SysUtils,
   Classes,
   Graphics,
   Controls,
   Forms,
   Dialogs,
   Menus,
   ComCtrls,
   ExtCtrls,
   FileCtrl,
   StdCtrls,
   Registry,
   Buttons,
   (* Global units *)
   ztvRegister,
   ztvHeaders,
   ztvBase,
   ztvGbls,
   (* Utility units *)
   Err_Msgs,
   ztvZipCheck,
   ztvRegArchive,
   (* Visual archive manager / util units *)
   ztvZipView,
   ztvZipTV,
   ztvZipRun,
   (* Decompression components *)
   ztvUnBh,
   ztvUnArj,
   ztvUnArc,
   ztvUnZip,
   ztvUnZoo,
   ztvUnTar,
   ztvUnLha,
   ztvUnGZip,
   ztvUnCab,
   ztvUnRar,
   ztvUnAce2,
   ztvUnJar,
   (* Compression components *)
   ztvBlakHole,
   ztvZip,
   ztvGZip,
   ztvTar,
   ztvJar,
   ztvMakeCab,
   ztvLha,
   // if your compiler stops here: remove the following line
   ztvZipSplitter,
   (* Encoding / decoding components *)
   ztvUUDecode,
   ztvUUEncode
   {$IFDEF use_zlib}
   ,
   ztvUnZLib
   {$ENDIF}
   ;

Type
   TSetCancel = Procedure(SC: Boolean) Of Object;

   TfrmMain = Class(TForm)
      SaveDialog1: TSaveDialog;
      OpenDialog1: TOpenDialog;
      CheckBox1: TCheckBox;
      cbRecurseDirs: TCheckBox;
      ListView1: TListView;
      MainMenu1: TMainMenu;
      mnuAddFiles1: TMenuItem;
      mnuAction1: TMenuItem;
      mnuDisplayElapsedTime1: TMenuItem;
      mnuBlankDirs1: TMenuItem;
      mnuClose1: TMenuItem;
      mnuDelete1: TMenuItem;
      mnuDelete2: TMenuItem;
      mnuExit1: TMenuItem;
      Extract1: TMenuItem;
      mnuExtract1: TMenuItem;
      mnuFile1: TMenuItem;
      mnuNew1: TMenuItem;
      mnuN1: TMenuItem;
      mnuOpen1: TMenuItem;
      mnuRefresh1: TMenuItem;
      mnuSaveAs1: TMenuItem;
      mnuSort1: TMenuItem;
      mnuUUEncode1: TMenuItem;
      mnuViewRun1: TMenuItem;
      mnuView1: TMenuItem;
      mnuErrorMessages1: TMenuItem;
      mnuAddFiles2: TMenuItem;
      Refresh1: TMenuItem;
      mnuEditComment2: TMenuItem;
      mnuEditComment1: TMenuItem;
      mnuTestArchive1: TMenuItem;
      mnuTestArchive2: TMenuItem;
      mnuRenameArchive1: TMenuItem;
      N1: TMenuItem;
      N2: TMenuItem;
      N3: TMenuItem;
      PopupMenu1: TPopupMenu;
      Edit1: TEdit;
      ComboBox1: TComboBox;
      Panel1: TPanel;
      pnlStatus: TPanel;
      pbxLed: TPaintBox;
      imgLed: TImage;
      StatusBar1: TStatusBar;
      ProgressBar1: TProgressBar;
      ProgressBar2: TProgressBar;

      (* utility components *)
      ZipTV1: TZipTV;
      ZipView1: TZipView;
      ZipRun1: TZipRun;

      (* Encode/Decode components *)
      UUDecode1: TUUDecode;
      UUEncode1: TUUEncode;

      (* Compression components *)
      BlakHole1: TBlakHole;
      Lha1: TLha;
      GZip1: TGZip;
      MakeCab1: TMakeCab;
      Jar1: TJar;
      Tar1: TTar;
      Zip1: TZip;

      // if your compiler stops here: remove the following line
      ZipSplitter1: TZipSplitter;

      (* Decompression components *)
      UnACE1: TUnACE;
      UnARC1: TUnARC;
      UnARJ1: TUnARJ;
      UnBH1: TUnBH;
      UnCab1: TUnCAB;
      UnGZip1: TUnGZIP;
      UnJAR1: TUnJAR;
      UnLHA1: TUnLHA;
      UnTAR1: TUnTAR;
      UnRAR1: TUnRAR;
      UnZip1: TUnZip;
      UnZOO1: TUnZOO;

      RegArchive1: TRegArchive;
      BitBtn1: TBitBtn;
      BitBtn2: TBitBtn;
      BitBtn3: TBitBtn;
      BitBtn4: TBitBtn;
      BitBtn5: TBitBtn;
      BitBtn6: TBitBtn;

      (* Components under development *)
      {$IFDEF DEVELOPMENT}
      //UnMsGZ1			: TUnMsGZ;
      {$ENDIF DEVELOPMENT}

      Function DefineCompressComponent: Boolean;
      Function RefreshList(FileName: String): Boolean;

      Procedure ApplicationBusy;
      Procedure ApplicationWaiting;
      Procedure DisplayFile(FileName: String);
      Procedure DisplayTotals(Which: Byte);
      Procedure EnableMenus;
      Procedure FormCreate(Sender: TObject);
      Procedure FormDestroy(Sender: TObject);
      Procedure mnuAddFiles1Click(Sender: TObject);
      Procedure mnuBlankDirs1Click(Sender: TObject);
      Procedure mnuClose1Click(Sender: TObject);
      Procedure mnuCompressStrDemoClick(Sender: TObject);
      Procedure mnuDelete1Click(Sender: TObject);
      Procedure mnuDisplayElapsedTime1Click(Sender: TObject);
      Procedure mnuEditComment1Click(Sender: TObject);
      Procedure mnuErrorMessages1Click(Sender: TObject);
      Procedure mnuExit1Click(Sender: TObject);
      Procedure mnuExtract1Click(Sender: TObject);
      Procedure mnuNew1Click(Sender: TObject);
      Procedure mnuOpen1Click(Sender: TObject);
      Procedure mnuRefresh1Click(Sender: TObject);
      Procedure mnuRenameArchive1Click(Sender: TObject);
      Procedure mnuSaveAs1Click(Sender: TObject);
      Procedure mnuSort1Click(Sender: TObject);
      Procedure mnuTestArchive1Click(Sender: TObject);
      Procedure mnuUUEncode1Click(Sender: TObject);
      Procedure pbxLedPaint(Sender: TObject);
      Procedure pbxLedClick(Sender: TObject);
      Procedure SetLedColor(lColor: TColor);
      Procedure StatusBar1Click(Sender: TObject);
      Procedure ListView1Click(Sender: TObject);
      Procedure ListView1Compare(Sender: TObject; Item1, Item2: TListItem;
         Data: Integer; Var Compare: Integer);
      Procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn);
      Procedure UnGZIP1NestedTarFile(Sender: TObject; FileName: String;
         Var DoUnTar: Boolean);
      Procedure UnGZIP1ChangeArchive(Sender: TObject; ArchiveName: String;
         ArcType: TArcType);
      Procedure MakeCab1GetNextCabinet(Sender: TObject;
         Var CabParameters: TCCAB; Var NewCabFileName: String;
         PreviousCabEstimatedSize: Integer; Var AbortCreation: Boolean);
      Procedure UnZIP1Activate(Sender: TObject);
      Procedure UnZIP1Begin(Sender: TObject; FName: String; Count: Integer;
         Var Extract: Boolean);
      Procedure UnZIP1ElapsedTime(Sender: TObject; ElapsedTime: Single);
      Procedure UnZIP1End(Sender: TObject; FileName: String; CRC_PASS: Boolean);
      Procedure UnZIP1FileExists(Sender: TObject; FileName: String;
         Var NewFileName: String; Var OverwriteMode: TOverwriteMode);
      Procedure UnZIP1GetPassword(Sender: TObject; FileName: String;
         Var Password: String; Var TryAgain: Boolean);