unit1.pas

DELPHI的压缩控件,非常实用的第三方控件

Unit unit1;

Interface

Uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls, ExtCtrls, ComCtrls, Menus, ztvBase, ztvGbls, ztvStreams, ztvZipTV,
   ztvUnZIP, ztvUnBh, ztvUnArc, ztvUnArj, ztvUnCab, ztvUnGZip, ztvUnLha,
   ztvUnTar, ztvUnZoo, ztvUUDecode, ztvUnAce2, ztvUnRar, Err_Msgs;

Type
   TForm1 = Class( TForm )
      Image1: TImage;
      MainMenu1: TMainMenu;
      mnuFile1: TMenuItem;
      mnuOpen1: TMenuItem;
      mnuN1: TMenuItem;
      mnuExit1: TMenuItem;
      OpenDialog1: TOpenDialog;
      Panel1: TPanel;
      Label4: TLabel;
      Label3: TLabel;
      Label1: TLabel;
      Label2: TLabel;
      Label5: TLabel;
      Label6: TLabel;
      Memo1: TMemo;
    	UpDown1: TUpDown;
      Procedure FormCreate( Sender: TObject );
      Procedure FormDestroy( Sender: TObject );
      Procedure mnuOpen1Click( Sender: TObject );
      Procedure mnuExit1Click( Sender: TObject );
      Procedure CreateDecompressComponent( Var Component: TUnBase );
    	Procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
   Private
      { Private declarations }
   Public
      { Public declarations }
   End;

Var
   Form1: TForm1;

Implementation

{$R *.DFM}
{$i ZipTV.inc}

Var
   DecompressedStream: TDecompMemoryStream;

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

Procedure TForm1.FormCreate( Sender: TObject );
Begin
   DecompressedStream := TDecompMemoryStream.Create();
   UpDown1.Max := 0;
End;
//-------------------------------------------------------------

Procedure TForm1.FormDestroy( Sender: TObject );
Begin
   DecompressedStream.Destroy();
End;
//-------------------------------------------------------------
(* Use the TZipTV component to determine the ArcType and create the	*)
(* decompression component accordingly to the ztv.ArcType property. *)

Procedure TForm1.CreateDecompressComponent( Var Component: TUnBase );
Var
   ztv: TZipTV;
Begin
   ztv := TZipTV.Create( Nil );
   Try
      ztv.ArchiveFile := OpenDialog1.FileName;
      Case ztv.ArcType Of
         atArc, atArcExe:
         	Component := TUnARC.Create( Nil );

         atArj, atArjExe:
         	Component := TUnARJ.Create( Nil );

         atBh, atBhExe:
         	Component := TUnBH.Create( Nil );

         atCab:
         	Component := TUnCAB.Create( Nil );

         atGZip:
         	Component := TUnGZIP.Create( Nil );

         atLha, atLhaExe, atLzh, atLzhExe:
         	Component := TUnLHA.Create( Nil );

         atRar:
         	Component := TUnRAR.Create( Nil );

         atTar:
         	Component := TUnTAR.Create( Nil );

         atUUE:
         	Component := TUUDecode.Create( Nil );

         atZip, atZipExe:
            Begin
               Component := TUnZIP.Create( Nil );
               Component.ZipCmntBufSize := 32000;
            End;

         atZoo:
         	Component := TUnZOO.Create( Nil );
      Else
         Component := Nil;
         Exit;
      End;
   Finally
      ztv.Destroy;
   End;
End;
//-------------------------------------------------------------

// Decompress archive to (only files matching FileSpec) to DecompressedStream.
// Be sure to free destroy DecompressedStream to free memory.  In this demo
// we do this in Form1.Destory.
Procedure TForm1.mnuOpen1Click( Sender: TObject );
Var
   DecompressComponent: TUnBase;
