unit1.pas

ZIP压缩算法 delphi组件 含代码

// ==========================================
// Note: For Delphi versions prior v6, search
// for, and unrem {$IFNDEF DEL6_OR_HIGHER}
// conditionals.
// ==========================================
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}                          // include for Delphi version definations

Var
   DecompressedStream: TDecompMemoryStream;

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

   (* 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
   // use the TZipTV component to retrieve the ArcType.  The ArcType property
   // is assigned to all components that have the ArchiveFile property.  When
   // the ArchiveFile property is assigned,  the ArcType property is assigned
   // internally.
   ztv := TZipTV.Create(Nil);
   Try
      // when the ArchiveFile property is assigned, the ArcType property is
        // assigned internally
      ztv.ArchiveFile := OpenDialog1.FileName;

      // now that we have the ArcType property, see if it is a supported
      // archive.
      Case ztv.ArcType Of
         atAce, atAceExe:
            Component := TUnACE.Create(Nil);

         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
         // not a supported archive... exit
         Component := Nil;
         Exit;
      End;
   Finally
      // destroy the created TZipTV component
      ztv.Destroy;
   End;
End;
//-------------------------------------------------------------

// Decompress archive to (only files matching FileSpec) to DecompressedStream.
// Be sure to destroy DecompressedStream to free memory.  In this demo this
// stream is destroyed in the Form1.Destroy event

Procedure TForm1.mnuOpen1Click(Sender: TObject);
Var
   DefaultFileSpec: String;
   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;

      // creates and assigns the decompressor component.
      CreateDecompressComponent(DecompressComponent);
      If DecompressComponent = Nil Then
         Exit;                          // not a supported archive

      DefaultFileSpec := '*.*';
      If Not InputQuery('Input FileSpec', 'File type(s) to extract...', DefaultFileSpec) Then
      Begin
         Memo1.Clear();
         Exit;
      End Else
         If DefaultFileSpec = '' Then
            Exit;


      Try

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

         (*** activate the decompression ***)
         DecompressComponent.ArchiveFile := OpenDialog1.FileName;

         DecompressComponent.FileSpec.Clear();
         DecompressComponent.FileSpec.Add(DefaultFileSpec);
         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.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 DEL6_OR_HIGHER}
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 DEL6_OR_HIGHER}

      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 DEL6_OR_HIGHER}

            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 DEL6_OR_HIGHER}
      End;

   End
   Else
      Memo1.Clear();

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

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

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

Procedure TForm1.FormDestroy(Sender: TObject);
Begin
   DecompressedStream.Destroy();
End;
//-------------------------------------------------------------

End.