abziptyp.pas

Lazarus is a free and open source development tool for the FreePascal Compiler. The purpose of the p

    property DirectoryOffset : Longint
      read FDirectoryOffset write FDirectoryOffset;
    property StartDiskNumber : Word
      read FStartDiskNumber write FStartDiskNumber;
    property ZipfileCommentLength : Word
      read FZipfileCommentLength write FZipfileCommentLength;
    property ZipfileComment : PChar
      read FZipfileComment write FZipfileComment;
    property IsValid : Boolean
      read GetValid;
  end;

{ TAbZipItem interface ===================================================== }
  TAbZipItem = class( TAbArchiveItem )
  protected {private}
    FItemInfo : TAbZipDirectoryFileHeader;
    FDecoder : TObject;

  protected {methods}
    function GetCompressionMethod : TAbZipCompressionMethod;
    function GetCompressionRatio : Double;
    function GetDeflationOption : TAbZipDeflationOption;
    function GetDictionarySize : TAbZipDictionarySize;
    function GetDiskNumberStart : Word;
    function GetExtraField : string;
    function GetFileComment : string;
    function GetGeneralPurposeBitFlag : Word;
    function GetInternalFileAttributes : Word;
    function GetRelativeOffset : Longint;
    function GetShannonFanoTreeCount : Byte;
    function GetVersionMadeBy : Word;
    function GetVersionNeededToExtract : Word;
    procedure SaveCDHToStream( Stream : TStream );
    procedure SaveDDToStream( Stream : TStream );
    procedure SaveLFHToStream( Stream : TStream );
    procedure SetCompressionMethod( Value : TAbZipCompressionMethod );
    procedure SetDiskNumberStart( Value : Word );
    procedure SetFileComment( Value : string );
    procedure SetExtraField( Value : string );
    procedure SetGeneralPurposeBitFlag( Value : Word );
    procedure SetInternalFileAttributes( Value : Word );
    procedure SetRelativeOffset( Value : Longint );
    procedure SetVersionMadeBy( Value : Word );
    procedure SetVersionNeededToExtract( Value : Word );

  protected {redefined property methods}
    function  GetCompressedSize : Longint; override;
    function  GetCRC32 : Longint; override;
    function  GetExternalFileAttributes : Longint; override;
    function  GetFileName : string; override;
    function  GetIsEncrypted : Boolean; override;
    function  GetLastModFileDate : Word; override;
    function  GetLastModFileTime : Word; override;
    function  GetUncompressedSize : Longint; override;
    procedure SetCompressedSize( const Value : Longint ); override;
    procedure SetCRC32( const Value : Longint ); override;
    procedure SetExternalFileAttributes( Value : Longint ); override;
    procedure SetFileName( Value : string ); override;
    procedure SetLastModFileDate(const Value : Word ); override;
    procedure SetLastModFileTime(const Value : Word ); override;
    procedure SetUncompressedSize( const Value : Longint ); override;

  public {methods}
    constructor Create;
    destructor  Destroy; override;
    procedure LoadFromStream( Stream : TStream );

  public {properties}
    property CompressionMethod : TAbZipCompressionMethod
      read GetCompressionMethod
      write SetCompressionMethod;
    property CompressionRatio : Double
      read GetCompressionRatio;
    property DeflationOption : TAbZipDeflationOption
      read GetDeflationOption;
    property DictionarySize : TAbZipDictionarySize
      read GetDictionarySize;
    property DiskNumberStart : Word
      read GetDiskNumberStart
      write SetDiskNumberStart;
    property ExtraField : string
      read GetExtraField
      write SetExtraField;
    property FileComment : string
      read GetFileComment
      write SetFileComment;
    property InternalFileAttributes : Word
      read GetInternalFileAttributes
      write SetInternalFileAttributes;
    property GeneralPurposeBitFlag : Word
      read GetGeneralPurposeBitFlag
      write SetGeneralPurposeBitFlag;
    property RelativeOffset : Longint
      read GetRelativeOffset
      write SetRelativeOffset;
    property ShannonFanoTreeCount : Byte
      read GetShannonFanoTreeCount;
    property VersionMadeBy : Word
      read GetVersionMadeBy
      write SetVersionMadeBy;
    property VersionNeededToExtract : Word
      read GetVersionNeededToExtract
      write SetVersionNeededToExtract;
  end;