Begin
   OpenDialog1.Title := 'Open Archive...';
   OpenDialog1.Filter := LoadStr( F_TZIPTV ); //F_TZIPTV in err_msgs.pas & err_msgs.rc
   OpenDialog1.Options := [ofHideReadOnly, ofFileMustExist, ofPathMustExist];
   If OpenDialog1.Execute Then
   Begin
      Caption := OpenDialog1.FileName;

      DecompressComponent := Nil;
      CreateDecompressComponent( DecompressComponent );
      If DecompressComponent = Nil Then Exit;

      Try

         (* clear DecompressedStream, releasing all allocated memory *)
         (* from previously displayed archives.								*)
         DecompressedStream.ClearMemory();

         (*** activate the decompression ***)
         DecompressComponent.ArchiveFile := OpenDialog1.FileName;
         DecompressComponent.FileSpec.Add( '*.*' );
         DecompressComponent.ExtractToMemoryStream( DecompressedStream );
      Finally
         DecompressComponent.Free();
      End;

      (* set the UpDown control's Min, Max, and Position properties *)
      UpDown1.Min := 0;
      UpDown1.Max := DecompressedStream.FileCount - 1;
      UpDown1.Position := 0;
      UpDown1.Enabled := True;
		UpDown1Click( Self, btNext );

      Label6.Caption := IntToStr( DecompressedStream.FileCount );
   End;
End;
//-------------------------------------------------------------

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

Procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
Var
   Signattr: Integer;                   //opened file's 2 to 4 char signattr
   FileSize: Integer;                   //size of file in decompressed stream
   StreamPos: Integer;                  //Position of begining of file in decompressed stream
{$ifndef DEL6_OR_HIGHER}
	DelphiCompatibleStrm,
   	MemoryStream: TMemoryStream;      //stream used to copy specific files from the
{$else}
   	MemoryStream: TMemoryStream32;    //stream used to copy specific files from the
{$endif}
Const
   (* File signatures *)
   IconSignature = 65536;
   MetaSignature = -1698247209;
   BitmapSignature = 19778;
Begin
   (* display its index *)
   Label2.Caption := IntToStr( UpDown1.Position + 1 );

   (* Retrieve the specific file's filename *)
   Label4.Caption := DecompressedStream.FileName[UpDown1.Position];

   (* Get the specific file's size from DecompressedStream *)
   FileSize := DecompressedStream.FileSize[UpDown1.Position];
   If FileSize > 32000 Then FileSize := 32000;

   (* Get the offset of the desired file from Decompressed Stream *)
   StreamPos := DecompressedStream.FileOffset[UpDown1.Position];

   (* Get the compressed file's first four bytes to check its signature *)
   DecompressedStream.Position := StreamPos;
   DecompressedStream.Read( Signattr, SizeOf( Signattr ) );

   (* reset the position to beginning of Signattr *)
   DecompressedStream.Position := StreamPos;
   If FileSize > 0 Then
   Begin


{$ifndef DEL6_OR_HIGHER}
   	DelphiCompatibleStrm := Nil;
      MemoryStream := TMemoryStream.Create();
{$else}
      MemoryStream := TMemoryStream32.Create();
{$endif}

      Try
         Try

            (* Copy the specific file from the DecompressedStream to MemoryStream *)

{$ifndef DEL6_OR_HIGHER}
            // Delphi version prior to version 6 must copy the TZipTV stream
            // (DecompressStream) into a Delphi compatible TMemoryStream
            // (DelphiCompatibleStrm).  There are no compatible problems in
            // Delphi version 6+
            DelphiCompatibleStrm := TMemoryStream.Create();

            ZTVStreamToTStream(DecompressedStream, DelphiCompatibleStrm, FileSize);

            DelphiCompatibleStrm.Position := 0;
            If MemoryStream.CopyFrom(DelphiCompatibleStrm, FileSize) = FileSize Then
{$else}
            If MemoryStream.CopyFrom(DecompressedStream, FileSize) = FileSize Then
{$endif}
            Begin
               MemoryStream.Position := 0;

               (* if the specified file is an icon... *)
               If Signattr = IconSignature Then
                  Image1.Picture.Icon.LoadFromStream( MemoryStream )

                  (* if the specified file is a MetaFile... *)
               Else If Signattr = MetaSignature Then
                  Image1.Picture.Metafile.LoadFromStream( MemoryStream )

                  (* if the specified file is a BitMap... *)
               Else If LoWord( Signattr ) = BitmapSignature Then
                  Image1.Picture.BitMap.LoadFromStream( MemoryStream )

                  (* if the specified file is a text or any other type of file... *)
               Else
                  Memo1.Lines.LoadFromStream( MemoryStream );

            End;
         Except
            Memo1.Clear();
         End;
      Finally
         MemoryStream.Free();
{$ifndef DEL6_OR_HIGHER}
         If DelphiCompatibleStrm <> Nil Then
      		DelphiCompatibleStrm.Free();
{$endif}
      End;

   End
   Else
      Memo1.Clear();

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

End.