2345 lines
84 KiB
ObjectPascal
2345 lines
84 KiB
ObjectPascal
(* ***** BEGIN LICENSE BLOCK *****
|
|
* Version: MPL 1.1
|
|
*
|
|
* The contents of this file are subject to the Mozilla Public License Version
|
|
* 1.1 (the "License"); you may not use this file except in compliance with
|
|
* the License. You may obtain a copy of the License at
|
|
* http://www.mozilla.org/MPL/
|
|
*
|
|
* Software distributed under the License is distributed on an "AS IS" basis,
|
|
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
|
* for the specific language governing rights and limitations under the
|
|
* License.
|
|
*
|
|
* The Original Code is TurboPower Abbrevia
|
|
*
|
|
* The Initial Developer of the Original Code is
|
|
* TurboPower Software
|
|
*
|
|
* Portions created by the Initial Developer are Copyright (C) 1997-2002
|
|
* the Initial Developer. All Rights Reserved.
|
|
*
|
|
* Contributor(s):
|
|
* Craig Peterson <capeterson@users.sourceforge.net>
|
|
*
|
|
* ***** END LICENSE BLOCK ***** *)
|
|
|
|
{*********************************************************}
|
|
{* ABBREVIA: AbZipTyp.pas *}
|
|
{*********************************************************}
|
|
{* ABBREVIA: PKZip types *}
|
|
{* Based on information from Appnote.txt, shipped with *}
|
|
{* PKWare's PKZip for Windows 2.5 *}
|
|
{*********************************************************}
|
|
|
|
unit AbZipTyp;
|
|
|
|
{$I AbDefine.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, AbArcTyp, AbUtils, AbSpanSt;
|
|
|
|
const
|
|
{ note #$50 = 'P', #$4B = 'K'}
|
|
Ab_ZipVersion = 63;
|
|
Ab_ZipLocalFileHeaderSignature : Longint = $04034B50;
|
|
Ab_ZipDataDescriptorSignature : Longint = $08074B50;
|
|
Ab_ZipCentralDirectoryFileHeaderSignature : Longint = $02014B50;
|
|
Ab_Zip64EndCentralDirectorySignature : Longint = $06064B50;
|
|
Ab_Zip64EndCentralDirectoryLocatorSignature:Longint = $07064B50;
|
|
Ab_ZipEndCentralDirectorySignature : Longint = $06054B50;
|
|
Ab_ZipSpannedSetSignature : Longint = $08074B50;
|
|
Ab_ZipPossiblySpannedSignature : Longint = $30304B50;
|
|
Ab_GeneralZipSignature : Word = $4B50;
|
|
|
|
Ab_ArchiveExtraDataRecord : Longint = $08064B50;
|
|
Ab_DigitalSignature : Longint = $05054B50;
|
|
|
|
Ab_WindowsExeSignature : Word = $5A4D;
|
|
Ab_LinuxExeSignature : Longint = $464C457F;
|
|
|
|
AbDefZipSpanningThreshold = 0;
|
|
AbDefPasswordRetries = 3;
|
|
AbFileIsEncryptedFlag = $0001;
|
|
AbHasDataDescriptorFlag = $0008;
|
|
AbLanguageEncodingFlag = $0800;
|
|
|
|
Ab_Zip64SubfieldID : Word = $0001;
|
|
Ab_InfoZipUnicodePathSubfieldID : Word = $7075;
|
|
Ab_XceedUnicodePathSubfieldID : Word = $554E;
|
|
Ab_XceedUnicodePathSignature : LongWord= $5843554E;
|
|
|
|
type
|
|
PAbByteArray4K = ^TAbByteArray4K;
|
|
TAbByteArray4K = array[1..4096] of Byte;
|
|
PAbByteArray8K = ^TAbByteArray8K;
|
|
TAbByteArray8K = array[0..8192] of Byte;
|
|
PAbIntArray8K = ^TAbIntArray8K;
|
|
TAbIntArray8K = array[0..8192] of SmallInt;
|
|
|
|
PAbWordArray = ^TAbWordArray;
|
|
TAbWordArray = array[0..65535 div SizeOf(Word)-1] of Word;
|
|
PAbByteArray = ^TAbByteArray;
|
|
TAbByteArray = array[0..65535-1] of Byte;
|
|
PAbSmallIntArray = ^TAbSmallIntArray;
|
|
TAbSmallIntArray = array[0..65535 div SizeOf(SmallInt)-1] of SmallInt;
|
|
|
|
PAbIntegerArray = ^TAbIntegerArray;
|
|
TAbIntegerArray = array[0..65535 div sizeof(integer)-1] of integer;
|
|
|
|
TAbZip64EndOfCentralDirectoryRecord = packed record
|
|
Signature : Longint;
|
|
RecordSize : Int64;
|
|
VersionMadeBy : Word;
|
|
VersionNeededToExtract : Word;
|
|
DiskNumber : LongWord;
|
|
StartDiskNumber : LongWord;
|
|
EntriesOnDisk : Int64;
|
|
TotalEntries : Int64;
|
|
DirectorySize : Int64;
|
|
DirectoryOffset : Int64;
|
|
end;
|
|
|
|
TAbZip64EndOfCentralDirectoryLocator = packed record
|
|
Signature : Longint;
|
|
StartDiskNumber : Longint;
|
|
RelativeOffset : Int64;
|
|
TotalDisks : Longint;
|
|
end;
|
|
|
|
TAbZipEndOfCentralDirectoryRecord = packed record
|
|
Signature : Longint;
|
|
DiskNumber : Word;
|
|
StartDiskNumber : Word;
|
|
EntriesOnDisk : Word;
|
|
TotalEntries : Word;
|
|
DirectorySize : LongWord;
|
|
DirectoryOffset : LongWord;
|
|
CommentLength : Word;
|
|
end;
|
|
|
|
TAbFollower = {used to expand reduced files}
|
|
packed record
|
|
Size : Byte; {size of follower set}
|
|
FSet : array[0..31] of Byte; {follower set}
|
|
end;
|
|
PAbFollowerSets = ^TAbFollowerSets;
|
|
TAbFollowerSets = array[0..255] of TAbFollower;
|
|
|
|
|
|
PAbSfEntry = ^TAbSfEntry;
|
|
TAbSfEntry = {entry in a Shannon-Fano tree}
|
|
packed record
|
|
case Byte of
|
|
0 : (Code : Word; Value, BitLength : Byte);
|
|
1 : (L : Longint);
|
|
end;
|
|
PAbSfTree = ^TAbSfTree;
|
|
TAbSfTree =
|
|
packed record {a Shannon-Fano tree}
|
|
Entries : SmallInt;
|
|
MaxLength : SmallInt;
|
|
Entry : array[0..256] of TAbSfEntry;
|
|
end;
|
|
|
|
PInfoZipUnicodePathRec = ^TInfoZipUnicodePathRec;
|
|
TInfoZipUnicodePathRec = packed record
|
|
Version: Byte;
|
|
NameCRC32: LongInt;
|
|
UnicodeName: array[0..0] of AnsiChar;
|
|
end;
|
|
|
|
PXceedUnicodePathRec = ^TXceedUnicodePathRec;
|
|
TXceedUnicodePathRec = packed record
|
|
Signature: LongWord;
|
|
Length: Integer;
|
|
UnicodeName: array[0..0] of WideChar;
|
|
end;
|
|
|
|
PZip64LocalHeaderRec = ^TZip64LocalHeaderRec;
|
|
TZip64LocalHeaderRec = packed record
|
|
UncompressedSize: Int64;
|
|
CompressedSize: Int64;
|
|
end;
|
|
|
|
type
|
|
TAbZipCompressionMethod =
|
|
(cmStored, cmShrunk, cmReduced1, cmReduced2, cmReduced3,
|
|
cmReduced4, cmImploded, cmTokenized, cmDeflated,
|
|
cmEnhancedDeflated, cmDCLImploded, cmBzip2 = 12, cmLZMA = 14,
|
|
cmIBMTerse = 18, cmLZ77, cmJPEG = 96, cmWavPack = 97, cmPPMd);
|
|
|
|
TAbZipSupportedMethod =
|
|
(smStored, smDeflated, smBestMethod);
|
|
|
|
{ExternalFileAttributes compatibility; aliases are Info-ZIP/PKZIP overlaps}
|
|
TAbZipHostOS =
|
|
(hosDOS, hosAmiga, hosVAX, hosUnix, hosVMCMS, hosAtari,
|
|
hosOS2, hosMacintosh, hosZSystem, hosCPM, hosNTFS, hosTOPS20 = hosNTFS,
|
|
hosMVS, hosWinNT = hosMVS, hosVSE, hosQDOS = hosVSE, hosRISC,
|
|
hosVFAT, hosAltMVS, hosBeOS, hosTandem, hosOS400, hosTHEOS = hosOS400,
|
|
hosDarwin, hosAtheOS = 30);
|
|
|
|
{for method 6 - imploding}
|
|
TAbZipDictionarySize =
|
|
(dsInvalid, ds4K, ds8K);
|
|
|
|
{for method 8 - deflating}
|
|
TAbZipDeflationOption =
|
|
(doInvalid, doNormal, doMaximum, doFast, doSuperFast );
|
|
|
|
type
|
|
TAbNeedPasswordEvent = procedure(Sender : TObject;
|
|
var NewPassword : AnsiString) of object;
|
|
|
|
const
|
|
AbDefCompressionMethodToUse = smBestMethod;
|
|
AbDefDeflationOption = doNormal;
|
|
|
|
|
|
type
|
|
TAbZipDataDescriptor = class( TObject )
|
|
protected {private}
|
|
FCRC32 : Longint;
|
|
FCompressedSize : Int64;
|
|
FUncompressedSize : Int64;
|
|
public {methods}
|
|
procedure SaveToStream( Stream : TStream );
|
|
public {properties}
|
|
property CRC32 : Longint
|
|
read FCRC32 write FCRC32;
|
|
property CompressedSize : Int64
|
|
read FCompressedSize write FCompressedSize;
|
|
property UncompressedSize : Int64
|
|
read FUncompressedSize write FUncompressedSize;
|
|
end;
|
|
|
|
type
|
|
{ TAbZipFileHeader interface =============================================== }
|
|
{ancestor class for ZipLocalFileHeader and DirectoryFileHeader}
|
|
TAbZipFileHeader = class( TObject )
|
|
protected {private}
|
|
FValidSignature : Longint;
|
|
FSignature : Longint;
|
|
FVersionNeededToExtract : Word;
|
|
FGeneralPurposeBitFlag : Word;
|
|
FCompressionMethod : Word;
|
|
FLastModFileTime : Word;
|
|
FLastModFileDate : Word;
|
|
FCRC32 : Longint;
|
|
FCompressedSize : LongWord;
|
|
FUncompressedSize : LongWord;
|
|
FFileName : AnsiString;
|
|
FExtraField : TAbExtraField;
|
|
protected {methods}
|
|
function GetCompressionMethod : TAbZipCompressionMethod;
|
|
function GetCompressionRatio : Double;
|
|
function GetDataDescriptor : Boolean;
|
|
function GetDeflationOption : TAbZipDeflationOption;
|
|
function GetDictionarySize : TAbZipDictionarySize;
|
|
function GetEncrypted : Boolean;
|
|
function GetIsUTF8 : Boolean;
|
|
function GetShannonFanoTreeCount : Byte;
|
|
function GetValid : Boolean;
|
|
procedure SetCompressionMethod( Value : TAbZipCompressionMethod );
|
|
procedure SetIsUTF8( Value : Boolean );
|
|
public {methods}
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
public {properties}
|
|
property Signature : Longint
|
|
read FSignature write FSignature;
|
|
property VersionNeededToExtract : Word
|
|
read FVersionNeededToExtract write FVersionNeededToExtract;
|
|
property GeneralPurposeBitFlag : Word
|
|
read FGeneralPurposeBitFlag write FGeneralPurposeBitFlag;
|
|
property CompressionMethod : TAbZipCompressionMethod
|
|
read GetCompressionMethod write SetCompressionMethod;
|
|
property LastModFileTime : Word
|
|
read FLastModFileTime write FLastModFileTime;
|
|
property LastModFileDate : Word
|
|
read FLastModFileDate write FLastModFileDate;
|
|
property CRC32 : Longint
|
|
read FCRC32 write FCRC32;
|
|
property CompressedSize : LongWord
|
|
read FCompressedSize write FCompressedSize;
|
|
property UncompressedSize : LongWord
|
|
read FUncompressedSize write FUncompressedSize;
|
|
property FileName : AnsiString
|
|
read FFileName write FFileName;
|
|
property ExtraField : TAbExtraField
|
|
read FExtraField;
|
|
|
|
property CompressionRatio : Double
|
|
read GetCompressionRatio;
|
|
property DeflationOption : TAbZipDeflationOption
|
|
read GetDeflationOption;
|
|
property DictionarySize : TAbZipDictionarySize
|
|
read GetDictionarySize;
|
|
property HasDataDescriptor : Boolean
|
|
read GetDataDescriptor;
|
|
property IsValid : Boolean
|
|
read GetValid;
|
|
property IsEncrypted : Boolean
|
|
read GetEncrypted;
|
|
property IsUTF8 : Boolean
|
|
read GetIsUTF8 write SetIsUTF8;
|
|
property ShannonFanoTreeCount : Byte
|
|
read GetShannonFanoTreeCount;
|
|
end;
|
|
|
|
{ TAbZipLocalFileHeader interface ========================================== }
|
|
TAbZipLocalFileHeader = class( TAbZipFileHeader )
|
|
public {methods}
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure LoadFromStream( Stream : TStream );
|
|
procedure SaveToStream( Stream : TStream );
|
|
end;
|
|
|
|
{ TAbZipDirectoryFileHeader interface ====================================== }
|
|
TAbZipDirectoryFileHeader = class( TAbZipFileHeader )
|
|
protected {private}
|
|
FVersionMadeBy : Word;
|
|
FDiskNumberStart : Word;
|
|
FInternalFileAttributes : Word;
|
|
FExternalFileAttributes : LongWord;
|
|
FRelativeOffset : LongWord;
|
|
FFileComment : AnsiString;
|
|
public {methods}
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure LoadFromStream( Stream : TStream );
|
|
procedure SaveToStream( Stream : TStream );
|
|
public {properties}
|
|
property VersionMadeBy : Word
|
|
read FVersionMadeBy write FVersionMadeBy;
|
|
property DiskNumberStart : Word
|
|
read FDiskNumberStart write FDiskNumberStart;
|
|
property InternalFileAttributes : Word
|
|
read FInternalFileAttributes write FInternalFileAttributes;
|
|
property ExternalFileAttributes : LongWord
|
|
read FExternalFileAttributes write FExternalFileAttributes;
|
|
property RelativeOffset : LongWord
|
|
read FRelativeOffset write FRelativeOffset;
|
|
property FileComment : AnsiString
|
|
read FFileComment write FFileComment;
|
|
end;
|
|
|
|
{ TAbZipDirectoryFileFooter interface ====================================== }
|
|
TAbZipDirectoryFileFooter = class( TObject )
|
|
protected {private}
|
|
FDiskNumber : LongWord;
|
|
FStartDiskNumber : LongWord;
|
|
FEntriesOnDisk : Int64;
|
|
FTotalEntries : Int64;
|
|
FDirectorySize : Int64;
|
|
FDirectoryOffset : Int64;
|
|
FZipfileComment : AnsiString;
|
|
function GetIsZip64: Boolean;
|
|
public {methods}
|
|
procedure LoadFromStream( Stream : TStream );
|
|
procedure LoadZip64FromStream( Stream : TStream );
|
|
procedure SaveToStream( Stream : TStream; aZip64TailOffset : Int64 = -1 );
|
|
public {properties}
|
|
property DiskNumber : LongWord
|
|
read FDiskNumber write FDiskNumber;
|
|
property EntriesOnDisk : Int64
|
|
read FEntriesOnDisk write FEntriesOnDisk;
|
|
property TotalEntries : Int64
|
|
read FTotalEntries write FTotalEntries;
|
|
property DirectorySize : Int64
|
|
read FDirectorySize write FDirectorySize;
|
|
property DirectoryOffset : Int64
|
|
read FDirectoryOffset write FDirectoryOffset;
|
|
property StartDiskNumber : LongWord
|
|
read FStartDiskNumber write FStartDiskNumber;
|
|
property ZipfileComment : AnsiString
|
|
read FZipfileComment write FZipfileComment;
|
|
property IsZip64: Boolean
|
|
read GetIsZip64;
|
|
end;
|
|
|
|
{ TAbZipItem interface ===================================================== }
|
|
TAbZipItem = class( TAbArchiveItem )
|
|
protected {private}
|
|
FItemInfo : TAbZipDirectoryFileHeader;
|
|
FDiskNumberStart : LongWord;
|
|
FLFHExtraField : TAbExtraField;
|
|
FRelativeOffset : Int64;
|
|
|
|
protected {methods}
|
|
function GetCompressionMethod : TAbZipCompressionMethod;
|
|
function GetCompressionRatio : Double;
|
|
function GetDeflationOption : TAbZipDeflationOption;
|
|
function GetDictionarySize : TAbZipDictionarySize;
|
|
function GetExtraField : TAbExtraField;
|
|
function GetFileComment : AnsiString;
|
|
function GetGeneralPurposeBitFlag : Word;
|
|
function GetHostOS: TAbZipHostOS;
|
|
function GetInternalFileAttributes : Word;
|
|
function GetRawFileName : AnsiString;
|
|
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 : LongWord );
|
|
procedure SetFileComment(const Value : AnsiString );
|
|
procedure SetGeneralPurposeBitFlag( Value : Word );
|
|
procedure SetHostOS( Value : TAbZipHostOS );
|
|
procedure SetInternalFileAttributes( Value : Word );
|
|
procedure SetRelativeOffset( Value : Int64 );
|
|
procedure SetVersionMadeBy( Value : Word );
|
|
procedure SetVersionNeededToExtract( Value : Word );
|
|
procedure UpdateVersionNeededToExtract;
|
|
procedure UpdateZip64ExtraHeader;
|
|
|
|
protected {redefined property methods}
|
|
function GetCRC32 : Longint; override;
|
|
function GetExternalFileAttributes : LongWord; override;
|
|
function GetIsDirectory: Boolean; override;
|
|
function GetIsEncrypted : Boolean; override;
|
|
function GetLastModFileDate : Word; override;
|
|
function GetLastModFileTime : Word; override;
|
|
function GetNativeFileAttributes : LongInt; override;
|
|
procedure SetCompressedSize( const Value : Int64 ); override;
|
|
procedure SetCRC32( const Value : Longint ); override;
|
|
procedure SetExternalFileAttributes( Value : LongWord ); override;
|
|
procedure SetFileName(const Value : string ); override;
|
|
procedure SetLastModFileDate(const Value : Word ); override;
|
|
procedure SetLastModFileTime(const Value : Word ); override;
|
|
procedure SetUncompressedSize( const Value : Int64 ); 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 : LongWord
|
|
read FDiskNumberStart
|
|
write SetDiskNumberStart;
|
|
property ExtraField : TAbExtraField
|
|
read GetExtraField;
|
|
property FileComment : AnsiString
|
|
read GetFileComment
|
|
write SetFileComment;
|
|
property HostOS: TAbZipHostOS
|
|
read GetHostOS
|
|
write SetHostOS;
|
|
property InternalFileAttributes : Word
|
|
read GetInternalFileAttributes
|
|
write SetInternalFileAttributes;
|
|
property GeneralPurposeBitFlag : Word
|
|
read GetGeneralPurposeBitFlag
|
|
write SetGeneralPurposeBitFlag;
|
|
property LFHExtraField : TAbExtraField
|
|
read FLFHExtraField;
|
|
property RawFileName : AnsiString
|
|
read GetRawFileName;
|
|
property RelativeOffset : Int64
|
|
read FRelativeOffset
|
|
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;
|
|
FDeflationOption : TAbZipDeflationOption;
|
|
FInfo : TAbZipDirectoryFileFooter;
|
|
FIsExecutable : Boolean;
|
|
FPassword : AnsiString;
|
|
FPasswordRetries : Byte;
|
|
FStubSize : LongWord;
|
|
|
|
FExtractHelper : TAbArchiveItemExtractEvent;
|
|
FExtractToStreamHelper : TAbArchiveItemExtractToStreamEvent;
|
|
FTestHelper : TAbArchiveItemTestEvent;
|
|
FInsertHelper : TAbArchiveItemInsertEvent;
|
|
FInsertFromStreamHelper : TAbArchiveItemInsertFromStreamEvent;
|
|
FOnNeedPassword : TAbNeedPasswordEvent;
|
|
FOnRequestLastDisk : TAbRequestDiskEvent;
|
|
FOnRequestNthDisk : TAbRequestNthDiskEvent;
|
|
FOnRequestBlankDisk : TAbRequestDiskEvent;
|
|
|
|
protected {methods}
|
|
procedure DoExtractHelper(Index : Integer; const NewName : string);
|
|
procedure DoExtractToStreamHelper(Index : Integer; aStream : TStream);
|
|
procedure DoTestHelper(Index : Integer);
|
|
procedure DoInsertHelper(Index : Integer; OutStream : TStream);
|
|
procedure DoInsertFromStreamHelper(Index : Integer; OutStream : TStream);
|
|
function GetItem( Index : Integer ) : TAbZipItem;
|
|
function GetZipfileComment : AnsiString;
|
|
procedure PutItem( Index : Integer; Value : TAbZipItem );
|
|
procedure DoRequestDisk(const AMessage: string; var Abort : Boolean);
|
|
procedure DoRequestLastDisk( var Abort : Boolean );
|
|
virtual;
|
|
procedure DoRequestNthDisk(Sender: TObject; DiskNumber : Byte; var Abort : Boolean );
|
|
virtual;
|
|
procedure DoRequestBlankDisk(Sender: TObject; var Abort : Boolean );
|
|
virtual;
|
|
procedure ExtractItemAt(Index : Integer; const UseName : string);
|
|
override;
|
|
procedure ExtractItemToStreamAt(Index : Integer; aStream : TStream);
|
|
override;
|
|
procedure TestItemAt(Index : Integer);
|
|
override;
|
|
function FixName(const Value : string ) : string;
|
|
override;
|
|
function GetSupportsEmptyFolders: Boolean;
|
|
override;
|
|
procedure LoadArchive;
|
|
override;
|
|
procedure SaveArchive;
|
|
override;
|
|
procedure SetZipfileComment(const Value : AnsiString );
|
|
|
|
protected {properties}
|
|
property IsExecutable : Boolean
|
|
read FIsExecutable write FIsExecutable;
|
|
|
|
public {protected}
|
|
procedure DoRequestImage(Sender: TObject; ImageNumber: Integer;
|
|
var ImageName: string; var Abort: Boolean);
|
|
|
|
public {methods}
|
|
constructor CreateFromStream( aStream : TStream; const ArchiveName : string );
|
|
override;
|
|
destructor Destroy;
|
|
override;
|
|
function CreateItem(const FileName : string): TAbArchiveItem;
|
|
override;
|
|
|
|
public {properties}
|
|
property CompressionMethodToUse : TAbZipSupportedMethod
|
|
read FCompressionMethodToUse
|
|
write FCompressionMethodToUse;
|
|
property DeflationOption : TAbZipDeflationOption
|
|
read FDeflationOption
|
|
write FDeflationOption;
|
|
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 : AnsiString
|
|
read FPassword
|
|
write FPassword;
|
|
property PasswordRetries : Byte
|
|
read FPasswordRetries
|
|
write FPasswordRetries
|
|
default AbDefPasswordRetries;
|
|
property StubSize : LongWord
|
|
read FStubSize;
|
|
property ZipfileComment : AnsiString
|
|
read GetZipfileComment
|
|
write SetZipfileComment;
|
|
|
|
property Items[Index : Integer] : TAbZipItem
|
|
read GetItem
|
|
write PutItem; default;
|
|
|
|
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) : Int64;
|
|
|
|
function VerifyZip(Strm : TStream) : TAbArchiveType;
|
|
|
|
function VerifySelfExtracting(Strm : TStream) : TAbArchiveType;
|
|
|
|
function ZipCompressionMethodToString(aMethod: TAbZipCompressionMethod): string;
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF MSWINDOWS}
|
|
Windows,
|
|
{$ENDIF}
|
|
{$IFDEF LibcAPI}
|
|
Libc,
|
|
{$ENDIF}
|
|
{$IFDEF UnixDialogs}
|
|
{$IFDEF KYLIX}
|
|
QControls,
|
|
QDialogs,
|
|
{$ENDIF}
|
|
{$IFDEF LCL}
|
|
Controls,
|
|
Dialogs,
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
Math,
|
|
AbCharset,
|
|
AbResString,
|
|
AbExcept,
|
|
AbVMStrm,
|
|
SysUtils;
|
|
|
|
function VerifyZip(Strm : TStream) : TAbArchiveType;
|
|
{ determine if stream appears to be in PkZip format }
|
|
var
|
|
Footer : TAbZipEndOfCentralDirectoryRecord;
|
|
Sig : LongInt;
|
|
TailPosition : int64;
|
|
StartPos : int64;
|
|
begin
|
|
StartPos := Strm.Position;
|
|
Result := atUnknown;
|
|
try
|
|
Strm.Position := 0;
|
|
Strm.Read(Sig, SizeOf(Sig));
|
|
if (Sig = Ab_ZipSpannedSetSignature) then
|
|
Result := atSpannedZip
|
|
else begin
|
|
{ attempt to find Central Directory Tail }
|
|
TailPosition := FindCentralDirectoryTail( Strm );
|
|
if TailPosition <> -1 then begin
|
|
{ check Central Directory Signature }
|
|
Strm.ReadBuffer(Footer, SizeOf(Footer));
|
|
if Footer.Signature = Ab_ZipEndCentralDirectorySignature then
|
|
if Footer.DiskNumber = 0 then
|
|
Result := atZip
|
|
else
|
|
Result := atSpannedZip;
|
|
end;
|
|
end;
|
|
except
|
|
on EReadError do
|
|
Result := atUnknown;
|
|
end;
|
|
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 : Int64;
|
|
IsWinExe, IsLinuxExe : Boolean;
|
|
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;
|
|
|
|
{ detect executable type }
|
|
IsLinuxExe := FileSignature = Ab_LinuxExeSignature;
|
|
IsWinExe := LongRec(FileSignature).Lo = Ab_WindowsExeSignature;
|
|
if not (IsWinExe or IsLinuxExe) then
|
|
Result := atUnknown;
|
|
|
|
{ Check for central directory tail }
|
|
if VerifyZip(Strm) <> atZip then
|
|
Result := atUnknown;
|
|
|
|
Strm.Position := StartPos;
|
|
end;
|
|
{============================================================================}
|
|
function ZipCompressionMethodToString(aMethod: TAbZipCompressionMethod): string;
|
|
begin
|
|
case aMethod of
|
|
cmStored:
|
|
Result := AbZipStored;
|
|
cmShrunk:
|
|
Result := AbZipShrunk;
|
|
cmReduced1..cmReduced4:
|
|
Result := AbZipReduced;
|
|
cmImploded:
|
|
Result := AbZipImploded;
|
|
cmTokenized:
|
|
Result := AbZipTokenized;
|
|
cmDeflated:
|
|
Result := AbZipDeflated;
|
|
cmEnhancedDeflated:
|
|
Result := AbZipDeflate64;
|
|
cmDCLImploded:
|
|
Result := AbZipDCLImploded;
|
|
cmBzip2:
|
|
Result := AbZipBzip2;
|
|
cmLZMA:
|
|
Result := AbZipLZMA;
|
|
cmIBMTerse:
|
|
Result := AbZipIBMTerse;
|
|
cmLZ77:
|
|
Result := AbZipLZ77;
|
|
cmJPEG:
|
|
Result := AbZipJPEG;
|
|
cmWavPack:
|
|
Result := AbZipWavPack;
|
|
cmPPMd:
|
|
Result := AbZipPPMd;
|
|
else
|
|
Result := Format(AbZipUnknown, [Ord(aMethod)]);
|
|
end;
|
|
end;
|
|
{============================================================================}
|
|
function FindCentralDirectoryTail(aStream : TStream) : Int64;
|
|
{ search end of aStream looking for ZIP Central Directory structure
|
|
returns position in stream if found (otherwise returns -1),
|
|
leaves stream positioned at start of structure or at original
|
|
position if not found }
|
|
const
|
|
StartBufSize = 512;
|
|
MaxBufSize = 64 * 1024;
|
|
var
|
|
StartPos : Int64;
|
|
TailRec : TAbZipEndOfCentralDirectoryRecord;
|
|
Buffer : PAnsiChar;
|
|
Offset : Int64;
|
|
TestPos : PAnsiChar;
|
|
Done : boolean;
|
|
BytesRead : Int64;
|
|
BufSize : Int64;
|
|
CommentLen: integer;
|
|
begin
|
|
{save the starting position}
|
|
StartPos := aStream.Seek(0, soCurrent);
|
|
|
|
{start off with the majority case: no zip file comment, so the
|
|
central directory tail is the last thing in the stream and it's a
|
|
fixed size and doesn't indicate a zip file comment}
|
|
Result := aStream.Seek(-sizeof(TailRec), soEnd);
|
|
if (Result >= 0) then begin
|
|
aStream.ReadBuffer(TailRec, sizeof(TailRec));
|
|
if (TailRec.Signature = Ab_ZipEndCentralDirectorySignature) and
|
|
(TailRec.CommentLength = 0) then begin
|
|
aStream.Seek(Result, soBeginning);
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
{the zip stream seems to have a comment, or it has null padding
|
|
bytes from some flaky program, or it's not even a zip formatted
|
|
stream; we need to search for the tail signature}
|
|
|
|
{get a buffer}
|
|
BufSize := StartBufSize;
|
|
GetMem(Buffer, BufSize);
|
|
try
|
|
|
|
{start out searching backwards}
|
|
Offset := -BufSize;
|
|
|
|
{while there is still data to search ...}
|
|
Done := false;
|
|
while not Done do begin
|
|
|
|
{seek to the search position}
|
|
Result := aStream.Seek(Offset, soEnd);
|
|
if (Result <= 0) then begin
|
|
Result := aStream.Seek(0, soBeginning);
|
|
Done := true;
|
|
end;
|
|
|
|
{read a buffer full}
|
|
BytesRead := aStream.Read(Buffer^, BufSize);
|
|
|
|
if BytesRead < sizeOf(TailRec) then begin
|
|
Result := -1;
|
|
Exit;
|
|
end;
|
|
|
|
{search backwards through the buffer looking for the signature}
|
|
TestPos := Buffer + BytesRead - sizeof(TailRec);
|
|
while (TestPos <> Buffer) and
|
|
(PLongint(TestPos)^ <> Ab_ZipEndCentralDirectorySignature) do
|
|
dec(TestPos);
|
|
|
|
{if we found the signature...}
|
|
if (PLongint(TestPos)^ = Ab_ZipEndCentralDirectorySignature) then begin
|
|
|
|
{get the tail record at this position}
|
|
Move(TestPos^, TailRec, sizeof(TailRec));
|
|
|
|
{if it's as valid a tail as we can check here...}
|
|
CommentLen := -Offset - (TestPos - Buffer + sizeof(TailRec));
|
|
if (TailRec.CommentLength <= CommentLen) then begin
|
|
|
|
{calculate its position and exit}
|
|
Result := Result + (TestPos - Buffer);
|
|
aStream.Seek(Result, soBeginning);
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
{otherwise move back one step, doubling the buffer}
|
|
if (BufSize < MaxBufSize) then begin
|
|
FreeMem(Buffer);
|
|
BufSize := BufSize * 2;
|
|
if BufSize > MaxBufSize then
|
|
BufSize := MaxBufSize;
|
|
GetMem(Buffer, BufSize);
|
|
end;
|
|
dec(Offset, BufSize - SizeOf(TailRec));
|
|
end;
|
|
|
|
{if we reach this point, the CD tail is not present}
|
|
Result := -1;
|
|
aStream.Seek(StartPos, soBeginning);
|
|
finally
|
|
FreeMem(Buffer);
|
|
end;
|
|
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}
|
|
var
|
|
DirectoryStart : Int64;
|
|
FileSignature : Longint;
|
|
StubSize : LongWord;
|
|
TailPosition : Int64;
|
|
ZDFF : TAbZipDirectoryFileFooter;
|
|
ZipItem : TAbZipItem;
|
|
IsWinExe, IsLinuxExe : Boolean;
|
|
begin
|
|
{check file type of stub stream}
|
|
StubStream.Position := 0;
|
|
StubStream.Read(FileSignature, SizeOf(FileSignature));
|
|
|
|
{detect executable type }
|
|
IsLinuxExe := FileSignature = Ab_LinuxExeSignature;
|
|
IsWinExe := LongRec(FileSignature).Lo = Ab_WindowsExeSignature;
|
|
|
|
if not (IsWinExe or IsLinuxExe) then
|
|
raise EAbZipInvalidStub.Create;
|
|
|
|
StubStream.Position := 0;
|
|
StubSize := StubStream.Size;
|
|
|
|
ZipStream.Position := 0;
|
|
ZipStream.Read( FileSignature, sizeof( FileSignature ) );
|
|
if LongRec(FileSignature).Lo <> Ab_GeneralZipSignature then
|
|
raise EAbZipInvalid.Create;
|
|
ZipStream.Position := 0;
|
|
|
|
{copy the stub into the selfex stream}
|
|
SelfExtractingStream.Position := 0;
|
|
SelfExtractingStream.CopyFrom( StubStream, 0 );
|
|
|
|
TailPosition := FindCentralDirectoryTail( ZipStream );
|
|
if TailPosition = -1 then
|
|
raise EAbZipInvalid.Create;
|
|
{load the ZipDirectoryFileFooter}
|
|
ZDFF := TAbZipDirectoryFileFooter.Create;
|
|
try
|
|
ZDFF.LoadFromStream( ZipStream );
|
|
DirectoryStart := ZDFF.DirectoryOffset;
|
|
finally
|
|
ZDFF.Free;
|
|
end;
|
|
{copy everything up to the CDH into the SelfExtractingStream}
|
|
ZipStream.Position := 0;
|
|
SelfExtractingStream.CopyFrom( ZipStream, DirectoryStart );
|
|
ZipStream.Position := DirectoryStart;
|
|
repeat
|
|
ZipItem := TAbZipItem.Create;
|
|
try
|
|
ZipItem.LoadFromStream( ZipStream );
|
|
ZipItem.RelativeOffset := ZipItem.RelativeOffset + StubSize;
|
|
{save the modified entry into the Self Extracting Stream}
|
|
ZipItem.SaveCDHToStream( SelfExtractingStream );
|
|
finally
|
|
ZipItem.Free;
|
|
end;
|
|
until ZipStream.Position = TailPosition;
|
|
|
|
{save the CDH Footer.}
|
|
ZDFF := TAbZipDirectoryFileFooter.Create;
|
|
try
|
|
ZDFF.LoadFromStream( ZipStream );
|
|
ZDFF.DirectoryOffset := ZDFF.DirectoryOffset + StubSize;
|
|
ZDFF.SaveToStream( SelfExtractingStream );
|
|
finally
|
|
ZDFF.Free;
|
|
end;
|
|
end;
|
|
{============================================================================}
|
|
{ TAbZipDataDescriptor implementation ====================================== }
|
|
procedure TAbZipDataDescriptor.SaveToStream( Stream : TStream );
|
|
begin
|
|
Stream.Write( Ab_ZipDataDescriptorSignature, sizeof( Ab_ZipDataDescriptorSignature ) );
|
|
Stream.Write( FCRC32, sizeof( FCRC32 ) );
|
|
if (FCompressedSize >= $FFFFFFFF) or (FUncompressedSize >= $FFFFFFFF) then begin
|
|
Stream.Write( FCompressedSize, sizeof( FCompressedSize ) );
|
|
Stream.Write( FUncompressedSize, sizeof( FUncompressedSize ) );
|
|
end
|
|
else begin
|
|
Stream.Write( FCompressedSize, sizeof( LongWord ) );
|
|
Stream.Write( FUncompressedSize, sizeof( LongWord ) );
|
|
end;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
|
|
{ TAbZipFileHeader implementation ========================================== }
|
|
constructor TAbZipFileHeader.Create;
|
|
begin
|
|
inherited Create;
|
|
FExtraField := TAbExtraField.Create;
|
|
FValidSignature := $0;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
destructor TAbZipFileHeader.Destroy;
|
|
begin
|
|
FreeAndNil(FExtraField);
|
|
inherited Destroy;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipFileHeader.GetCompressionMethod : TAbZipCompressionMethod;
|
|
begin
|
|
Result := TAbZipCompressionMethod( FCompressionMethod );
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipFileHeader.GetDataDescriptor : Boolean;
|
|
begin
|
|
Result := ( CompressionMethod = cmDeflated ) and
|
|
( ( FGeneralPurposeBitFlag and AbHasDataDescriptorFlag ) <> 0 );
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipFileHeader.GetCompressionRatio : Double;
|
|
var
|
|
CompSize : Int64;
|
|
begin
|
|
{adjust for encrypted headers - ensures we never get negative compression
|
|
ratios for stored, encrypted files - no guarantees about negative
|
|
compression ratios in other cases}
|
|
if isEncrypted then
|
|
CompSize := CompressedSize - 12
|
|
else
|
|
CompSize := CompressedSize;
|
|
if UncompressedSize > 0 then
|
|
Result := 100.0 * ( 1 - ( ( 1.0 * CompSize ) / UncompressedSize ) )
|
|
else
|
|
Result := 0.0;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipFileHeader.GetDeflationOption : TAbZipDeflationOption;
|
|
begin
|
|
if CompressionMethod = cmDeflated then
|
|
if ( ( FGeneralPurposeBitFlag and $02 ) <> 0 ) then
|
|
if ( ( FGeneralPurposeBitFlag and $04 ) <> 0 ) then
|
|
Result := doSuperFast
|
|
else
|
|
Result := doMaximum
|
|
else
|
|
if ( ( FGeneralPurposeBitFlag and $04 ) <> 0 ) then
|
|
Result := doFast
|
|
else
|
|
Result := doNormal
|
|
else
|
|
Result := doInvalid;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipFileHeader.GetDictionarySize : TAbZipDictionarySize;
|
|
begin
|
|
if CompressionMethod = cmImploded then
|
|
if ( ( FGeneralPurposeBitFlag and $02 ) <> 0 ) then
|
|
Result := ds8K
|
|
else
|
|
Result := ds4K
|
|
else
|
|
Result := dsInvalid;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipFileHeader.GetEncrypted : Boolean;
|
|
begin
|
|
{bit 0 of the GeneralPurposeBitFlag}
|
|
Result := ( ( FGeneralPurposeBitFlag and AbFileIsEncryptedFlag ) <> 0 );
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipFileHeader.GetIsUTF8 : Boolean;
|
|
begin
|
|
Result := ( ( GeneralPurposeBitFlag and AbLanguageEncodingFlag ) <> 0 );
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipFileHeader.GetShannonFanoTreeCount : Byte;
|
|
begin
|
|
if CompressionMethod = cmImploded then
|
|
if ( ( FGeneralPurposeBitFlag and $04 ) <> 0 ) then
|
|
Result := 3
|
|
else
|
|
Result := 2
|
|
else
|
|
Result := 0;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipFileHeader.GetValid : Boolean;
|
|
begin
|
|
Result := ( FValidSignature = FSignature );
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipFileHeader.SetCompressionMethod( Value :
|
|
TAbZipCompressionMethod );
|
|
begin
|
|
FCompressionMethod := Ord( Value );
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipFileHeader.SetIsUTF8( Value : Boolean );
|
|
begin
|
|
if Value then
|
|
GeneralPurposeBitFlag := GeneralPurposeBitFlag or AbLanguageEncodingFlag
|
|
else
|
|
GeneralPurposeBitFlag := GeneralPurposeBitFlag and not AbLanguageEncodingFlag;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
|
|
{ TAbZipLocalFileHeader implementation ===================================== }
|
|
constructor TAbZipLocalFileHeader.Create;
|
|
begin
|
|
inherited Create;
|
|
FValidSignature := Ab_ZipLocalFileHeaderSignature;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
destructor TAbZipLocalFileHeader.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipLocalFileHeader.LoadFromStream( Stream : TStream );
|
|
var
|
|
ExtraFieldLength, FileNameLength : Word;
|
|
begin
|
|
with Stream do begin
|
|
Read( FSignature, sizeof( FSignature ) );
|
|
Read( FVersionNeededToExtract, sizeof( FVersionNeededToExtract ) );
|
|
Read( FGeneralPurposeBitFlag, sizeof( FGeneralPurposeBitFlag ) );
|
|
Read( FCompressionMethod, sizeof( FCompressionMethod ) );
|
|
Read( FLastModFileTime, sizeof( FLastModFileTime ) );
|
|
Read( FLastModFileDate, sizeof( FLastModFileDate ) );
|
|
Read( FCRC32, sizeof( FCRC32 ) );
|
|
Read( FCompressedSize, sizeof( FCompressedSize ) );
|
|
Read( FUncompressedSize, sizeof( FUncompressedSize ) );
|
|
Read( FileNameLength, sizeof( FileNameLength ) );
|
|
Read( ExtraFieldLength, sizeof( ExtraFieldLength ) );
|
|
|
|
SetLength( FFileName, FileNameLength );
|
|
if FileNameLength > 0 then
|
|
Read( FFileName[1], FileNameLength );
|
|
|
|
FExtraField.LoadFromStream( Stream, ExtraFieldLength );
|
|
end;
|
|
if not IsValid then
|
|
raise EAbZipInvalid.Create;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipLocalFileHeader.SaveToStream( Stream : TStream );
|
|
var
|
|
ExtraFieldLength, FileNameLength: Word;
|
|
begin
|
|
with Stream do begin
|
|
{write the valid signature from the constant}
|
|
Write( FValidSignature, sizeof( FValidSignature ) );
|
|
Write( FVersionNeededToExtract, sizeof( FVersionNeededToExtract ) );
|
|
Write( FGeneralPurposeBitFlag, sizeof( FGeneralPurposeBitFlag ) );
|
|
Write( FCompressionMethod, sizeof( FCompressionMethod ) );
|
|
Write( FLastModFileTime, sizeof( FLastModFileTime ) );
|
|
Write( FLastModFileDate, sizeof( FLastModFileDate ) );
|
|
Write( FCRC32, sizeof( FCRC32 ) );
|
|
Write( FCompressedSize, sizeof( FCompressedSize ) );
|
|
Write( FUncompressedSize, sizeof( FUncompressedSize ) );
|
|
FileNameLength := Word( Length( FFileName ) );
|
|
Write( FileNameLength, sizeof( FileNameLength ) );
|
|
ExtraFieldLength := Length(FExtraField.Buffer);
|
|
Write( ExtraFieldLength, sizeof( ExtraFieldLength ) );
|
|
if FileNameLength > 0 then
|
|
Write( FFileName[1], FileNameLength );
|
|
if ExtraFieldLength > 0 then
|
|
Write(FExtraField.Buffer[0], ExtraFieldLength);
|
|
end;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
|
|
{ TAbZipDirectoryFileHeader implementation ================================= }
|
|
constructor TAbZipDirectoryFileHeader.Create;
|
|
begin
|
|
inherited Create;
|
|
FValidSignature := Ab_ZipCentralDirectoryFileHeaderSignature;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
destructor TAbZipDirectoryFileHeader.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipDirectoryFileHeader.LoadFromStream( Stream : TStream );
|
|
var
|
|
ExtraFieldLength, FileCommentLength, FileNameLength : Word;
|
|
begin
|
|
with Stream do begin
|
|
Read( FSignature, sizeof( FSignature ) );
|
|
Read( FVersionMadeBy, sizeof( FVersionMadeBy ) );
|
|
Read( FVersionNeededToExtract, sizeof( FVersionNeededToExtract ) );
|
|
Read( FGeneralPurposeBitFlag, sizeof( FGeneralPurposeBitFlag ) );
|
|
Read( FCompressionMethod, sizeof( FCompressionMethod ) );
|
|
Read( FLastModFileTime, sizeof( FLastModFileTime ) );
|
|
Read( FLastModFileDate, sizeof( FLastModFileDate ) );
|
|
Read( FCRC32, sizeof( FCRC32 ) );
|
|
Read( FCompressedSize, sizeof( FCompressedSize ) );
|
|
Read( FUncompressedSize, sizeof( FUncompressedSize ) );
|
|
Read( FileNameLength, sizeof( FileNameLength ) );
|
|
Read( ExtraFieldLength, sizeof( ExtraFieldLength ) );
|
|
Read( FileCommentLength, sizeof( FileCommentLength ) );
|
|
Read( FDiskNumberStart, sizeof( FDiskNumberStart ) );
|
|
Read( FInternalFileAttributes, sizeof( FInternalFileAttributes ) );
|
|
Read( FExternalFileAttributes, sizeof( FExternalFileAttributes ) );
|
|
Read( FRelativeOffset, sizeof( FRelativeOffset ) );
|
|
|
|
SetLength( FFileName, FileNameLength );
|
|
if FileNameLength > 0 then
|
|
Read( FFileName[1], FileNameLength );
|
|
|
|
FExtraField.LoadFromStream( Stream, ExtraFieldLength );
|
|
|
|
SetLength( FFileComment, FileCommentLength );
|
|
if FileCommentLength > 0 then
|
|
Read( FFileComment[1], FileCommentLength );
|
|
end;
|
|
if not IsValid then
|
|
raise EAbZipInvalid.Create;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipDirectoryFileHeader.SaveToStream( Stream : TStream );
|
|
var
|
|
ExtraFieldLength, FileCommentLength, FileNameLength : Word;
|
|
begin
|
|
with Stream do begin
|
|
{write the valid signature from the constant}
|
|
Write( FValidSignature, sizeof( FValidSignature ) );
|
|
Write( FVersionMadeBy, sizeof( FVersionMadeBy ) );
|
|
Write( FVersionNeededToExtract, sizeof( FVersionNeededToExtract ) );
|
|
Write( FGeneralPurposeBitFlag, sizeof( FGeneralPurposeBitFlag ) );
|
|
Write( FCompressionMethod, sizeof( FCompressionMethod ) );
|
|
Write( FLastModFileTime, sizeof( FLastModFileTime ) );
|
|
Write( FLastModFileDate, sizeof( FLastModFileDate ) );
|
|
Write( FCRC32, sizeof( FCRC32 ) );
|
|
Write( FCompressedSize, sizeof( FCompressedSize ) );
|
|
Write( FUncompressedSize, sizeof( FUncompressedSize ) );
|
|
FileNameLength := Word( Length( FFileName ) );
|
|
Write( FileNameLength, sizeof( FileNameLength ) );
|
|
ExtraFieldLength := Length(FExtraField.Buffer);
|
|
Write( ExtraFieldLength, sizeof( ExtraFieldLength ) );
|
|
FileCommentLength := Word( Length( FFileComment ) );
|
|
Write( FileCommentLength, sizeof( FileCommentLength ) );
|
|
Write( FDiskNumberStart, sizeof( FDiskNumberStart ) );
|
|
Write( FInternalFileAttributes, sizeof( FInternalFileAttributes ) );
|
|
Write( FExternalFileAttributes, sizeof( FExternalFileAttributes ) );
|
|
Write( FRelativeOffset, sizeof( FRelativeOffset ) );
|
|
if FileNameLength > 0 then
|
|
Write( FFileName[1], FileNameLength );
|
|
if ExtraFieldLength > 0 then
|
|
Write( FExtraField.Buffer[0], ExtraFieldLength );
|
|
if FileCommentLength > 0 then
|
|
Write( FFileComment[1], FileCommentLength );
|
|
end;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
|
|
{ TAbZipDirectoryFileFooter implementation ================================= }
|
|
function TAbZipDirectoryFileFooter.GetIsZip64: Boolean;
|
|
begin
|
|
Result := (DiskNumber >= $FFFF) or
|
|
(StartDiskNumber >= $FFFF) or
|
|
(EntriesOnDisk >= $FFFF) or
|
|
(TotalEntries >= $FFFF) or
|
|
(DirectorySize >= $FFFFFFFF) or
|
|
(DirectoryOffset >= $FFFFFFFF);
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipDirectoryFileFooter.LoadFromStream( Stream : TStream );
|
|
var
|
|
Footer: TAbZipEndOfCentralDirectoryRecord;
|
|
begin
|
|
Stream.ReadBuffer( Footer, SizeOf(Footer) );
|
|
if Footer.Signature <> Ab_ZipEndCentralDirectorySignature then
|
|
raise EAbZipInvalid.Create;
|
|
FDiskNumber := Footer.DiskNumber;
|
|
FStartDiskNumber := Footer.StartDiskNumber;
|
|
FEntriesOnDisk := Footer.EntriesOnDisk;
|
|
FTotalEntries := Footer.TotalEntries;
|
|
FDirectorySize := Footer.DirectorySize;
|
|
FDirectoryOffset := Footer.DirectoryOffset;
|
|
SetLength( FZipfileComment, Footer.CommentLength );
|
|
if Footer.CommentLength > 0 then
|
|
Stream.ReadBuffer( FZipfileComment[1], Footer.CommentLength );
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipDirectoryFileFooter.LoadZip64FromStream( Stream : TStream );
|
|
{load the ZIP64 end of central directory record.
|
|
LoadFromStream() must be called first to load the standard record}
|
|
var
|
|
Footer: TAbZip64EndOfCentralDirectoryRecord;
|
|
begin
|
|
Stream.ReadBuffer( Footer, SizeOf(Footer) );
|
|
if Footer.Signature <> Ab_Zip64EndCentralDirectorySignature then
|
|
raise EAbZipInvalid.Create;
|
|
if FDiskNumber = $FFFF then
|
|
FDiskNumber := Footer.DiskNumber;
|
|
if FStartDiskNumber = $FFFF then
|
|
FStartDiskNumber := Footer.StartDiskNumber;
|
|
if FEntriesOnDisk = $FFFF then
|
|
FEntriesOnDisk := Footer.EntriesOnDisk;
|
|
if FTotalEntries = $FFFF then
|
|
FTotalEntries := Footer.TotalEntries;
|
|
if FDirectorySize = $FFFFFFFF then
|
|
FDirectorySize := Footer.DirectorySize;
|
|
if FDirectoryOffset = $FFFFFFFF then
|
|
FDirectoryOffset := Footer.DirectoryOffset;
|
|
{RecordSize, VersionMadeBy, and VersionNeededToExtract are currently ignored}
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipDirectoryFileFooter.SaveToStream( Stream : TStream;
|
|
aZip64TailOffset: Int64 = -1);
|
|
{write end of central directory record, along with Zip64 records if necessary.
|
|
aZip64TailOffset is the value to use for the Zip64 locator's directory
|
|
offset, and is only necessary when writing to an intermediate stream}
|
|
var
|
|
Footer: TAbZipEndOfCentralDirectoryRecord;
|
|
Zip64Footer: TAbZip64EndOfCentralDirectoryRecord;
|
|
Zip64Locator: TAbZip64EndOfCentralDirectoryLocator;
|
|
begin
|
|
if IsZip64 then begin
|
|
{setup Zip64 end of central directory record}
|
|
Zip64Footer.Signature := Ab_Zip64EndCentralDirectorySignature;
|
|
Zip64Footer.RecordSize := SizeOf(Zip64Footer) -
|
|
SizeOf(Zip64Footer.Signature) - SizeOf(Zip64Footer.RecordSize);
|
|
Zip64Footer.VersionMadeBy := 45;
|
|
Zip64Footer.VersionNeededToExtract := 45;
|
|
Zip64Footer.DiskNumber := DiskNumber;
|
|
Zip64Footer.StartDiskNumber := StartDiskNumber;
|
|
Zip64Footer.EntriesOnDisk := EntriesOnDisk;
|
|
Zip64Footer.TotalEntries := TotalEntries;
|
|
Zip64Footer.DirectorySize := DirectorySize;
|
|
Zip64Footer.DirectoryOffset := DirectoryOffset;
|
|
{setup Zip64 end of central directory locator}
|
|
Zip64Locator.Signature := Ab_Zip64EndCentralDirectoryLocatorSignature;
|
|
Zip64Locator.StartDiskNumber := DiskNumber;
|
|
if aZip64TailOffset = -1 then
|
|
Zip64Locator.RelativeOffset := Stream.Position
|
|
else
|
|
Zip64Locator.RelativeOffset := aZip64TailOffset;
|
|
Zip64Locator.TotalDisks := DiskNumber + 1;
|
|
{write Zip64 records}
|
|
Stream.WriteBuffer(Zip64Footer, SizeOf(Zip64Footer));
|
|
Stream.WriteBuffer(Zip64Locator, SizeOf(Zip64Locator));
|
|
end;
|
|
Footer.Signature := Ab_ZipEndCentralDirectorySignature;
|
|
Footer.DiskNumber := Min(FDiskNumber, $FFFF);
|
|
Footer.StartDiskNumber := Min(FStartDiskNumber, $FFFF);
|
|
Footer.EntriesOnDisk := Min(FEntriesOnDisk, $FFFF);
|
|
Footer.TotalEntries := Min(FTotalEntries, $FFFF);
|
|
Footer.DirectorySize := Min(FDirectorySize, $FFFFFFFF);
|
|
Footer.DirectoryOffset := Min(FDirectoryOffset, $FFFFFFFF);
|
|
Footer.CommentLength := Length( FZipfileComment );
|
|
Stream.WriteBuffer( Footer, SizeOf(Footer) );
|
|
if FZipfileComment <> '' then
|
|
Stream.Write( FZipfileComment[1], Length(FZipfileComment) );
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
|
|
{ TAbZipItem implementation ================================================ }
|
|
constructor TAbZipItem.Create;
|
|
begin
|
|
inherited Create;
|
|
FItemInfo := TAbZipDirectoryFileHeader.Create;
|
|
FLFHExtraField := TAbExtraField.Create;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
destructor TAbZipItem.Destroy;
|
|
begin
|
|
FLFHExtraField.Free;
|
|
FItemInfo.Free;
|
|
FItemInfo := nil;
|
|
inherited Destroy;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipItem.GetCompressionMethod : TAbZipCompressionMethod;
|
|
begin
|
|
Result := FItemInfo.CompressionMethod;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipItem.GetCompressionRatio : Double;
|
|
begin
|
|
Result := FItemInfo.CompressionRatio;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipItem.GetCRC32 : Longint;
|
|
begin
|
|
Result := FItemInfo.CRC32;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipItem.GetDeflationOption : TAbZipDeflationOption;
|
|
begin
|
|
Result := FItemInfo.DeflationOption;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipItem.GetDictionarySize : TAbZipDictionarySize;
|
|
begin
|
|
Result := FItemInfo.DictionarySize;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipItem.GetGeneralPurposeBitFlag : Word;
|
|
begin
|
|
Result := FItemInfo.GeneralPurposeBitFlag;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipItem.GetHostOS: TAbZipHostOS;
|
|
begin
|
|
Result := TAbZipHostOS(Hi(VersionMadeBy));
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipItem.GetExternalFileAttributes : LongWord;
|
|
begin
|
|
Result := FItemInfo.ExternalFileAttributes;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipItem.GetExtraField : TAbExtraField;
|
|
begin
|
|
Result := FItemInfo.ExtraField;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipItem.GetFileComment : AnsiString;
|
|
begin
|
|
Result := FItemInfo.FileComment;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipItem.GetInternalFileAttributes : Word;
|
|
begin
|
|
Result := FItemInfo.InternalFileAttributes;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipItem.GetIsDirectory: Boolean;
|
|
begin
|
|
Result := ((ExternalFileAttributes and faDirectory) <> 0) or
|
|
((FileName <> '') and CharInSet(Filename[Length(FFilename)], ['\','/']));
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipItem.GetIsEncrypted : Boolean;
|
|
begin
|
|
Result := FItemInfo.IsEncrypted;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipItem.GetLastModFileDate : Word;
|
|
begin
|
|
Result := FItemInfo.LastModFileDate;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipItem.GetLastModFileTime : Word;
|
|
begin
|
|
Result := FItemInfo.LastModFileTime;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipItem.GetNativeFileAttributes : LongInt;
|
|
begin
|
|
{$IFDEF MSWINDOWS}
|
|
if (HostOS = hosUnix) or (ExternalFileAttributes > $1FFFF) then
|
|
Result := AbUnix2DosFileAttributes(ExternalFileAttributes shr 16)
|
|
else
|
|
Result := Byte(ExternalFileAttributes);
|
|
{$ENDIF}
|
|
{$IFDEF UNIX}
|
|
if HostOS in [hosDOS, hosNTFS, hosWinNT] then
|
|
Result := AbDOS2UnixFileAttributes(ExternalFileAttributes)
|
|
else
|
|
Result := ExternalFileAttributes shr 16;
|
|
{$ENDIF}
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipItem.GetRawFileName : AnsiString;
|
|
begin
|
|
Result := FItemInfo.FileName;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipItem.GetShannonFanoTreeCount : Byte;
|
|
begin
|
|
Result := FItemInfo.ShannonFanoTreeCount;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipItem.GetVersionMadeBy : Word;
|
|
begin
|
|
Result := FItemInfo.VersionMadeBy;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipItem.GetVersionNeededToExtract : Word;
|
|
begin
|
|
Result := FItemInfo.VersionNeededToExtract;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipItem.LoadFromStream( Stream : TStream );
|
|
var
|
|
FieldSize: Word;
|
|
FieldStream: TStream;
|
|
InfoZipField: PInfoZipUnicodePathRec;
|
|
UnicodeName: UnicodeString;
|
|
UTF8Name: AnsiString;
|
|
XceedField: PXceedUnicodePathRec;
|
|
begin
|
|
FItemInfo.LoadFromStream( Stream );
|
|
|
|
{ decode filename (ANSI/OEM/UTF-8) }
|
|
if FItemInfo.IsUTF8 or (AbDetectCharSet(FItemInfo.FileName) = csUTF8) then
|
|
FFileName := UTF8ToString(FItemInfo.FileName)
|
|
else if FItemInfo.ExtraField.Get(Ab_InfoZipUnicodePathSubfieldID, Pointer(InfoZipField), FieldSize) and
|
|
(FieldSize > SizeOf(TInfoZipUnicodePathRec)) and
|
|
(InfoZipField.Version = 1) and
|
|
(InfoZipField.NameCRC32 = AbCRC32Of(FItemInfo.FileName)) then begin
|
|
SetString(UTF8Name, InfoZipField.UnicodeName,
|
|
FieldSize - SizeOf(TInfoZipUnicodePathRec) + 1);
|
|
FFileName := UTF8ToString(UTF8Name);
|
|
end
|
|
else if FItemInfo.ExtraField.Get(Ab_XceedUnicodePathSubfieldID, Pointer(XceedField), FieldSize) and
|
|
(FieldSize > SizeOf(TXceedUnicodePathRec)) and
|
|
(XceedField.Signature = Ab_XceedUnicodePathSignature) and
|
|
(XceedField.Length * SizeOf(WideChar) = FieldSize - SizeOf(TXceedUnicodePathRec) + SizeOf(WideChar)) then begin
|
|
SetString(UnicodeName, XceedField.UnicodeName, XceedField.Length);
|
|
FFileName := string(UnicodeName);
|
|
end
|
|
{$IFDEF MSWINDOWS}
|
|
else if (GetACP <> GetOEMCP) and ((HostOS = hosDOS) or AbIsOEM(FItemInfo.FileName)) then begin
|
|
SetLength(FFileName, Length(FItemInfo.FileName));
|
|
OemToCharBuff(PAnsiChar(FItemInfo.FileName), PChar(FFileName), Length(FFileName));
|
|
end
|
|
{$ENDIF}
|
|
else
|
|
FFileName := string(FItemInfo.FileName);
|
|
|
|
{ read ZIP64 extended header }
|
|
FUncompressedSize := FItemInfo.UncompressedSize;
|
|
FCompressedSize := FItemInfo.CompressedSize;
|
|
FRelativeOffset := FItemInfo.RelativeOffset;
|
|
FDiskNumberStart := FItemInfo.DiskNumberStart;
|
|
if FItemInfo.ExtraField.GetStream(Ab_Zip64SubfieldID, FieldStream) then
|
|
try
|
|
if FItemInfo.UncompressedSize = $FFFFFFFF then
|
|
FieldStream.ReadBuffer(FUncompressedSize, SizeOf(Int64));
|
|
if FItemInfo.CompressedSize = $FFFFFFFF then
|
|
FieldStream.ReadBuffer(FCompressedSize, SizeOf(Int64));
|
|
if FItemInfo.RelativeOffset = $FFFFFFFF then
|
|
FieldStream.ReadBuffer(FRelativeOffset, SizeOf(Int64));
|
|
if FItemInfo.DiskNumberStart = $FFFF then
|
|
FieldStream.ReadBuffer(FDiskNumberStart, SizeOf(LongWord));
|
|
finally
|
|
FieldStream.Free;
|
|
end;
|
|
|
|
LastModFileTime := FItemInfo.LastModFileTime;
|
|
LastModFileDate := FItemInfo.LastModFileDate;
|
|
FDiskFileName := FileName;
|
|
AbUnfixName( FDiskFileName );
|
|
Action := aaNone;
|
|
Tagged := False;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipItem.SaveLFHToStream( Stream : TStream );
|
|
var
|
|
LFH : TAbZipLocalFileHeader;
|
|
Zip64Field: TZip64LocalHeaderRec;
|
|
begin
|
|
LFH := TAbZipLocalFileHeader.Create;
|
|
try
|
|
LFH.VersionNeededToExtract := VersionNeededToExtract;
|
|
LFH.GeneralPurposeBitFlag := GeneralPurposeBitFlag;
|
|
LFH.CompressionMethod := CompressionMethod;
|
|
LFH.LastModFileTime := LastModFileTime;
|
|
LFH.LastModFileDate := LastModFileDate;
|
|
LFH.CRC32 := CRC32;
|
|
LFH.FileName := RawFileName;
|
|
LFH.ExtraField.Assign(LFHExtraField);
|
|
LFH.ExtraField.CloneFrom(ExtraField, Ab_InfoZipUnicodePathSubfieldID);
|
|
LFH.ExtraField.CloneFrom(ExtraField, Ab_XceedUnicodePathSubfieldID);
|
|
{ setup sizes; unlike the central directory header, the ZIP64 local header
|
|
needs to store both compressed and uncompressed sizes if either needs it }
|
|
if (CompressedSize >= $FFFFFFFF) or (UncompressedSize >= $FFFFFFFF) then begin
|
|
LFH.UncompressedSize := $FFFFFFFF;
|
|
LFH.CompressedSize := $FFFFFFFF;
|
|
Zip64Field.UncompressedSize := UncompressedSize;
|
|
Zip64Field.CompressedSize := CompressedSize;
|
|
LFH.ExtraField.Put(Ab_Zip64SubfieldID, Zip64Field, SizeOf(Zip64Field));
|
|
end
|
|
else begin
|
|
LFH.UncompressedSize := UncompressedSize;
|
|
LFH.CompressedSize := CompressedSize;
|
|
LFH.ExtraField.Delete(Ab_Zip64SubfieldID);
|
|
end;
|
|
LFH.SaveToStream( Stream );
|
|
finally
|
|
LFH.Free;
|
|
end;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipItem.SaveCDHToStream( Stream : TStream );
|
|
{-Save a ZipCentralDirectorHeader entry to Stream}
|
|
begin
|
|
FItemInfo.SaveToStream( Stream );
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipItem.SaveDDToStream( Stream : TStream );
|
|
var
|
|
DD : TAbZipDataDescriptor;
|
|
begin
|
|
DD := TAbZipDataDescriptor.Create;
|
|
try
|
|
DD.CRC32 := CRC32;
|
|
DD.CompressedSize := CompressedSize;
|
|
DD.UncompressedSize := UncompressedSize;
|
|
DD.SaveToStream( Stream );
|
|
finally
|
|
DD.Free;
|
|
end;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipItem.SetCompressedSize( const Value : Int64 );
|
|
begin
|
|
FCompressedSize := Value;
|
|
FItemInfo.CompressedSize := Min(Value, $FFFFFFFF);
|
|
UpdateZip64ExtraHeader;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipItem.SetCompressionMethod( Value : TAbZipCompressionMethod );
|
|
begin
|
|
FItemInfo.CompressionMethod := Value;
|
|
UpdateVersionNeededToExtract;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipItem.SetCRC32( const Value : Longint );
|
|
begin
|
|
FItemInfo.CRC32 := Value;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipItem.SetDiskNumberStart( Value : LongWord );
|
|
begin
|
|
FDiskNumberStart := Value;
|
|
FItemInfo.DiskNumberStart := Min(Value, $FFFF);
|
|
UpdateZip64ExtraHeader;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipItem.SetExternalFileAttributes( Value : LongWord );
|
|
begin
|
|
FItemInfo.ExternalFileAttributes := Value;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipItem.SetFileComment(const Value : AnsiString );
|
|
begin
|
|
FItemInfo.FileComment := Value;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
{$IFDEF KYLIX}{$IFOPT O+}{$DEFINE OPTIMIZATIONS_ON}{$O-}{$ENDIF}{$ENDIF}
|
|
procedure TAbZipItem.SetFileName(const Value : string );
|
|
var
|
|
{$IFDEF MSWINDOWS}
|
|
AnsiName : AnsiString;
|
|
{$ENDIF}
|
|
UTF8Name : AnsiString;
|
|
FieldSize : Word;
|
|
I : Integer;
|
|
InfoZipField : PInfoZipUnicodePathRec;
|
|
UseExtraField: Boolean;
|
|
begin
|
|
inherited SetFileName(Value);
|
|
{$IFDEF MSWINDOWS}
|
|
FItemInfo.IsUTF8 := False;
|
|
HostOS := hosDOS;
|
|
if AbTryEncode(Value, CP_OEMCP, False, AnsiName) then
|
|
{no-op}
|
|
else if (GetACP <> GetOEMCP) and AbTryEncode(Value, CP_ACP, False, AnsiName) then
|
|
HostOS := hosWinNT
|
|
else if AbTryEncode(Value, CP_OEMCP, True, AnsiName) then
|
|
{no-op}
|
|
else if (GetACP <> GetOEMCP) and AbTryEncode(Value, CP_ACP, True, AnsiName) then
|
|
HostOS := hosWinNT
|
|
else
|
|
FItemInfo.IsUTF8 := True;
|
|
if FItemInfo.IsUTF8 then
|
|
FItemInfo.FileName := Utf8Encode(Value)
|
|
else
|
|
FItemInfo.FileName := AnsiName;
|
|
{$ENDIF}
|
|
{$IFDEF UNIX}
|
|
FItemInfo.FileName := AnsiString(Value);
|
|
FItemInfo.IsUTF8 := AbSysCharSetIsUTF8;
|
|
{$ENDIF}
|
|
|
|
UseExtraField := False;
|
|
if not FItemInfo.IsUTF8 then
|
|
for i := 1 to Length(Value) do begin
|
|
if Ord(Value[i]) > 127 then begin
|
|
UseExtraField := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
if UseExtraField then begin
|
|
UTF8Name := AnsiToUTF8(Value);
|
|
FieldSize := SizeOf(TInfoZipUnicodePathRec) + Length(UTF8Name) - 1;
|
|
GetMem(InfoZipField, FieldSize);
|
|
try
|
|
InfoZipField.Version := 1;
|
|
InfoZipField.NameCRC32 := AbCRC32Of(FItemInfo.FileName);
|
|
Move(UTF8Name[1], InfoZipField.UnicodeName, Length(UTF8Name));
|
|
FItemInfo.ExtraField.Put(Ab_InfoZipUnicodePathSubfieldID, InfoZipField^, FieldSize);
|
|
finally
|
|
FreeMem(InfoZipField);
|
|
end;
|
|
end
|
|
else
|
|
FItemInfo.ExtraField.Delete(Ab_InfoZipUnicodePathSubfieldID);
|
|
FItemInfo.ExtraField.Delete(Ab_XceedUnicodePathSubfieldID);
|
|
end;
|
|
{$IFDEF OPTIMIZATIONS_ON}{$O+}{$ENDIF}
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipItem.SetGeneralPurposeBitFlag( Value : Word );
|
|
begin
|
|
FItemInfo.GeneralPurposeBitFlag := Value;
|
|
UpdateVersionNeededToExtract;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipItem.SetHostOS( Value : TAbZipHostOS );
|
|
begin
|
|
FItemInfo.VersionMadeBy := Low(FItemInfo.VersionMadeBy) or
|
|
Word(Ord(Value)) shl 8;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipItem.SetInternalFileAttributes( Value : Word );
|
|
begin
|
|
FItemInfo.InternalFileAttributes := Value;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipItem.SetLastModFileDate( const Value : Word );
|
|
begin
|
|
FItemInfo.LastModFileDate := Value;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipItem.SetLastModFileTime( const Value : Word );
|
|
begin
|
|
FItemInfo.LastModFileTime := Value;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipItem.SetRelativeOffset( Value : Int64 );
|
|
begin
|
|
FRelativeOffset := Value;
|
|
FItemInfo.RelativeOffset := Min(Value, $FFFFFFFF);
|
|
UpdateZip64ExtraHeader;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipItem.SetUncompressedSize( const Value : Int64 );
|
|
begin
|
|
FUncompressedSize := Value;
|
|
FItemInfo.UncompressedSize:= Min(Value, $FFFFFFFF);
|
|
UpdateZip64ExtraHeader;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipItem.SetVersionMadeBy( Value : Word );
|
|
begin
|
|
FItemInfo.VersionMadeBy := Value;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipItem.SetVersionNeededToExtract( Value : Word );
|
|
begin
|
|
FItemInfo.VersionNeededToExtract := Value;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipItem.UpdateVersionNeededToExtract;
|
|
{calculates VersionNeededToExtract and VersionMadeBy based on used features}
|
|
begin
|
|
{According to AppNote.txt zipx compression methods should set the Version
|
|
Needed To Extract to the AppNote version the method was introduced in (e.g.,
|
|
6.3 for PPMd). Most utilities just set it to 2.0 and rely on the extractor
|
|
detecting unsupported compression methods, since it's easier to add support
|
|
for decompression methods without implementing the entire newer spec. }
|
|
if ExtraField.Has(Ab_Zip64SubfieldID) then
|
|
VersionNeededToExtract := 45
|
|
else if IsDirectory or IsEncrypted or not (CompressionMethod in [cmStored..cmImploded]) then
|
|
VersionNeededToExtract := 20
|
|
else
|
|
VersionNeededToExtract := 10;
|
|
VersionMadeBy := (VersionMadeBy and $FF00) + Max(20, VersionNeededToExtract);
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipItem.UpdateZip64ExtraHeader;
|
|
var
|
|
Changed: Boolean;
|
|
FieldStream: TMemoryStream;
|
|
begin
|
|
FieldStream := TMemoryStream.Create;
|
|
try
|
|
if UncompressedSize >= $FFFFFFFF then
|
|
FieldStream.WriteBuffer(FUncompressedSize, SizeOf(Int64));
|
|
if CompressedSize >= $FFFFFFFF then
|
|
FieldStream.WriteBuffer(FCompressedSize, SizeOf(Int64));
|
|
if RelativeOffset >= $FFFFFFFF then
|
|
FieldStream.WriteBuffer(FRelativeOffset, SizeOf(Int64));
|
|
if DiskNumberStart >= $FFFF then
|
|
FieldStream.WriteBuffer(FDiskNumberStart, SizeOf(LongWord));
|
|
Changed := (FieldStream.Size > 0) <> ExtraField.Has(Ab_Zip64SubfieldID);
|
|
if FieldStream.Size > 0 then
|
|
ExtraField.Put(Ab_Zip64SubfieldID, FieldStream.Memory^, FieldStream.Size)
|
|
else
|
|
ExtraField.Delete(Ab_Zip64SubfieldID);
|
|
if Changed then
|
|
UpdateVersionNeededToExtract;
|
|
finally
|
|
FieldStream.Free;
|
|
end;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
|
|
|
|
{ TAbZipArchive implementation ============================================= }
|
|
constructor TAbZipArchive.CreateFromStream( aStream : TStream;
|
|
const ArchiveName : string );
|
|
begin
|
|
inherited CreateFromStream( aStream, ArchiveName );
|
|
FCompressionMethodToUse := smBestMethod;
|
|
FInfo := TAbZipDirectoryFileFooter.Create;
|
|
StoreOptions := StoreOptions + [soStripDrive];
|
|
FDeflationOption := doNormal;
|
|
FPasswordRetries := AbDefPasswordRetries;
|
|
FTempDir := '';
|
|
SpanningThreshold := AbDefZipSpanningThreshold;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
destructor TAbZipArchive.Destroy;
|
|
begin
|
|
FInfo.Free;
|
|
FInfo := nil;
|
|
inherited Destroy;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipArchive.CreateItem( const FileName : string ): TAbArchiveItem;
|
|
var
|
|
FileSpec : string;
|
|
begin
|
|
FileSpec := FileName;
|
|
Result := TAbZipItem.Create;
|
|
with TAbZipItem( Result ) do begin
|
|
CompressionMethod := cmDeflated;
|
|
GeneralPurposeBitFlag := 0;
|
|
CompressedSize := 0;
|
|
CRC32 := 0;
|
|
DiskFileName := ExpandFileName(FileSpec);
|
|
FileName := FixName(FileSpec);
|
|
RelativeOffset := 0;
|
|
end;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipArchive.DoExtractHelper(Index : Integer; const NewName : string);
|
|
begin
|
|
if Assigned(FExtractHelper) then
|
|
FExtractHelper(Self, ItemList[Index], NewName)
|
|
else
|
|
raise EAbZipNoExtraction.Create;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipArchive.DoExtractToStreamHelper(Index : Integer;
|
|
aStream : TStream);
|
|
begin
|
|
if Assigned(FExtractToStreamHelper) then
|
|
FExtractToStreamHelper(Self, ItemList[Index], aStream)
|
|
else
|
|
raise EAbZipNoExtraction.Create;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipArchive.DoTestHelper(Index : Integer);
|
|
begin
|
|
if Assigned(FTestHelper) then
|
|
FTestHelper(Self, ItemList[Index])
|
|
else
|
|
raise EAbZipNoExtraction.Create;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipArchive.DoInsertHelper(Index : Integer; OutStream : TStream);
|
|
begin
|
|
if Assigned(FInsertHelper) then
|
|
FInsertHelper(Self, ItemList[Index], OutStream)
|
|
else
|
|
raise EAbZipNoInsertion.Create;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipArchive.DoInsertFromStreamHelper(Index : Integer;
|
|
OutStream : TStream);
|
|
begin
|
|
if Assigned(FInsertFromStreamHelper) then
|
|
FInsertFromStreamHelper(Self, ItemList[Index], OutStream, InStream)
|
|
else
|
|
raise EAbZipNoInsertion.Create;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipArchive.DoRequestDisk(const AMessage: string; var Abort : Boolean);
|
|
begin
|
|
{$IFDEF MSWINDOWS}
|
|
Abort := Windows.MessageBox( 0, PChar(AMessage), PChar(AbDiskRequestS),
|
|
MB_TASKMODAL or MB_OKCANCEL ) = IDCANCEL;
|
|
{$ENDIF}
|
|
{$IFDEF UnixDialogs}
|
|
{$IFDEF KYLIX}
|
|
Abort := QDialogs.MessageDlg(AbDiskRequestS, AMessage, mtWarning,
|
|
mbOKCancel, 0) = mrCancel;
|
|
{$ENDIF}
|
|
{$IFDEF LCL}
|
|
Abort := Dialogs.MessageDlg(AbDiskRequestS, AMessage, mtWarning, mbOKCancel,
|
|
0) = mrCancel;
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
Abort := True;
|
|
{$ENDIF}
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipArchive.DoRequestLastDisk( var Abort : Boolean );
|
|
begin
|
|
Abort := False;
|
|
if Assigned( FOnRequestLastDisk ) then
|
|
FOnRequestLastDisk( Self, Abort )
|
|
else
|
|
DoRequestDisk( AbLastDiskRequestS, Abort );
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipArchive.DoRequestNthDisk( Sender: TObject;
|
|
DiskNumber : Byte;
|
|
var Abort : Boolean );
|
|
begin
|
|
Abort := False;
|
|
if Assigned( FOnRequestNthDisk ) then
|
|
FOnRequestNthDisk( Self, DiskNumber, Abort )
|
|
else
|
|
DoRequestDisk( Format(AbDiskNumRequestS, [DiskNumber]), Abort );
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipArchive.DoRequestBlankDisk(Sender: TObject; var Abort : Boolean );
|
|
begin
|
|
Abort := False;
|
|
FSpanned := True;
|
|
|
|
if Assigned( FOnRequestBlankDisk ) then
|
|
FOnRequestBlankDisk( Self, Abort )
|
|
else
|
|
DoRequestDisk( AbBlankDiskS, Abort );
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipArchive.DoRequestImage(Sender: TObject; ImageNumber : Integer;
|
|
var ImageName : string ; var Abort : Boolean);
|
|
begin
|
|
if Assigned(FOnRequestImage) then
|
|
FOnRequestImage(Self, ImageNumber, ImageName, Abort);
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipArchive.ExtractItemAt(Index : Integer; const UseName : string);
|
|
begin
|
|
DoExtractHelper(Index, UseName);
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipArchive.ExtractItemToStreamAt(Index : Integer;
|
|
aStream : TStream);
|
|
begin
|
|
DoExtractToStreamHelper(Index, aStream);
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipArchive.FixName(const Value : string ) : string;
|
|
{-changes backslashes to forward slashes}
|
|
var
|
|
i : SmallInt;
|
|
lValue : string;
|
|
begin
|
|
lValue := Value;
|
|
{$IFDEF MSWINDOWS}
|
|
if DOSMode then begin
|
|
{Add the base directory to the filename before converting }
|
|
{the file spec to the short filespec format. }
|
|
if BaseDirectory <> '' then begin
|
|
{Does the filename contain a drive or a leading backslash? }
|
|
if not ((Pos(':', lValue) = 2) or (Pos(AbPathDelim, lValue) = 1)) then
|
|
{If not, add the BaseDirectory to the filename.}
|
|
lValue := AbAddBackSlash(BaseDirectory) + lValue;
|
|
end;
|
|
lValue := AbGetShortFileSpec( lValue );
|
|
end;
|
|
{$ENDIF MSWINDOWS}
|
|
|
|
{Zip files Always strip the drive path}
|
|
StoreOptions := StoreOptions + [soStripDrive];
|
|
|
|
{strip drive stuff}
|
|
if soStripDrive in StoreOptions then
|
|
AbStripDrive( lValue );
|
|
|
|
{check for a leading backslash}
|
|
if (Length(lValue) > 1) and (lValue[1] = AbPathDelim) then
|
|
System.Delete( lValue, 1, 1 );
|
|
|
|
if soStripPath in StoreOptions then begin
|
|
lValue := ExtractFileName( lValue );
|
|
end;
|
|
|
|
if soRemoveDots in StoreOptions then
|
|
AbStripDots( lValue );
|
|
|
|
for i := 1 to Length( lValue ) do
|
|
if lValue[i] = '\' then
|
|
lValue[i] := '/';
|
|
Result := lValue;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipArchive.GetItem( Index : Integer ) : TAbZipItem;
|
|
begin
|
|
Result := TAbZipItem(FItemList.Items[Index]);
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipArchive.GetSupportsEmptyFolders: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbZipArchive.GetZipfileComment : AnsiString;
|
|
begin
|
|
Result := FInfo.ZipfileComment;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipArchive.LoadArchive;
|
|
var
|
|
Abort : Boolean;
|
|
TailPosition : int64;
|
|
Item : TAbZipItem;
|
|
Progress : Byte;
|
|
FileSignature : Longint;
|
|
Zip64Locator : TAbZip64EndOfCentralDirectoryLocator;
|
|
begin
|
|
Abort := False;
|
|
if FStream.Size = 0 then
|
|
Exit;
|
|
|
|
{Get signature info}
|
|
FStream.Position := 0;
|
|
FStream.Read( FileSignature, sizeof( FileSignature ) );
|
|
|
|
{Get Executable Type; allow non-native stubs}
|
|
IsExecutable :=
|
|
(LongRec(FileSignature).Lo = Ab_WindowsExeSignature) or
|
|
(FileSignature = Ab_LinuxExeSignature);
|
|
|
|
{ try to locate central directory tail }
|
|
TailPosition := FindCentralDirectoryTail( FStream );
|
|
if (TailPosition = -1) and (FileSignature = Ab_ZipSpannedSetSignature) and
|
|
FOwnsStream and AbDriveIsRemovable(ArchiveName) then begin
|
|
while TailPosition = -1 do begin
|
|
FreeAndNil(FStream);
|
|
DoRequestLastDisk(Abort);
|
|
if Abort then begin
|
|
FStatus := asInvalid; //TODO: Status updates are extremely inconsistent
|
|
raise EAbUserAbort.Create;
|
|
end;
|
|
FStream := TFileStream.Create( ArchiveName, Mode );
|
|
TailPosition := FindCentralDirectoryTail( FStream );
|
|
end;
|
|
end;
|
|
|
|
if TailPosition = -1 then begin
|
|
FStatus := asInvalid;
|
|
raise EAbZipInvalid.Create;
|
|
end;
|
|
|
|
{ load the ZipDirectoryFileFooter }
|
|
FInfo.LoadFromStream(FStream);
|
|
|
|
{ find Zip64 end of central directory locator; it will usually occur
|
|
immediately before the standard end of central directory record.
|
|
the actual Zip64 end of central directory may be on another disk }
|
|
if FInfo.IsZip64 then begin
|
|
Dec(TailPosition, SizeOf(Zip64Locator));
|
|
repeat
|
|
if TailPosition < 0 then
|
|
raise EAbZipInvalid.Create;
|
|
FStream.Position := TailPosition;
|
|
FStream.ReadBuffer(Zip64Locator, SizeOf(Zip64Locator));
|
|
Dec(TailPosition);
|
|
until Zip64Locator.Signature = Ab_Zip64EndCentralDirectoryLocatorSignature;
|
|
{ update current image number }
|
|
FInfo.DiskNumber := Zip64Locator.TotalDisks - 1;
|
|
end;
|
|
|
|
{ setup spanning support and move to the start of the central directory }
|
|
FSpanned := FInfo.DiskNumber > 0;
|
|
|
|
if FSpanned then begin
|
|
if FOwnsStream then begin
|
|
FStream := TAbSpanReadStream.Create( ArchiveName, FInfo.DiskNumber, FStream );
|
|
TAbSpanReadStream(FStream).OnRequestImage := DoRequestImage;
|
|
TAbSpanReadStream(FStream).OnRequestNthDisk := DoRequestNthDisk;
|
|
if FInfo.IsZip64 then begin
|
|
TAbSpanReadStream(FStream).SeekImage(Zip64Locator.StartDiskNumber,
|
|
Zip64Locator.RelativeOffset);
|
|
FInfo.LoadZip64FromStream(FStream);
|
|
end;
|
|
TAbSpanReadStream(FStream).SeekImage(FInfo.StartDiskNumber, FInfo.DirectoryOffset);
|
|
end
|
|
else
|
|
raise EAbZipBadSpanStream.Create;
|
|
end
|
|
else begin
|
|
if FInfo.IsZip64 then begin
|
|
FStream.Position := Zip64Locator.RelativeOffset;
|
|
FInfo.LoadZip64FromStream(FStream);
|
|
end;
|
|
FStream.Position := FInfo.DirectoryOffset;
|
|
end;
|
|
|
|
{ build Items list from central directory records }
|
|
FStubSize := High(LongWord);
|
|
while Count < FInfo.TotalEntries do begin
|
|
{ create new Item }
|
|
Item := TAbZipItem.Create;
|
|
try
|
|
Item.LoadFromStream(FStream);
|
|
Item.Action := aaNone;
|
|
FItemList.Add(Item);
|
|
except
|
|
Item.Free;
|
|
raise;
|
|
end;
|
|
|
|
if IsExecutable and (Item.DiskNumberStart = 0) and
|
|
(Item.RelativeOffset < FStubSize) then
|
|
FStubSize := Item.RelativeOffset;
|
|
|
|
Progress := (Count * 100) div FInfo.TotalEntries;
|
|
DoArchiveProgress( Progress, Abort );
|
|
if Abort then begin
|
|
FStatus := asInvalid;
|
|
raise EAbUserAbort.Create;
|
|
end;
|
|
end;
|
|
|
|
DoArchiveProgress(100, Abort);
|
|
FIsDirty := False;
|
|
end;
|
|
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipArchive.PutItem( Index : Integer; Value : TAbZipItem );
|
|
begin
|
|
FItemList.Items[Index] := Value;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipArchive.SaveArchive;
|
|
{builds a new archive and copies it to FStream}
|
|
var
|
|
Abort : Boolean;
|
|
MemStream : TMemoryStream;
|
|
HasDataDescriptor : Boolean;
|
|
i : LongWord;
|
|
LFH : TAbZipLocalFileHeader;
|
|
NewStream : TStream;
|
|
WorkingStream : TAbVirtualMemoryStream;
|
|
CurrItem : TAbZipItem;
|
|
Progress : Byte;
|
|
begin
|
|
if Count = 0 then
|
|
Exit;
|
|
|
|
{shouldn't be trying to overwrite an existing spanned archive}
|
|
if Spanned then begin
|
|
for i := 0 to Pred(Count) do
|
|
if ItemList[i].Action <> aaFailed then
|
|
ItemList[i].Action := aaNone;
|
|
FIsDirty := False;
|
|
raise EAbZipSpanOverwrite.Create;
|
|
end;
|
|
|
|
{init new zip archive stream
|
|
can span only new archives, if SpanningThreshold > 0 or removable drive
|
|
spanning writes to original location, rather than writing to a temp stream first}
|
|
if FOwnsStream and (FStream.Size = 0) and not IsExecutable and
|
|
((SpanningThreshold > 0) or AbDriveIsRemovable(ArchiveName)) then begin
|
|
NewStream := TAbSpanWriteStream.Create(ArchiveName, FStream, SpanningThreshold);
|
|
FStream := nil;
|
|
TAbSpanWriteStream(NewStream).OnRequestBlankDisk := DoRequestBlankDisk;
|
|
TAbSpanWriteStream(NewStream).OnRequestImage := DoRequestImage;
|
|
end
|
|
else begin
|
|
NewStream := TAbVirtualMemoryStream.Create;
|
|
TAbVirtualMemoryStream(NewStream).SwapFileDirectory := FTempDir;
|
|
end;
|
|
|
|
try {NewStream}
|
|
{copy the executable stub over to the output}
|
|
if IsExecutable then
|
|
NewStream.CopyFrom( FStream, StubSize )
|
|
{assume spanned for spanning stream}
|
|
else if NewStream is TAbSpanWriteStream then
|
|
NewStream.Write(Ab_ZipSpannedSetSignature,
|
|
SizeOf(Ab_ZipSpannedSetSignature));
|
|
|
|
{build new zip archive from existing archive}
|
|
for i := 0 to pred( Count ) do begin
|
|
CurrItem := (ItemList[i] as TAbZipItem);
|
|
FCurrentItem := ItemList[i];
|
|
|
|
case CurrItem.Action of
|
|
aaNone, aaMove: begin
|
|
{just copy the file to new stream}
|
|
Assert(not (NewStream is TAbSpanWriteStream));
|
|
FStream.Position := CurrItem.RelativeOffset;
|
|
CurrItem.DiskNumberStart := 0;
|
|
CurrItem.RelativeOffset := NewStream.Position;
|
|
{toss old local file header}
|
|
LFH := TAbZipLocalFileHeader.Create;
|
|
try {LFH}
|
|
LFH.LoadFromStream( FStream );
|
|
if CurrItem.LFHExtraField.Count = 0 then
|
|
CurrItem.LFHExtraField.Assign(LFH.ExtraField);
|
|
finally {LFH}
|
|
LFH.Free;
|
|
end; {LFH}
|
|
{write out new local file header and append compressed data}
|
|
|
|
CurrItem.SaveLFHToStream( NewStream );
|
|
if (CurrItem.CompressedSize > 0) then
|
|
NewStream.CopyFrom(FStream, CurrItem.CompressedSize);
|
|
end;
|
|
|
|
aaDelete: begin
|
|
{doing nothing omits file from new stream}
|
|
end;
|
|
|
|
aaAdd, aaFreshen, aaReplace, aaStreamAdd: begin
|
|
{compress the file and add it to new stream}
|
|
try
|
|
WorkingStream := TAbVirtualMemoryStream.Create;
|
|
try {WorkingStream}
|
|
WorkingStream.SwapFileDirectory := FTempDir;
|
|
{compress the file}
|
|
if (CurrItem.Action = aaStreamAdd) then
|
|
DoInsertFromStreamHelper(i, WorkingStream)
|
|
else
|
|
DoInsertHelper(i, WorkingStream);
|
|
{write local header}
|
|
if NewStream is TAbSpanWriteStream then begin
|
|
MemStream := TMemoryStream.Create;
|
|
try
|
|
CurrItem.SaveLFHToStream(MemStream);
|
|
TAbSpanWriteStream(NewStream).WriteUnspanned(
|
|
MemStream.Memory^, MemStream.Size);
|
|
{calculate positions after the write in case it triggered a new span}
|
|
CurrItem.DiskNumberStart := TAbSpanWriteStream(NewStream).CurrentImage;
|
|
CurrItem.RelativeOffset := NewStream.Position - MemStream.Size;
|
|
finally
|
|
MemStream.Free;
|
|
end;
|
|
end
|
|
else begin
|
|
CurrItem.DiskNumberStart := 0;
|
|
CurrItem.RelativeOffset := NewStream.Position;
|
|
CurrItem.SaveLFHToStream(NewStream);
|
|
end;
|
|
{copy compressed data}
|
|
NewStream.CopyFrom(WorkingStream, 0);
|
|
if CurrItem.IsEncrypted then
|
|
CurrItem.SaveDDToStream(NewStream);
|
|
finally
|
|
WorkingStream.Free;
|
|
end;
|
|
except
|
|
on E : Exception do
|
|
begin
|
|
{ Exception was caused by a User Abort and Item Failure should not be called
|
|
Question: Do we want an New Event when this occurs or should the
|
|
exception just be re-raised [783614] }
|
|
if (E is EAbUserAbort) then
|
|
raise;
|
|
CurrItem.Action := aaDelete;
|
|
DoProcessItemFailure(CurrItem, ptAdd, ecFileOpenError, 0);
|
|
end;
|
|
end;
|
|
end;
|
|
end; { case }
|
|
|
|
{ TODO: Check HasDataDescriptior behavior; seems like it's getting
|
|
written twice for encrypted files }
|
|
{Now add the data descriptor record to new stream}
|
|
HasDataDescriptor := (CurrItem.CompressionMethod = cmDeflated) and
|
|
((CurrItem.GeneralPurposeBitFlag and AbHasDataDescriptorFlag) <> 0);
|
|
if (CurrItem.Action <> aaDelete) and HasDataDescriptor then
|
|
CurrItem.SaveDDToStream(NewStream);
|
|
Progress := AbPercentage(9 * succ( i ), 10 * Count);
|
|
DoArchiveSaveProgress(Progress, Abort);
|
|
DoArchiveProgress(Progress, Abort);
|
|
if Abort then
|
|
raise EAbUserAbort.Create;
|
|
end;
|
|
|
|
{write the central directory}
|
|
if NewStream is TAbSpanWriteStream then
|
|
FInfo.DiskNumber := TAbSpanWriteStream(NewStream).CurrentImage
|
|
else
|
|
FInfo.DiskNumber := 0;
|
|
FInfo.StartDiskNumber := FInfo.DiskNumber;
|
|
FInfo.DirectoryOffset := NewStream.Position;
|
|
FInfo.DirectorySize := 0;
|
|
FInfo.EntriesOnDisk := 0;
|
|
FInfo.TotalEntries := 0;
|
|
MemStream := TMemoryStream.Create;
|
|
try
|
|
{write central directory entries}
|
|
for i := 0 to Count - 1 do begin
|
|
if not (FItemList[i].Action in [aaDelete, aaFailed]) then begin
|
|
(FItemList[i] as TAbZipItem).SaveCDHToStream(MemStream);
|
|
if NewStream is TAbSpanWriteStream then begin
|
|
TAbSpanWriteStream(NewStream).WriteUnspanned(MemStream.Memory^, MemStream.Size);
|
|
{update tail info on span change}
|
|
if FInfo.DiskNumber <> TAbSpanWriteStream(NewStream).CurrentImage then begin
|
|
FInfo.DiskNumber := TAbSpanWriteStream(NewStream).CurrentImage;
|
|
FInfo.EntriesOnDisk := 0;
|
|
if FInfo.TotalEntries = 0 then begin
|
|
FInfo.StartDiskNumber := FInfo.DiskNumber;
|
|
FInfo.DirectoryOffset := NewStream.Position - MemStream.Size;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
NewStream.WriteBuffer(MemStream.Memory^, MemStream.Size);
|
|
FInfo.DirectorySize := FInfo.DirectorySize + MemStream.Size;
|
|
FInfo.EntriesOnDisk := FInfo.EntriesOnDisk + 1;
|
|
FInfo.TotalEntries := FInfo.TotalEntries + 1;
|
|
MemStream.Clear;
|
|
end;
|
|
end;
|
|
{append the central directory footer}
|
|
FInfo.SaveToStream(MemStream, NewStream.Position);
|
|
if NewStream is TAbSpanWriteStream then begin
|
|
{update the footer if writing it would trigger a new span}
|
|
if not TAbSpanWriteStream(NewStream).WriteUnspanned(MemStream.Memory^,
|
|
MemStream.Size) then begin
|
|
FInfo.DiskNumber := TAbSpanWriteStream(NewStream).CurrentImage;
|
|
FInfo.EntriesOnDisk := 0;
|
|
FInfo.SaveToStream(NewStream);
|
|
end;
|
|
end
|
|
else
|
|
NewStream.WriteBuffer(MemStream.Memory^, MemStream.Size);
|
|
finally {MemStream}
|
|
MemStream.Free;
|
|
end; {MemStream}
|
|
|
|
FSpanned := (FInfo.DiskNumber > 0);
|
|
|
|
{update output stream}
|
|
if NewStream is TAbSpanWriteStream then begin
|
|
{zip has already been written to target location}
|
|
FStream := TAbSpanWriteStream(NewStream).ReleaseStream;
|
|
if Spanned then begin
|
|
{switch to read stream}
|
|
FStream := TAbSpanReadStream.Create(ArchiveName, FInfo.DiskNumber, FStream);
|
|
TAbSpanReadStream(FStream).OnRequestImage := DoRequestImage;
|
|
TAbSpanReadStream(FStream).OnRequestNthDisk := DoRequestNthDisk;
|
|
end
|
|
else begin
|
|
{replace spanned signature}
|
|
FStream.Position := 0;
|
|
FStream.Write(Ab_ZipPossiblySpannedSignature,
|
|
SizeOf(Ab_ZipPossiblySpannedSignature));
|
|
end;
|
|
end
|
|
else begin
|
|
{copy new stream to FStream (non-spanned only)}
|
|
NewStream.Position := 0;
|
|
if (FStream is TMemoryStream) then
|
|
TMemoryStream(FStream).LoadFromStream(NewStream)
|
|
else begin
|
|
if FOwnsStream then begin
|
|
{need new stream to write}
|
|
FreeAndNil(FStream);
|
|
FStream := TFileStream.Create(FArchiveName,
|
|
fmOpenReadWrite or fmShareDenyWrite);
|
|
end;
|
|
FStream.Size := 0;
|
|
FStream.Position := 0;
|
|
FStream.CopyFrom(NewStream, 0)
|
|
end;
|
|
end;
|
|
|
|
{update Items list}
|
|
for i := pred( Count ) downto 0 do begin
|
|
if FItemList[i].Action = aaDelete then
|
|
FItemList.Delete( i )
|
|
else if FItemList[i].Action <> aaFailed then
|
|
FItemList[i].Action := aaNone;
|
|
end;
|
|
|
|
DoArchiveSaveProgress( 100, Abort );
|
|
DoArchiveProgress( 100, Abort );
|
|
finally {NewStream}
|
|
NewStream.Free;
|
|
end;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipArchive.SetZipfileComment(const Value : AnsiString );
|
|
begin
|
|
FInfo.FZipfileComment := Value;
|
|
FIsDirty := True;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbZipArchive.TestItemAt(Index : Integer);
|
|
begin
|
|
DoTestHelper(Index);
|
|
end;
|
|
|
|
end.
|
|
|
|
|
|
|
|
|