{ TAbZipArchive interface ================================================== }
  TAbZipArchive = class( TAbArchive )
  protected {private}
    FCompressionMethodToUse : TAbZipSupportedMethod;
    FCurrentDisk            : Word;
    FDeflationOption        : TAbZipDeflationOption;
    FDriveIsRemovable       : Boolean;
    FInfo                   : TAbZipDirectoryFileFooter;
    FIsExecutable           : Boolean;
    FPassword               : string;
    FPasswordRetries        : Byte;
    FStubSize               : Longint;
    FAutoGen                : Boolean;                               {!!.02}

    FExtractHelper          : TAbArchiveItemExtractEvent;
    FExtractToStreamHelper  : TAbArchiveItemExtractToStreamEvent;
    FTestHelper             : TAbArchiveItemTestEvent;
    FInsertHelper           : TAbArchiveItemInsertEvent;
    FInsertFromStreamHelper : TAbArchiveItemInsertFromStreamEvent;
    FOnNeedPassword         : TAbNeedPasswordEvent;
    FOnRequestLastDisk      : TAbRequestDiskEvent;
    FOnRequestNthDisk       : TAbRequestNthDiskEvent;
    FOnRequestBlankDisk     : TAbRequestDiskEvent;

  protected {methods}

    function CreateItem(const FileSpec : string): TAbArchiveItem; override;
    procedure DoExtractHelper(Index : Integer; NewName : string);
    procedure DoExtractToStreamHelper(Index : Integer; aStream : TStream);
    procedure DoTestHelper(Index : Integer);
    procedure DoInsertHelper(Index : Integer; OutStream : TStream);
    procedure DoInsertFromStreamHelper(Index : Integer; OutStream : TStream);
    procedure DoRequestNextImage(ImageNumber : Integer; var Stream : TStream;
      var Abort : Boolean );
    function FindCDTail : Longint;
    function GetItem( Index : Integer ) : TAbZipItem;                    
    function GetZipFileComment : string;
    procedure PutItem( Index : Integer; Value : TAbZipItem );
    procedure DoRequestLastDisk( var Abort : Boolean );
      virtual;
    procedure DoRequestNthDisk( DiskNumber : Byte; var Abort : Boolean );
      virtual;
    procedure DoRequestBlankDisk( var Abort : Boolean );
      virtual;
    procedure ExtractItemAt(Index : Integer; const NewName : string);
      override;
    procedure ExtractItemToStreamAt(Index : Integer; aStream : TStream);
      override;
    procedure TestItemAt(Index : Integer);
      override;
    function FixName( Value : string ) : string;
      override;
    procedure LoadArchive;
      override;
    procedure SaveArchive;
      override;
    procedure SetZipFileComment( Value : string );

  protected {properties}
    property IsExecutable : Boolean
      read FIsExecutable write FIsExecutable;

  public {protected}
    procedure DoRequestNthImage(ImageNumber : Integer; var Stream : TStream;
      var Abort : Boolean );
    procedure DoSpanningMediaRequest(Sender: TObject; ImageNumber: Integer;
      var ImageName: string; var Abort: Boolean); override;
    procedure DoRequestImage(Mode : TAbSpanMode; ImageNumber: Integer;   {!!.01}
      var ImageName: string; var Abort: Boolean);                        {!!.01}

  public {methods}
    constructor Create( FileName : string; Mode : Word );
      override;
    constructor CreateFromStream( aStream : TStream; ArchiveName : string );
    destructor Destroy;
      override;

  public {properties}
    property CompressionMethodToUse : TAbZipSupportedMethod
      read FCompressionMethodToUse
      write FCompressionMethodToUse;
    property CurrentDisk : Word
      read FCurrentDisk
      write FCurrentDisk;
    property DeflationOption : TAbZipDeflationOption
      read FDeflationOption
      write FDeflationOption;
    property DriveIsRemovable : Boolean
      read FDriveIsRemovable;
    property ExtractHelper : TAbArchiveItemExtractEvent
      read FExtractHelper
      write FExtractHelper;
    property ExtractToStreamHelper : TAbArchiveItemExtractToStreamEvent
      read FExtractToStreamHelper
      write FExtractToStreamHelper;
    property TestHelper : TAbArchiveItemTestEvent
      read FTestHelper
      write FTestHelper;
    property InsertHelper : TAbArchiveItemInsertEvent
      read FInsertHelper
      write FInsertHelper;
    property InsertFromStreamHelper : TAbArchiveItemInsertFromStreamEvent
      read FInsertFromStreamHelper
      write FInsertFromStreamHelper;
    property Password : string
      read FPassword
      write FPassword;
    property PasswordRetries : Byte
      read FPasswordRetries
      write FPasswordRetries
      default AbDefPasswordRetries;
    property StubSize : Longint
      read FStubSize;
    property ZipFileComment : string
      read GetZipFileComment
      write SetZipFileComment;

    property Items[Index : Integer] : TAbZipItem                      {!!.03}
      read GetItem                                                    {!!.03}
      write PutItem; default;                                         {!!.03}

{!!!}    procedure SaveArchive2;


  public {events}
    property OnNeedPassword : TAbNeedPasswordEvent
      read FOnNeedPassword write FOnNeedPassword;
    property OnRequestLastDisk : TAbRequestDiskEvent
      read FOnRequestLastDisk write FOnRequestLastDisk;
    property OnRequestNthDisk : TAbRequestNthDiskEvent
      read FOnRequestNthDisk write FOnRequestNthDisk;
    property OnRequestBlankDisk : TAbRequestDiskEvent
      read FOnRequestBlankDisk write FOnRequestBlankDisk;
  end;

{============================================================================}
procedure MakeSelfExtracting( StubStream, ZipStream,
  SelfExtractingStream : TStream );
    {-takes an executable stub, and a .zip format stream, and creates
     a SelfExtracting stream.  The stub should create a TAbZipArchive
     passing itself as the file, using a read-only open mode.  It should
     then perform operations as needed - like ExtractFiles( '*.*' ).
     This routine updates the RelativeOffset of each item in the archive}

function FindCentralDirectoryTail(aStream : TStream) : Longint;

function VerifyZip(Strm : TStream) : TAbArchiveType;

function VerifySelfExtracting(Strm : TStream) : TAbArchiveType;

implementation

uses
  {$IFDEF MSWINDOWS}
  Windows,
//  Dialogs,                                                           {!!.04}
  {$ENDIF}
  {$IFDEF LINUX}
  Libc,
  {$IFNDEF NoQt}
  {$IFDEF UsingCLX}
  QControls,
  QDialogs,
  {$ENDIF}
  {$ENDIF}
  {$ENDIF}
  AbConst,
  AbExcept,
  AbVMStrm,
  SysUtils;

function VerifyZip(Strm : TStream) : TAbArchiveType;
{ determine if stream appears to be in PkZip format }
var
  Footer       : TAbZipDirectoryFileFooter;
  Sig          : LongInt;                                                {!!.01}
  TailPosition : LongInt;
  StartPos     : LongInt;
begin
  StartPos := Strm.Position;
  Result := atUnknown;

  Strm.Position := 0;                                                {!!.02}
  Strm.Read(Sig, SizeOf(LongInt));                                   {!!.02}
  if (Sig = Ab_ZipSpannedSetSignature) or                            {!!.02}
     (Sig = Ab_ZipPossiblySpannedSignature) then                     {!!.02}
    Result := atSpannedZip                                           {!!.02}
  else begin                                                         {!!.02}

    { attempt to find Central Directory Tail }
    TailPosition := FindCentralDirectoryTail( Strm );
    if TailPosition <> -1 then begin
      { check Central Directory Signature }
      Footer := TAbZipDirectoryFileFooter.Create;
      try
        Footer.LoadFromStream(Strm);
        if Footer.FSignature = AB_ZipCentralDirectoryTailSignature then
          Result := atZip;
      finally
        Footer.Free;
      end;
    end
(* {!!.02}
  else begin  { may be a span }                                          {!!.01}
    Strm.Seek(0, soFromBeginning);                                       {!!.01}
    Strm.Read(Sig, SizeOf(LongInt));                                     {!!.01}
    if (Sig = Ab_ZipSpannedSetSignature)                                 {!!.01}
      or (Sig = Ab_ZipPossiblySpannedSignature)                          {!!.01}
    then                                                                 {!!.01}
      Result := atSpannedZip;                                            {!!.01}
*) {!!.02}
  end;                                                                   {!!.01}
  Strm.Position := StartPos;
end;

function VerifySelfExtracting(Strm : TStream) : TAbArchiveType;
{ determine if stream appears to be an executable with appended PkZip data }
var
  FileSignature : LongInt;
  StartPos      : LongInt;
  IsWinExe, IsLinuxExe : Boolean;                                        {!!.01}
begin
  StartPos := Strm.Position;
  { verify presence of executable stub }
  {check file type of stub stream}
  Strm.Position := 0;
  Strm.Read( FileSignature, sizeof( FileSignature ) );

  Result := atSelfExtZip;

{!!.01 -- re-written Executable Type Detection to allow use of non-native stubs }
  IsLinuxExe := False;
  IsWinExe := LongRec(FileSignature).Lo = Ab_WindowsExeSignature;        {!!.02}
  if not IsWinExe then begin
    IsLinuxExe := FileSignature = Ab_LinuxExeSigWord1; { check 1st sig }
    if IsLinuxExe then begin
      Strm.Read(FileSignature, SizeOf(FileSignature)); { check 2nd sig }
      IsLinuxExe := FileSignature = Ab_LinuxExeSigWord2;
    end;
  end;

  if not (IsWinExe or IsLinuxExe) then
    Result := atUnknown;

{!!.01 -- end re-written }
  { Check for central directory tail }
  if VerifyZip(Strm) <> atZip then
    Result := atUnknown;

  Strm.Position := StartPos;
end;

{============================================================================}
function FindCentralDirectoryTail(aStream : TStream) : Longint;
{ search end of aStream looking for ZIP Central Directory structure
  returns position in stream if found (otherwise returns -1),