mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-06 05:52:36 +02:00
3072 lines
93 KiB
ObjectPascal
3072 lines
93 KiB
ObjectPascal
{
|
|
$Id: header,v 1.3 2013/05/26 06:33:45 michael Exp $
|
|
This file is part of the Free Component Library (FCL)
|
|
Copyright (c) 1999-2014 by the Free Pascal development team
|
|
|
|
See the file COPYING.FPC, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
|
**********************************************************************}
|
|
{$mode objfpc}
|
|
{$h+}
|
|
unit opkman_zip;
|
|
{$warnings off}
|
|
{$hints off}
|
|
Interface
|
|
|
|
Uses
|
|
{$IFDEF UNIX}
|
|
BaseUnix,
|
|
{$ENDIF}
|
|
SysUtils,Classes,zstream;
|
|
|
|
|
|
Const
|
|
{ Signatures }
|
|
END_OF_CENTRAL_DIR_SIGNATURE = $06054B50;
|
|
ZIP64_END_OF_CENTRAL_DIR_SIGNATURE = $06064B50;
|
|
ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIGNATURE = $07064B50;
|
|
LOCAL_FILE_HEADER_SIGNATURE = $04034B50;
|
|
CENTRAL_FILE_HEADER_SIGNATURE = $02014B50;
|
|
ZIP64_HEADER_ID = $0001;
|
|
// infozip unicode path
|
|
INFOZIP_UNICODE_PATH_ID = $7075;
|
|
|
|
const
|
|
OS_FAT = 0; //MS-DOS and OS/2 (FAT/VFAT/FAT32)
|
|
OS_UNIX = 3;
|
|
OS_OS2 = 6; //OS/2 HPFS
|
|
OS_NTFS = 10;
|
|
OS_VFAT = 14;
|
|
OS_OSX = 19;
|
|
|
|
UNIX_MASK = $F000;
|
|
UNIX_FIFO = $1000;
|
|
UNIX_CHAR = $2000;
|
|
UNIX_DIR = $4000;
|
|
UNIX_BLK = $6000;
|
|
UNIX_FILE = $8000;
|
|
UNIX_LINK = $A000;
|
|
UNIX_SOCK = $C000;
|
|
|
|
|
|
UNIX_RUSR = $0100;
|
|
UNIX_WUSR = $0080;
|
|
UNIX_XUSR = $0040;
|
|
|
|
UNIX_RGRP = $0020;
|
|
UNIX_WGRP = $0010;
|
|
UNIX_XGRP = $0008;
|
|
|
|
UNIX_ROTH = $0004;
|
|
UNIX_WOTH = $0002;
|
|
UNIX_XOTH = $0001;
|
|
|
|
UNIX_DEFAULT = UNIX_RUSR or UNIX_WUSR or UNIX_XUSR or UNIX_RGRP or UNIX_ROTH;
|
|
|
|
Type
|
|
Local_File_Header_Type = Packed Record //1 per zipped file
|
|
Signature : LongInt; //4 bytes
|
|
Extract_Version_Reqd : Word; //if zip64: >= 45
|
|
Bit_Flag : Word; //"General purpose bit flag in PKZip appnote
|
|
Compress_Method : Word;
|
|
Last_Mod_Time : Word;
|
|
Last_Mod_Date : Word;
|
|
Crc32 : LongWord;
|
|
Compressed_Size : LongWord;
|
|
Uncompressed_Size : LongWord;
|
|
Filename_Length : Word;
|
|
Extra_Field_Length : Word; //refers to Extensible data field size
|
|
end;
|
|
|
|
Extensible_Data_Field_Header_Type = Packed Record
|
|
// Beginning of extra field
|
|
// after local file header
|
|
// after central directory header
|
|
Header_ID : Word;
|
|
//e.g. $0001 (ZIP64_HEADER_ID) Zip64 extended information extra field
|
|
// $0009 OS/2: extended attributes
|
|
// $000a NTFS: (Win32 really)
|
|
// $000d UNIX: uid, gid etc
|
|
Data_Size : Word; //size of following field data
|
|
//... field data should follow...
|
|
end;
|
|
|
|
Zip64_Extended_Info_Field_Type = Packed Record //goes after Extensible_Data_Field_Header_Type
|
|
// overrides Local and Central Directory data
|
|
// stored in extra field
|
|
Original_Size : QWord; //Uncompressed file
|
|
Compressed_Size : QWord; //Compressed data
|
|
Relative_Hdr_Offset : QWord; //Offset that leads to local header record
|
|
Disk_Start_Number : LongWord; //on which disk this file starts
|
|
end;
|
|
|
|
{ Define the Central Directory record types }
|
|
|
|
Central_File_Header_Type = Packed Record
|
|
Signature : LongInt; //4 bytes
|
|
MadeBy_Version : Word; //if zip64: lower byte >= 45
|
|
Extract_Version_Reqd : Word; //if zip64: >=45
|
|
Bit_Flag : Word; //General purpose bit flag in PKZip appnote
|
|
Compress_Method : Word;
|
|
Last_Mod_Time : Word;
|
|
Last_Mod_Date : Word;
|
|
Crc32 : LongWord;
|
|
Compressed_Size : LongWord;
|
|
Uncompressed_Size : LongWord;
|
|
Filename_Length : Word;
|
|
Extra_Field_Length : Word;
|
|
File_Comment_Length : Word;
|
|
Starting_Disk_Num : Word;
|
|
Internal_Attributes : Word;
|
|
External_Attributes : LongWord;
|
|
Local_Header_Offset : LongWord; // if zip64: 0xFFFFFFFF
|
|
End;
|
|
|
|
End_of_Central_Dir_Type = Packed Record //End of central directory record
|
|
//1 per zip file, near end, before comment
|
|
Signature : LongInt; //4 bytes
|
|
Disk_Number : Word;
|
|
Central_Dir_Start_Disk : Word;
|
|
Entries_This_Disk : Word;
|
|
Total_Entries : Word;
|
|
Central_Dir_Size : LongWord;
|
|
Start_Disk_Offset : LongWord;
|
|
ZipFile_Comment_Length : Word;
|
|
end;
|
|
|
|
Zip64_End_of_Central_Dir_type = Packed Record
|
|
Signature : LongInt;
|
|
Record_Size : QWord;
|
|
Version_Made_By : Word; //lower byte >= 45
|
|
Extract_Version_Reqd : Word; //version >= 45
|
|
Disk_Number : LongWord;
|
|
Central_Dir_Start_Disk : LongWord;
|
|
Entries_This_Disk : QWord;
|
|
Total_Entries : QWord;
|
|
Central_Dir_Size : QWord;
|
|
Start_Disk_Offset : QWord;
|
|
end;
|
|
|
|
Zip64_End_of_Central_Dir_Locator_type = Packed Record //comes after Zip64_End_of_Central_Dir_type
|
|
Signature : LongInt;
|
|
Zip64_EOCD_Start_Disk : LongWord; //Starting disk for Zip64 End of Central Directory record
|
|
Central_Dir_Zip64_EOCD_Offset : QWord; //offset of Zip64 End of Central Directory record
|
|
Total_Disks : LongWord; //total number of disks (contained in zip)
|
|
end;
|
|
|
|
Const
|
|
Crc_32_Tab : Array[0..255] of LongWord = (
|
|
$00000000, $77073096, $ee0e612c, $990951ba, $076dc419, $706af48f, $e963a535, $9e6495a3,
|
|
$0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd, $e7b82d07, $90bf1d91,
|
|
$1db71064, $6ab020f2, $f3b97148, $84be41de, $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7,
|
|
$136c9856, $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9, $fa0f3d63, $8d080df5,
|
|
$3b6e20c8, $4c69105e, $d56041e4, $a2677172, $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b,
|
|
$35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940, $32d86ce3, $45df5c75, $dcd60dcf, $abd13d59,
|
|
$26d930ac, $51de003a, $c8d75180, $bfd06116, $21b4f4b5, $56b3c423, $cfba9599, $b8bda50f,
|
|
$2802b89e, $5f058808, $c60cd9b2, $b10be924, $2f6f7c87, $58684c11, $c1611dab, $b6662d3d,
|
|
$76dc4190, $01db7106, $98d220bc, $efd5102a, $71b18589, $06b6b51f, $9fbfe4a5, $e8b8d433,
|
|
$7807c9a2, $0f00f934, $9609a88e, $e10e9818, $7f6a0dbb, $086d3d2d, $91646c97, $e6635c01,
|
|
$6b6b51f4, $1c6c6162, $856530d8, $f262004e, $6c0695ed, $1b01a57b, $8208f4c1, $f50fc457,
|
|
$65b0d9c6, $12b7e950, $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3, $fbd44c65,
|
|
$4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, $4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb,
|
|
$4369e96a, $346ed9fc, $ad678846, $da60b8d0, $44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9,
|
|
$5005713c, $270241aa, $be0b1010, $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f,
|
|
$5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, $2eb40d81, $b7bd5c3b, $c0ba6cad,
|
|
$edb88320, $9abfb3b6, $03b6e20c, $74b1d29a, $ead54739, $9dd277af, $04db2615, $73dc1683,
|
|
$e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8, $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1,
|
|
$f00f9344, $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb, $196c3671, $6e6b06e7,
|
|
$fed41b76, $89d32be0, $10da7a5a, $67dd4acc, $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5,
|
|
$d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252, $d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b,
|
|
$d80d2bda, $af0a1b4c, $36034af6, $41047a60, $df60efc3, $a867df55, $316e8eef, $4669be79,
|
|
$cb61b38c, $bc66831a, $256fd2a0, $5268e236, $cc0c7795, $bb0b4703, $220216b9, $5505262f,
|
|
$c5ba3bbe, $b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31, $2cd99e8b, $5bdeae1d,
|
|
$9b64c2b0, $ec63f226, $756aa39c, $026d930a, $9c0906a9, $eb0e363f, $72076785, $05005713,
|
|
$95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38, $92d28e9b, $e5d5be0d, $7cdcefb7, $0bdbdf21,
|
|
$86d3d2d4, $f1d4e242, $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1, $18b74777,
|
|
$88085ae6, $ff0f6a70, $66063bca, $11010b5c, $8f659eff, $f862ae69, $616bffd3, $166ccf45,
|
|
$a00ae278, $d70dd2ee, $4e048354, $3903b3c2, $a7672661, $d06016f7, $4969474d, $3e6e77db,
|
|
$aed16a4a, $d9d65adc, $40df0b66, $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9,
|
|
$bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605, $cdd70693, $54de5729, $23d967bf,
|
|
$b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94, $b40bbe37, $c30c8ea1, $5a05df1b, $2d02ef8d
|
|
);
|
|
|
|
Type
|
|
|
|
TProgressEvent = Procedure(Sender : TObject; Const Pct : Double) of object;
|
|
TProgressEventEx = Procedure(Sender : TObject; Const ATotPos, ATotSize: Int64) of object;
|
|
TOnEndOfFileEvent = Procedure(Sender : TObject; Const Ratio : Double) of object;
|
|
TOnStartFileEvent = Procedure(Sender : TObject; Const AFileName : String) of object;
|
|
|
|
Type
|
|
|
|
{ TCompressor }
|
|
TCompressor = Class(TObject)
|
|
private
|
|
FTerminated: Boolean;
|
|
Protected
|
|
FInFile : TStream; { I/O file variables }
|
|
FOutFile : TStream;
|
|
FCrc32Val : LongWord; { CRC calculation variable }
|
|
FBufferSize : LongWord;
|
|
FOnPercent : Integer;
|
|
FOnProgress : TProgressEvent;
|
|
Procedure UpdC32(Octet: Byte);
|
|
Public
|
|
Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord); virtual;
|
|
Procedure Compress; Virtual; Abstract;
|
|
Class Function ZipID : Word; virtual; Abstract;
|
|
Class Function ZipVersionReqd: Word; virtual; Abstract;
|
|
Function ZipBitFlag: Word; virtual; Abstract;
|
|
Procedure Terminate;
|
|
Property BufferSize : LongWord read FBufferSize;
|
|
Property OnPercent : Integer Read FOnPercent Write FOnPercent;
|
|
Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
|
|
Property Crc32Val : LongWord Read FCrc32Val Write FCrc32Val;
|
|
Property Terminated : Boolean Read FTerminated;
|
|
end;
|
|
|
|
{ TDeCompressor }
|
|
TDeCompressor = Class(TObject)
|
|
Protected
|
|
FInFile : TStream; { I/O file variables }
|
|
FOutFile : TStream;
|
|
FCrc32Val : LongWord; { CRC calculation variable }
|
|
FBufferSize : LongWord;
|
|
FOnPercent : Integer;
|
|
FOnProgress : TProgressEvent;
|
|
FOnProgressEx: TProgressEventEx;
|
|
FTotPos : Int64;
|
|
FTotSize : Int64;
|
|
FTerminated : Boolean;
|
|
Procedure UpdC32(Octet: Byte);
|
|
Public
|
|
Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord); virtual;
|
|
Procedure DeCompress; Virtual; Abstract;
|
|
Procedure Terminate;
|
|
Class Function ZipID : Word; virtual; Abstract;
|
|
Property BufferSize : LongWord read FBufferSize;
|
|
Property OnPercent : Integer Read FOnPercent Write FOnPercent;
|
|
Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
|
|
Property OnProgressEx : TProgressEventEx Read FOnProgressEx Write FOnProgressEx;
|
|
Property Crc32Val : LongWord Read FCrc32Val Write FCrc32Val;
|
|
Property Terminated : Boolean Read FTerminated;
|
|
end;
|
|
|
|
{ TShrinker }
|
|
|
|
Const
|
|
TABLESIZE = 8191;
|
|
FIRSTENTRY = 257;
|
|
|
|
Type
|
|
CodeRec = Packed Record
|
|
Child : Smallint;
|
|
Sibling : Smallint;
|
|
Suffix : Byte;
|
|
end;
|
|
CodeArray = Array[0..TABLESIZE] of CodeRec;
|
|
TablePtr = ^CodeArray;
|
|
|
|
FreeListPtr = ^FreeListArray;
|
|
FreeListArray = Array[FIRSTENTRY..TABLESIZE] of Word;
|
|
|
|
BufPtr = PByte;
|
|
|
|
TShrinker = Class(TCompressor)
|
|
Private
|
|
FBufSize : LongWord;
|
|
MaxInBufIdx : LongWord; { Count of valid chars in input buffer }
|
|
InputEof : Boolean; { End of file indicator }
|
|
CodeTable : TablePtr; { Points to code table for LZW compression }
|
|
FreeList : FreeListPtr; { Table of free code table entries }
|
|
NextFree : Word; { Index into free list table }
|
|
|
|
ClearList : Array[0..1023] of Byte; { Bit mapped structure used in }
|
|
{ during adaptive resets }
|
|
CodeSize : Byte; { Size of codes (in bits) currently being written }
|
|
MaxCode : Word; { Largest code that can be written in CodeSize bits }
|
|
InBufIdx, { Points to next char in buffer to be read }
|
|
OutBufIdx : LongWord; { Points to next free space in output buffer }
|
|
InBuf, { I/O buffers }
|
|
OutBuf : BufPtr;
|
|
FirstCh : Boolean; { Flag indicating the START of a shrink operation }
|
|
TableFull : Boolean; { Flag indicating a full symbol table }
|
|
SaveByte : Byte; { Output code buffer }
|
|
BitsUsed : Byte; { Index into output code buffer }
|
|
BytesIn : LongWord; { Count of input file bytes processed }
|
|
BytesOut : LongWord; { Count of output bytes }
|
|
FOnBytes : LongWord;
|
|
Procedure FillInputBuffer;
|
|
Procedure WriteOutputBuffer;
|
|
Procedure FlushOutput;
|
|
Procedure PutChar(B : Byte);
|
|
procedure PutCode(Code : Smallint);
|
|
Procedure InitializeCodeTable;
|
|
Procedure Prune(Parent : Word);
|
|
Procedure Clear_Table;
|
|
Procedure Table_Add(Prefix : Word; Suffix : Byte);
|
|
function Table_Lookup(TargetPrefix : Smallint;
|
|
TargetSuffix : Byte;
|
|
Out FoundAt : Smallint) : Boolean;
|
|
Procedure Shrink(Suffix : Smallint);
|
|
Procedure ProcessLine(Const Source : String);
|
|
Procedure DoOnProgress(Const Pct : Double); Virtual;
|
|
Public
|
|
Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord); override;
|
|
Destructor Destroy; override;
|
|
Procedure Compress; override;
|
|
Class Function ZipID : Word; override;
|
|
Class Function ZipVersionReqd : Word; override;
|
|
Function ZipBitFlag : Word; override;
|
|
end;
|
|
|
|
{ TDeflater }
|
|
|
|
TDeflater = Class(TCompressor)
|
|
private
|
|
FCompressionLevel: TCompressionlevel;
|
|
Public
|
|
Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord);override;
|
|
Procedure Compress; override;
|
|
Class Function ZipID : Word; override;
|
|
Class Function ZipVersionReqd : Word; override;
|
|
Function ZipBitFlag : Word; override;
|
|
Property CompressionLevel : TCompressionlevel Read FCompressionLevel Write FCompressionLevel;
|
|
end;
|
|
|
|
{ TInflater }
|
|
|
|
TInflater = Class(TDeCompressor)
|
|
Public
|
|
Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord);override;
|
|
Procedure DeCompress; override;
|
|
Class Function ZipID : Word; override;
|
|
end;
|
|
|
|
{ TZipFileEntry }
|
|
|
|
TZipFileEntry = Class(TCollectionItem)
|
|
private
|
|
FArchiveFileName: String; //Name of the file as it appears in the zip file list
|
|
FUTF8FileName : UTF8String;
|
|
FUTF8DiskFileName : UTF8String;
|
|
FAttributes: LongWord;
|
|
FDateTime: TDateTime;
|
|
FDiskFileName: String; {Name of the file on disk (i.e. uncompressed. Can be empty if based on a stream.);
|
|
uses local OS/filesystem directory separators}
|
|
FHeaderPos: int64;
|
|
FNeedsZip64: Boolean; //flags whether filesize is big enough so we need a zip64 entry
|
|
FOS: Byte;
|
|
FSize: Int64;
|
|
FStream: TStream;
|
|
FCompressionLevel: TCompressionlevel;
|
|
function GetArchiveFileName: String;
|
|
function GetUTF8ArchiveFileName: UTF8String;
|
|
function GetUTF8DiskFileName: UTF8String;
|
|
procedure SetArchiveFileName(Const AValue: String);
|
|
procedure SetDiskFileName(Const AValue: String);
|
|
procedure SetUTF8ArchiveFileName(AValue: UTF8String);
|
|
procedure SetUTF8DiskFileName(AValue: UTF8String);
|
|
Protected
|
|
// For multi-disk support, a disk number property could be added here.
|
|
Property HdrPos : int64 Read FHeaderPos Write FheaderPos;
|
|
Property NeedsZip64 : boolean Read FNeedsZip64 Write FNeedsZip64;
|
|
Public
|
|
constructor Create(ACollection: TCollection); override;
|
|
function IsDirectory: Boolean;
|
|
function IsLink: Boolean;
|
|
Procedure Assign(Source : TPersistent); override;
|
|
Property Stream : TStream Read FStream Write FStream;
|
|
Published
|
|
Property ArchiveFileName : String Read GetArchiveFileName Write SetArchiveFileName;
|
|
Property UTF8ArchiveFileName : UTF8String Read GetUTF8ArchiveFileName Write SetUTF8ArchiveFileName;
|
|
Property DiskFileName : String Read FDiskFileName Write SetDiskFileName;
|
|
Property UTF8DiskFileName : UTF8String Read GetUTF8DiskFileName Write SetUTF8DiskFileName;
|
|
Property Size : Int64 Read FSize Write FSize;
|
|
Property DateTime : TDateTime Read FDateTime Write FDateTime;
|
|
property OS: Byte read FOS write FOS;
|
|
property Attributes: LongWord read FAttributes write FAttributes;
|
|
Property CompressionLevel: TCompressionlevel read FCompressionLevel write FCompressionLevel;
|
|
end;
|
|
|
|
{ TZipFileEntries }
|
|
|
|
TZipFileEntries = Class(TCollection)
|
|
private
|
|
function GetZ(AIndex : Integer): TZipFileEntry;
|
|
procedure SetZ(AIndex : Integer; const AValue: TZipFileEntry);
|
|
Public
|
|
Function AddFileEntry(Const ADiskFileName : String): TZipFileEntry;
|
|
Function AddFileEntry(Const ADiskFileName, AArchiveFileName : String): TZipFileEntry;
|
|
Function AddFileEntry(Const AStream : TSTream; Const AArchiveFileName : String): TZipFileEntry;
|
|
Procedure AddFileEntries(Const List : TStrings);
|
|
Property Entries[AIndex : Integer] : TZipFileEntry Read GetZ Write SetZ; default;
|
|
end;
|
|
|
|
{ TZipper }
|
|
|
|
TZipper = Class(TObject)
|
|
Private
|
|
FEntries : TZipFileEntries;
|
|
FTerminated: Boolean;
|
|
FZipping : Boolean;
|
|
FBufSize : LongWord;
|
|
FFileName : RawByteString; { Name of resulting Zip file }
|
|
FFileComment : String;
|
|
FFiles : TStrings;
|
|
FInMemSize : Int64;
|
|
FZipFileNeedsZip64 : Boolean; //flags whether at least one file is big enough to require a zip64 record
|
|
FOutStream : TStream;
|
|
FInFile : TStream; { I/O file variables }
|
|
LocalHdr : Local_File_Header_Type;
|
|
LocalZip64ExtHdr: Extensible_Data_Field_Header_Type; //Extra field header fixed to zip64 (i.e. .ID=1)
|
|
LocalZip64Fld : Zip64_Extended_Info_Field_Type; //header is in LocalZip64ExtHdr
|
|
CentralHdr : Central_File_Header_Type;
|
|
EndHdr : End_of_Central_Dir_Type;
|
|
FOnPercent : LongInt;
|
|
FOnProgress : TProgressEvent;
|
|
FOnEndOfFile : TOnEndOfFileEvent;
|
|
FOnStartFile : TOnStartFileEvent;
|
|
FCurrentCompressor : TCompressor;
|
|
function CheckEntries: Integer;
|
|
procedure SetEntries(const AValue: TZipFileEntries);
|
|
Protected
|
|
Procedure CloseInput(Item : TZipFileEntry);
|
|
Procedure StartZipFile(Item : TZipFileEntry);
|
|
Function UpdateZipHeader(Item : TZipFileEntry; FZip : TStream; ACRC : LongWord;AMethod : Word; AZipVersionReqd : Word; AZipBitFlag : Word) : Boolean;
|
|
Procedure BuildZipDirectory; //Builds central directory based on local headers
|
|
Procedure DoEndOfFile;
|
|
Procedure ZipOneFile(Item : TZipFileEntry); virtual;
|
|
Function OpenInput(Item : TZipFileEntry) : Boolean;
|
|
Procedure GetFileInfo;
|
|
Procedure SetBufSize(Value : LongWord);
|
|
Procedure SetFileName(Value : RawByteString);
|
|
Function CreateCompressor(Item : TZipFileEntry; AinFile,AZipStream : TStream) : TCompressor; virtual;
|
|
Property NeedsZip64 : boolean Read FZipFileNeedsZip64 Write FZipFileNeedsZip64;
|
|
Public
|
|
Constructor Create;
|
|
Destructor Destroy;override;
|
|
Procedure ZipAllFiles; virtual;
|
|
// Saves zip to file and changes FileName
|
|
Procedure SaveToFile(AFileName: RawByteString);
|
|
// Saves zip to stream
|
|
Procedure SaveToStream(AStream: TStream);
|
|
// Zips specified files into a zip with name AFileName
|
|
Procedure ZipFiles(AFileName : RawByteString; FileList : TStrings);
|
|
Procedure ZipFiles(FileList : TStrings);
|
|
// Zips specified entries into a zip with name AFileName
|
|
Procedure ZipFiles(AFileName : RawByteString; Entries : TZipFileEntries);
|
|
Procedure ZipFiles(Entries : TZipFileEntries);
|
|
Procedure Clear;
|
|
Procedure Terminate;
|
|
Public
|
|
Property BufferSize : LongWord Read FBufSize Write SetBufSize;
|
|
Property OnPercent : Integer Read FOnPercent Write FOnPercent;
|
|
Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
|
|
Property OnStartFile : TOnStartFileEvent Read FOnStartFile Write FOnStartFile;
|
|
Property OnEndFile : TOnEndOfFileEvent Read FOnEndOfFile Write FOnEndOfFile;
|
|
Property FileName : RawByteString Read FFileName Write SetFileName;
|
|
Property FileComment: String Read FFileComment Write FFileComment;
|
|
// Deprecated. Use Entries.AddFileEntry(FileName) or Entries.AddFileEntries(List) instead.
|
|
Property Files : TStrings Read FFiles; deprecated;
|
|
Property InMemSize : Int64 Read FInMemSize Write FInMemSize;
|
|
Property Entries : TZipFileEntries Read FEntries Write SetEntries;
|
|
Property Terminated : Boolean Read FTerminated;
|
|
end;
|
|
|
|
{ TFullZipFileEntry }
|
|
|
|
TFullZipFileEntry = Class(TZipFileEntry)
|
|
private
|
|
FBitFlags: Word;
|
|
FCompressedSize: QWord;
|
|
FCompressMethod: Word;
|
|
FCRC32: LongWord;
|
|
Public
|
|
Property BitFlags : Word Read FBitFlags;
|
|
Property CompressMethod : Word Read FCompressMethod;
|
|
Property CompressedSize : QWord Read FCompressedSize;
|
|
property CRC32: LongWord read FCRC32 write FCRC32;
|
|
end;
|
|
|
|
TOnCustomStreamEvent = Procedure(Sender : TObject; var AStream : TStream; AItem : TFullZipFileEntry) of object;
|
|
TCustomInputStreamEvent = Procedure(Sender: TObject; var AStream: TStream) of object;
|
|
|
|
{ TFullZipFileEntries }
|
|
|
|
TFullZipFileEntries = Class(TZipFileEntries)
|
|
private
|
|
function GetFZ(AIndex : Integer): TFullZipFileEntry;
|
|
procedure SetFZ(AIndex : Integer; const AValue: TFullZipFileEntry);
|
|
Public
|
|
Property FullEntries[AIndex : Integer] : TFullZipFileEntry Read GetFZ Write SetFZ; default;
|
|
end;
|
|
|
|
{ TUnZipper }
|
|
|
|
TUnZipper = Class(TObject)
|
|
Private
|
|
FOnCloseInputStream: TCustomInputStreamEvent;
|
|
FOnCreateStream: TOnCustomStreamEvent;
|
|
FOnDoneStream: TOnCustomStreamEvent;
|
|
FOnOpenInputStream: TCustomInputStreamEvent;
|
|
FUnZipping : Boolean;
|
|
FBufSize : LongWord;
|
|
FFileName : RawByteString; { Name of resulting Zip file }
|
|
FOutputPath : RawByteString;
|
|
FFileComment: String;
|
|
FEntries : TFullZipFileEntries;
|
|
FFiles : TStrings;
|
|
FUseUTF8: Boolean;
|
|
FZipStream : TStream; { I/O file variables }
|
|
LocalHdr : Local_File_Header_Type; //Local header, before compressed file data
|
|
LocalZip64Fld : Zip64_Extended_Info_Field_Type; //header is in LocalZip64ExtHdr
|
|
CentralHdr : Central_File_Header_Type;
|
|
FTotPos : Int64;
|
|
FTotSize : Int64;
|
|
FTerminated: Boolean;
|
|
FOnPercent : LongInt;
|
|
FOnProgress : TProgressEvent;
|
|
FOnProgressEx : TProgressEventEx;
|
|
FOnEndOfFile : TOnEndOfFileEvent;
|
|
FOnStartFile : TOnStartFileEvent;
|
|
FCurrentDecompressor: TDecompressor;
|
|
function CalcTotalSize(AllFiles: Boolean): Int64;
|
|
function IsMatch(I: TFullZipFileEntry): Boolean;
|
|
Protected
|
|
Procedure OpenInput;
|
|
Procedure CloseOutput(Item : TFullZipFileEntry; var OutStream: TStream);
|
|
Procedure CloseInput;
|
|
Procedure FindEndHeaders(
|
|
out AEndHdr: End_of_Central_Dir_Type;
|
|
out AEndHdrPos: Int64;
|
|
out AEndZip64Hdr: Zip64_End_of_Central_Dir_type;
|
|
out AEndZip64HdrPos: Int64);
|
|
Procedure ReadZipDirectory;
|
|
Procedure ReadZipHeader(Item : TFullZipFileEntry; out AMethod : Word);
|
|
Procedure DoEndOfFile;
|
|
Procedure UnZipOneFile(Item : TFullZipFileEntry); virtual;
|
|
Function OpenOutput(OutFileName : RawByteString; Out OutStream: TStream; Item : TFullZipFileEntry) : Boolean;
|
|
Procedure SetBufSize(Value : LongWord);
|
|
Procedure SetFileName(Value : RawByteString);
|
|
Procedure SetOutputPath(Value: RawByteString);
|
|
Function CreateDeCompressor(Item : TZipFileEntry; AMethod : Word;AZipFile,AOutFile : TStream) : TDeCompressor; virtual;
|
|
Public
|
|
Constructor Create;
|
|
Destructor Destroy;override;
|
|
Procedure UnZipAllFiles; virtual;
|
|
Procedure UnZipFiles(AFileName : RawByteString; FileList : TStrings);
|
|
Procedure UnZipFiles(FileList : TStrings);
|
|
Procedure UnZipAllFiles(AFileName : RawByteString);
|
|
Procedure Clear;
|
|
Procedure Examine;
|
|
Procedure Terminate;
|
|
Public
|
|
Property BufferSize : LongWord Read FBufSize Write SetBufSize;
|
|
Property OnOpenInputStream: TCustomInputStreamEvent read FOnOpenInputStream write FOnOpenInputStream;
|
|
Property OnCloseInputStream: TCustomInputStreamEvent read FOnCloseInputStream write FOnCloseInputStream;
|
|
Property OnCreateStream : TOnCustomStreamEvent Read FOnCreateStream Write FOnCreateStream;
|
|
Property OnDoneStream : TOnCustomStreamEvent Read FOnDoneStream Write FOnDoneStream;
|
|
Property OnPercent : Integer Read FOnPercent Write FOnPercent;
|
|
Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
|
|
Property OnProgressEx : TProgressEventEx Read FOnProgressEx Write FOnProgressEx;
|
|
Property OnStartFile : TOnStartFileEvent Read FOnStartFile Write FOnStartFile;
|
|
Property OnEndFile : TOnEndOfFileEvent Read FOnEndOfFile Write FOnEndOfFile;
|
|
Property FileName : RawByteString Read FFileName Write SetFileName;
|
|
Property OutputPath : RawByteString Read FOutputPath Write SetOutputPath;
|
|
Property FileComment: String Read FFileComment;
|
|
Property Files : TStrings Read FFiles;
|
|
Property Entries : TFullZipFileEntries Read FEntries;
|
|
Property UseUTF8 : Boolean Read FUseUTF8 Write FUseUTF8;
|
|
Property Terminated : Boolean Read FTerminated;
|
|
end;
|
|
|
|
EZipError = Class(Exception);
|
|
|
|
Implementation
|
|
|
|
uses rtlconsts;
|
|
|
|
ResourceString
|
|
SErrBufsizeChange = 'Changing buffer size is not allowed while (un)zipping.';
|
|
SErrFileChange = 'Changing output file name is not allowed while (un)zipping.';
|
|
SErrInvalidCRC = 'Invalid CRC checksum while unzipping %s.';
|
|
SErrCorruptZIP = 'Corrupt ZIP file %s.';
|
|
SErrUnsupportedCompressionFormat = 'Unsupported compression format %d.';
|
|
SErrUnsupportedMultipleDisksCD = 'A central directory split over multiple disks is unsupported.';
|
|
SErrMaxEntries = 'Encountered %d file entries; maximum supported is %d.';
|
|
SErrMissingFileName = 'Missing filename in entry %d.';
|
|
SErrMissingArchiveName = 'Missing archive filename in streamed entry %d.';
|
|
SErrFileDoesNotExist = 'File "%s" does not exist.';
|
|
SErrPosTooLarge = 'Position/offset %d is larger than maximum supported %d.';
|
|
SErrNoFileName = 'No archive filename for examine operation.';
|
|
SErrNoStream = 'No stream is opened.';
|
|
SErrEncryptionNotSupported = 'Cannot unzip item "%s": encryption is not supported.';
|
|
SErrPatchSetNotSupported = 'Cannot unzip item "%s": patch sets are not supported.';
|
|
|
|
{ ---------------------------------------------------------------------
|
|
Auxiliary
|
|
---------------------------------------------------------------------}
|
|
Type
|
|
// A local version of TFileStream which uses rawbytestring. It
|
|
TFileStream = class(THandleStream)
|
|
Private
|
|
FFileName : RawBytestring;
|
|
public
|
|
constructor Create(const AFileName: RawBytestring; Mode: Word);
|
|
constructor Create(const AFileName: RawBytestring; Mode: Word; Rights: Cardinal);
|
|
destructor Destroy; override;
|
|
property FileName : RawBytestring Read FFilename;
|
|
end;
|
|
constructor TFileStream.Create(const AFileName: rawbytestring; Mode: Word);
|
|
|
|
begin
|
|
Create(AFileName,Mode,438);
|
|
end;
|
|
|
|
|
|
constructor TFileStream.Create(const AFileName: rawbytestring; Mode: Word; Rights: Cardinal);
|
|
|
|
Var
|
|
H : Thandle;
|
|
|
|
begin
|
|
FFileName:=AFileName;
|
|
If (Mode and fmCreate) > 0 then
|
|
H:=FileCreate(AFileName,Mode,Rights)
|
|
else
|
|
H:=FileOpen(AFileName,Mode);
|
|
|
|
If (THandle(H)=feInvalidHandle) then
|
|
If Mode=fmcreate then
|
|
raise EFCreateError.createfmt(SFCreateError,[AFileName])
|
|
else
|
|
raise EFOpenError.Createfmt(SFOpenError,[AFilename]);
|
|
Inherited Create(H);
|
|
end;
|
|
|
|
|
|
destructor TFileStream.Destroy;
|
|
|
|
begin
|
|
FileClose(Handle);
|
|
end;
|
|
|
|
{$IFDEF FPC_BIG_ENDIAN}
|
|
function SwapLFH(const Values: Local_File_Header_Type): Local_File_Header_Type;
|
|
begin
|
|
with Values do
|
|
begin
|
|
Result.Signature := SwapEndian(Signature);
|
|
Result.Extract_Version_Reqd := SwapEndian(Extract_Version_Reqd);
|
|
Result.Bit_Flag := SwapEndian(Bit_Flag);
|
|
Result.Compress_Method := SwapEndian(Compress_Method);
|
|
Result.Last_Mod_Time := SwapEndian(Last_Mod_Time);
|
|
Result.Last_Mod_Date := SwapEndian(Last_Mod_Date);
|
|
Result.Crc32 := SwapEndian(Crc32);
|
|
Result.Compressed_Size := SwapEndian(Compressed_Size);
|
|
Result.Uncompressed_Size := SwapEndian(Uncompressed_Size);
|
|
Result.Filename_Length := SwapEndian(Filename_Length);
|
|
Result.Extra_Field_Length := SwapEndian(Extra_Field_Length);
|
|
end;
|
|
end;
|
|
|
|
function SwapEDFH(const Values: Extensible_Data_Field_Header_Type): Extensible_Data_Field_Header_Type;
|
|
begin
|
|
with Values do
|
|
begin
|
|
Result.Header_ID := SwapEndian(Header_ID);
|
|
Result.Data_Size := SwapEndian(Data_Size);
|
|
end;
|
|
end;
|
|
|
|
function SwapZ64EIF(const Values: Zip64_Extended_Info_Field_Type): Zip64_Extended_Info_Field_Type;
|
|
begin
|
|
with Values do
|
|
begin
|
|
Result.Original_Size := SwapEndian(Original_Size);
|
|
Result.Compressed_Size := SwapEndian(Compressed_Size);
|
|
Result.Relative_Hdr_Offset := SwapEndian(Relative_Hdr_Offset);
|
|
Result.Disk_Start_Number := SwapEndian(Disk_Start_Number);
|
|
end;
|
|
end;
|
|
|
|
function SwapCFH(const Values: Central_File_Header_Type): Central_File_Header_Type;
|
|
begin
|
|
with Values do
|
|
begin
|
|
Result.Signature := SwapEndian(Signature);
|
|
Result.MadeBy_Version := SwapEndian(MadeBy_Version);
|
|
Result.Extract_Version_Reqd := SwapEndian(Extract_Version_Reqd);
|
|
Result.Bit_Flag := SwapEndian(Bit_Flag);
|
|
Result.Compress_Method := SwapEndian(Compress_Method);
|
|
Result.Last_Mod_Time := SwapEndian(Last_Mod_Time);
|
|
Result.Last_Mod_Date := SwapEndian(Last_Mod_Date);
|
|
Result.Crc32 := SwapEndian(Crc32);
|
|
Result.Compressed_Size := SwapEndian(Compressed_Size);
|
|
Result.Uncompressed_Size := SwapEndian(Uncompressed_Size);
|
|
Result.Filename_Length := SwapEndian(Filename_Length);
|
|
Result.Extra_Field_Length := SwapEndian(Extra_Field_Length);
|
|
Result.File_Comment_Length := SwapEndian(File_Comment_Length);
|
|
Result.Starting_Disk_Num := SwapEndian(Starting_Disk_Num);
|
|
Result.Internal_Attributes := SwapEndian(Internal_Attributes);
|
|
Result.External_Attributes := SwapEndian(External_Attributes);
|
|
Result.Local_Header_Offset := SwapEndian(Local_Header_Offset);
|
|
end;
|
|
end;
|
|
|
|
function SwapECD(const Values: End_of_Central_Dir_Type): End_of_Central_Dir_Type;
|
|
begin
|
|
with Values do
|
|
begin
|
|
Result.Signature := SwapEndian(Signature);
|
|
Result.Disk_Number := SwapEndian(Disk_Number);
|
|
Result.Central_Dir_Start_Disk := SwapEndian(Central_Dir_Start_Disk);
|
|
Result.Entries_This_Disk := SwapEndian(Entries_This_Disk);
|
|
Result.Total_Entries := SwapEndian(Total_Entries);
|
|
Result.Central_Dir_Size := SwapEndian(Central_Dir_Size);
|
|
Result.Start_Disk_Offset := SwapEndian(Start_Disk_Offset);
|
|
Result.ZipFile_Comment_Length := SwapEndian(ZipFile_Comment_Length);
|
|
end;
|
|
end;
|
|
|
|
function SwapZ64ECD(const Values: Zip64_End_of_Central_Dir_Type): Zip64_End_of_Central_Dir_Type;
|
|
begin
|
|
with Values do
|
|
begin
|
|
Result.Signature := SwapEndian(Signature);
|
|
Result.Record_Size := SwapEndian(Record_Size);
|
|
Result.Version_Made_By := SwapEndian(Version_Made_By);
|
|
Result.Extract_Version_Reqd := SwapEndian(Extract_Version_Reqd);
|
|
Result.Disk_Number := SwapEndian(Disk_Number);
|
|
Result.Central_Dir_Start_Disk := SwapEndian(Central_Dir_Start_Disk);
|
|
Result.Entries_This_Disk := SwapEndian(Entries_This_Disk);
|
|
Result.Total_Entries := SwapEndian(Total_Entries);
|
|
Result.Central_Dir_Size := SwapEndian(Central_Dir_Size);
|
|
Result.Start_Disk_Offset := SwapEndian(Start_Disk_Offset);
|
|
end;
|
|
end;
|
|
|
|
function SwapZ64ECDL(const Values: Zip64_End_of_Central_Dir_Locator_type): Zip64_End_of_Central_Dir_Locator_type;
|
|
begin
|
|
with Values do
|
|
begin
|
|
Result.Signature := SwapEndian(Signature);
|
|
Result.Zip64_EOCD_Start_Disk := SwapEndian(Zip64_EOCD_Start_Disk);
|
|
Result.Central_Dir_Zip64_EOCD_Offset := SwapEndian(Central_Dir_Zip64_EOCD_Offset);
|
|
Result.Total_Disks := SwapEndian(Total_Disks);
|
|
end;
|
|
end;
|
|
{$ENDIF FPC_BIG_ENDIAN}
|
|
|
|
Procedure DateTimeToZipDateTime(DT : TDateTime; out ZD,ZT : Word);
|
|
|
|
Var
|
|
Y,M,D,H,N,S,MS : Word;
|
|
|
|
begin
|
|
DecodeDate(DT,Y,M,D);
|
|
DecodeTime(DT,H,N,S,MS);
|
|
if Y<1980 then
|
|
begin
|
|
// Invalid date/time; set to earliest possible
|
|
Y:=0;
|
|
M:=1;
|
|
D:=1;
|
|
H:=0;
|
|
N:=0;
|
|
S:=0;
|
|
MS:=0;
|
|
end
|
|
else
|
|
begin
|
|
Y:=Y-1980;
|
|
end;
|
|
ZD:=d+(32*M)+(512*Y);
|
|
ZT:=(S div 2)+(32*N)+(2048*h);
|
|
end;
|
|
|
|
Procedure ZipDateTimeToDateTime(ZD,ZT : Word;out DT : TDateTime);
|
|
|
|
Var
|
|
Y,M,D,H,N,S,MS : Word;
|
|
|
|
begin
|
|
MS:=0;
|
|
S:=(ZT and 31) shl 1;
|
|
N:=(ZT shr 5) and 63;
|
|
H:=ZT shr 11;
|
|
D:=ZD and 31;
|
|
M:=(ZD shr 5) and 15;
|
|
Y:=((ZD shr 9) and 127)+1980;
|
|
|
|
if M < 1 then M := 1;
|
|
if D < 1 then D := 1;
|
|
DT:=ComposeDateTime(EncodeDate(Y,M,D),EncodeTime(H,N,S,MS));
|
|
end;
|
|
|
|
|
|
|
|
function ZipUnixAttrsToFatAttrs(const Name: String; Attrs: Longint): Longint;
|
|
begin
|
|
Result := faArchive;
|
|
|
|
if (Pos('.', Name) = 1) and (Name <> '.') and (Name <> '..') then
|
|
Result := Result + faHidden;
|
|
case (Attrs and UNIX_MASK) of
|
|
UNIX_DIR: Result := Result + faDirectory;
|
|
UNIX_LINK: Result := Result + faSymLink;
|
|
UNIX_FIFO, UNIX_CHAR, UNIX_BLK, UNIX_SOCK:
|
|
Result := Result + faSysFile;
|
|
end;
|
|
|
|
if (Attrs and UNIX_WUSR) = 0 then
|
|
Result := Result + faReadOnly;
|
|
end;
|
|
|
|
function ZipFatAttrsToUnixAttrs(Attrs: Longint): Longint;
|
|
begin
|
|
Result := UNIX_DEFAULT;
|
|
if (faReadOnly and Attrs) > 0 then
|
|
Result := Result and not (UNIX_WUSR);
|
|
|
|
if (faSymLink and Attrs) > 0 then
|
|
Result := Result or UNIX_LINK
|
|
else
|
|
if (faDirectory and Attrs) > 0 then
|
|
Result := Result or UNIX_DIR
|
|
else
|
|
Result := Result or UNIX_FILE;
|
|
end;
|
|
|
|
function CRC32Str(const s:string):DWord;
|
|
var
|
|
i:Integer;
|
|
begin
|
|
Result:=$FFFFFFFF;
|
|
if Length(S)>0 then
|
|
for i:=1 to Length(s) do
|
|
Result:=Crc_32_Tab[Byte(Result XOR LongInt(s[i]))] XOR ((Result SHR 8) AND $00FFFFFF);
|
|
Result:=not Result;
|
|
end;
|
|
|
|
{ ---------------------------------------------------------------------
|
|
TDeCompressor
|
|
---------------------------------------------------------------------}
|
|
|
|
|
|
Procedure TDeCompressor.UpdC32(Octet: Byte);
|
|
|
|
Begin
|
|
FCrc32Val := Crc_32_Tab[Byte(FCrc32Val XOR LongInt(Octet))] XOR ((FCrc32Val SHR 8) AND $00FFFFFF);
|
|
end;
|
|
|
|
constructor TDeCompressor.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
|
|
begin
|
|
FinFile:=AInFile;
|
|
FoutFile:=AOutFile;
|
|
FBufferSize:=ABufSize;
|
|
CRC32Val:=$FFFFFFFF;
|
|
end;
|
|
|
|
procedure TDeCompressor.Terminate;
|
|
begin
|
|
FTerminated:=True;
|
|
end;
|
|
|
|
|
|
{ ---------------------------------------------------------------------
|
|
TCompressor
|
|
---------------------------------------------------------------------}
|
|
|
|
|
|
Procedure TCompressor.UpdC32(Octet: Byte);
|
|
|
|
Begin
|
|
FCrc32Val := Crc_32_Tab[Byte(FCrc32Val XOR LongInt(Octet))] XOR ((FCrc32Val SHR 8) AND $00FFFFFF);
|
|
end;
|
|
|
|
constructor TCompressor.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
|
|
begin
|
|
FinFile:=AInFile;
|
|
FoutFile:=AOutFile;
|
|
FBufferSize:=ABufSize;
|
|
CRC32Val:=$FFFFFFFF;
|
|
end;
|
|
|
|
procedure TCompressor.Terminate;
|
|
begin
|
|
FTerminated:=True;
|
|
end;
|
|
|
|
|
|
{ ---------------------------------------------------------------------
|
|
TDeflater
|
|
---------------------------------------------------------------------}
|
|
|
|
constructor TDeflater.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
|
|
begin
|
|
Inherited;
|
|
FCompressionLevel:=clDefault;
|
|
end;
|
|
|
|
|
|
procedure TDeflater.Compress;
|
|
Var
|
|
Buf : PByte;
|
|
I,Count,NewCount : integer;
|
|
C : TCompressionStream;
|
|
BytesNow : Int64;
|
|
NextMark : Int64;
|
|
OnBytes : Int64;
|
|
FSize : Int64;
|
|
begin
|
|
CRC32Val:=$FFFFFFFF;
|
|
Buf:=GetMem(FBufferSize);
|
|
if FOnPercent = 0 then
|
|
FOnPercent := 1;
|
|
OnBytes:=Round((FInFile.Size * FOnPercent) / 100);
|
|
BytesNow:=0;
|
|
NextMark := OnBytes;
|
|
FSize:=FInfile.Size;
|
|
Try
|
|
C:=TCompressionStream.Create(FCompressionLevel,FOutFile,True);
|
|
Try
|
|
if assigned(FOnProgress) then
|
|
fOnProgress(self,0);
|
|
Repeat
|
|
Count:=FInFile.Read(Buf^,FBufferSize);
|
|
For I:=0 to Count-1 do
|
|
UpdC32(Buf[i]);
|
|
NewCount:=Count;
|
|
while (NewCount>0) do
|
|
NewCount:=NewCount-C.Write(Buf^,NewCount);
|
|
inc(BytesNow,Count);
|
|
if BytesNow>NextMark Then
|
|
begin
|
|
if (FSize>0) and assigned(FOnProgress) Then
|
|
FOnProgress(self,100 * ( BytesNow / FSize));
|
|
inc(NextMark,OnBytes);
|
|
end;
|
|
Until (Count=0) or Terminated;
|
|
Finally
|
|
C.Free;
|
|
end;
|
|
Finally
|
|
FreeMem(Buf);
|
|
end;
|
|
if assigned(FOnProgress) then
|
|
fOnProgress(self,100.0);
|
|
Crc32Val:=NOT Crc32Val;
|
|
end;
|
|
|
|
class function TDeflater.ZipID: Word;
|
|
begin
|
|
Result:=8;
|
|
end;
|
|
|
|
class function TDeflater.ZipVersionReqd: Word;
|
|
begin
|
|
Result:=20;
|
|
end;
|
|
|
|
function TDeflater.ZipBitFlag: Word;
|
|
begin
|
|
case CompressionLevel of
|
|
clnone: Result := %110;
|
|
clfastest: Result := %100;
|
|
cldefault: Result := %000;
|
|
clmax: Result := %010;
|
|
else
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
{ ---------------------------------------------------------------------
|
|
TInflater
|
|
---------------------------------------------------------------------}
|
|
|
|
constructor TInflater.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
|
|
begin
|
|
Inherited;
|
|
end;
|
|
|
|
|
|
procedure TInflater.DeCompress;
|
|
|
|
Var
|
|
Buf : PByte;
|
|
I,Count : Integer;
|
|
C : TDeCompressionStream;
|
|
BytesNow : Integer;
|
|
NextMark : Integer;
|
|
OnBytes : Integer;
|
|
FSize : Integer;
|
|
|
|
begin
|
|
CRC32Val:=$FFFFFFFF;
|
|
if FOnPercent = 0 then
|
|
FOnPercent := 1;
|
|
OnBytes:=Round((FInFile.Size * FOnPercent) / 100);
|
|
BytesNow:=0; NextMark := OnBytes;
|
|
FSize:=FInfile.Size;
|
|
|
|
If Assigned(FOnProgress) then
|
|
fOnProgress(self,0);
|
|
|
|
Buf:=GetMem(FBufferSize);
|
|
Try
|
|
C:=TDeCompressionStream.Create(FInFile,True);
|
|
Try
|
|
Repeat
|
|
Count:=C.Read(Buf^,FBufferSize);
|
|
For I:=0 to Count-1 do
|
|
UpdC32(Buf[i]);
|
|
FOutFile.Write(Buf^,Count);
|
|
inc(BytesNow,Count);
|
|
if BytesNow>NextMark Then
|
|
begin
|
|
if (FSize>0) and assigned(FOnProgress) Then
|
|
FOnProgress(self,100 * ( BytesNow / FSize));
|
|
if assigned(FOnProgressEx) Then
|
|
FOnProgressEx(Self, FTotPos + BytesNow, FTotSize);
|
|
inc(NextMark,OnBytes);
|
|
end;
|
|
Until (Count=0) or Terminated;
|
|
FTotPos := FTotPos + FOutFile.Size;
|
|
Finally
|
|
C.Free;
|
|
end;
|
|
Finally
|
|
FreeMem(Buf);
|
|
end;
|
|
if assigned(FOnProgress) then
|
|
fOnProgress(self,100.0);
|
|
if assigned(FOnProgressEx) then
|
|
FOnProgressEx(Self, FTotPos, FTotSize);
|
|
Crc32Val:=NOT Crc32Val;
|
|
end;
|
|
|
|
class function TInflater.ZipID: Word;
|
|
begin
|
|
Result:=8;
|
|
end;
|
|
|
|
|
|
{ ---------------------------------------------------------------------
|
|
TShrinker
|
|
---------------------------------------------------------------------}
|
|
|
|
Const
|
|
DefaultInMemSize = 256*1024; { Files larger than 256k are processed on disk }
|
|
DefaultBufSize = 16384; { Use 16K file buffers }
|
|
MINBITS = 9; { Starting code size of 9 bits }
|
|
MAXBITS = 13; { Maximum code size of 13 bits }
|
|
SPECIAL = 256; { Special function code }
|
|
INCSIZE = 1; { Code indicating a jump in code size }
|
|
CLEARCODE = 2; { Code indicating code table has been cleared }
|
|
STDATTR = faAnyFile; { Standard file attribute for DOS Find First/Next }
|
|
|
|
constructor TShrinker.Create(AInFile, AOutFile : TStream; ABufSize : LongWord);
|
|
begin
|
|
Inherited;
|
|
FBufSize:=ABufSize;
|
|
InBuf:=GetMem(FBUFSIZE);
|
|
OutBuf:=GetMem(FBUFSIZE);
|
|
CodeTable:=GetMem(SizeOf(CodeTable^));
|
|
FreeList:=GetMem(SizeOf(FreeList^));
|
|
end;
|
|
|
|
destructor TShrinker.Destroy;
|
|
begin
|
|
FreeMem(CodeTable);
|
|
FreeMem(FreeList);
|
|
FreeMem(InBuf);
|
|
FreeMem(OutBuf);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
Procedure TShrinker.Compress;
|
|
|
|
Var
|
|
OneString : String;
|
|
Remaining : Word;
|
|
|
|
begin
|
|
BytesIn := 1;
|
|
BytesOut := 1;
|
|
InitializeCodeTable;
|
|
FillInputBuffer;
|
|
FirstCh:= TRUE;
|
|
Crc32Val:=$FFFFFFFF;
|
|
FOnBytes:=Round((FInFile.Size * FOnPercent) / 100);
|
|
While Not InputEof do
|
|
begin
|
|
Remaining:=Succ(MaxInBufIdx - InBufIdx);
|
|
If Remaining>255 then
|
|
Remaining:=255;
|
|
If Remaining=0 then
|
|
FillInputBuffer
|
|
else
|
|
begin
|
|
SetLength(OneString,Remaining);
|
|
Move(InBuf[InBufIdx], OneString[1], Remaining);
|
|
Inc(InBufIdx, Remaining);
|
|
ProcessLine(OneString);
|
|
end;
|
|
end;
|
|
Crc32Val := Not Crc32Val;
|
|
ProcessLine('');
|
|
end;
|
|
|
|
class function TShrinker.ZipID: Word;
|
|
begin
|
|
Result:=1;
|
|
end;
|
|
|
|
class function TShrinker.ZipVersionReqd: Word;
|
|
begin
|
|
Result:=10;
|
|
end;
|
|
|
|
function TShrinker.ZipBitFlag: Word;
|
|
begin
|
|
Result:=0;
|
|
end;
|
|
|
|
|
|
Procedure TShrinker.DoOnProgress(Const Pct: Double);
|
|
|
|
begin
|
|
If Assigned(FOnProgress) then
|
|
FOnProgress(Self,Pct);
|
|
end;
|
|
|
|
|
|
Procedure TShrinker.FillInputBuffer;
|
|
|
|
Begin
|
|
MaxInbufIDx:=FInfile.Read(InBuf[0], FBufSize);
|
|
If MaxInbufIDx=0 then
|
|
InputEof := TRUE
|
|
else
|
|
InputEOF := FALSE;
|
|
InBufIdx := 0;
|
|
end;
|
|
|
|
|
|
Procedure TShrinker.WriteOutputBuffer;
|
|
Begin
|
|
FOutFile.WriteBuffer(OutBuf[0], OutBufIdx);
|
|
OutBufIdx := 0;
|
|
end;
|
|
|
|
|
|
Procedure TShrinker.PutChar(B : Byte);
|
|
|
|
Begin
|
|
OutBuf[OutBufIdx] := B;
|
|
Inc(OutBufIdx);
|
|
If OutBufIdx>=FBufSize then
|
|
WriteOutputBuffer;
|
|
Inc(BytesOut);
|
|
end;
|
|
|
|
Procedure TShrinker.FlushOutput;
|
|
Begin
|
|
If OutBufIdx>0 then
|
|
WriteOutputBuffer;
|
|
End;
|
|
|
|
|
|
procedure TShrinker.PutCode(Code : Smallint);
|
|
|
|
var
|
|
ACode : LongInt;
|
|
XSize : Smallint;
|
|
|
|
begin
|
|
if (Code=-1) then
|
|
begin
|
|
if BitsUsed>0 then
|
|
PutChar(SaveByte);
|
|
end
|
|
else
|
|
begin
|
|
ACode := Longint(Code);
|
|
XSize := CodeSize+BitsUsed;
|
|
ACode := (ACode shl BitsUsed) or SaveByte;
|
|
while (XSize div 8) > 0 do
|
|
begin
|
|
PutChar(Lo(ACode));
|
|
ACode := ACode shr 8;
|
|
Dec(XSize,8);
|
|
end;
|
|
BitsUsed := XSize;
|
|
SaveByte := Lo(ACode);
|
|
end;
|
|
end;
|
|
|
|
|
|
Procedure TShrinker.InitializeCodeTable;
|
|
|
|
Var
|
|
I : Word;
|
|
Begin
|
|
For I := 0 to TableSize do
|
|
begin
|
|
With CodeTable^[I] do
|
|
begin
|
|
Child := -1;
|
|
Sibling := -1;
|
|
If (I<=255) then
|
|
Suffix := I;
|
|
end;
|
|
If (I>=257) then
|
|
FreeList^[I] := I;
|
|
end;
|
|
NextFree := FIRSTENTRY;
|
|
TableFull := FALSE;
|
|
end;
|
|
|
|
|
|
Procedure TShrinker.Prune(Parent : Word);
|
|
|
|
Var
|
|
CurrChild : Smallint;
|
|
NextSibling : Smallint;
|
|
Begin
|
|
CurrChild := CodeTable^[Parent].Child;
|
|
{ Find first Child that has descendants .. clear any that don't }
|
|
While (CurrChild <> -1) and (CodeTable^[CurrChild].Child = -1) do
|
|
begin
|
|
CodeTable^[Parent].Child := CodeTable^[CurrChild].Sibling;
|
|
CodeTable^[CurrChild].Sibling := -1;
|
|
{ Turn on ClearList bit to indicate a cleared entry }
|
|
ClearList[CurrChild DIV 8] := (ClearList[CurrChild DIV 8] OR (1 SHL (CurrChild MOD 8)));
|
|
CurrChild := CodeTable^[Parent].Child;
|
|
end;
|
|
If CurrChild <> -1 then
|
|
begin { If there are any children left ...}
|
|
Prune(CurrChild);
|
|
NextSibling := CodeTable^[CurrChild].Sibling;
|
|
While NextSibling <> -1 do
|
|
begin
|
|
If CodeTable^[NextSibling].Child = -1 then
|
|
begin
|
|
CodeTable^[CurrChild].Sibling := CodeTable^[NextSibling].Sibling;
|
|
CodeTable^[NextSibling].Sibling := -1;
|
|
{ Turn on ClearList bit to indicate a cleared entry }
|
|
ClearList[NextSibling DIV 8] := (ClearList[NextSibling DIV 8] OR (1 SHL (NextSibling MOD 8)));
|
|
NextSibling := CodeTable^[CurrChild].Sibling;
|
|
end
|
|
else
|
|
begin
|
|
CurrChild := NextSibling;
|
|
Prune(CurrChild);
|
|
NextSibling := CodeTable^[CurrChild].Sibling;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
Procedure TShrinker.Clear_Table;
|
|
Var
|
|
Node : Word;
|
|
Begin
|
|
FillChar(ClearList, SizeOf(ClearList), $00);
|
|
For Node := 0 to 255 do
|
|
Prune(Node);
|
|
NextFree := Succ(TABLESIZE);
|
|
For Node := TABLESIZE downto FIRSTENTRY do
|
|
begin
|
|
If (ClearList[Node DIV 8] AND (1 SHL (Node MOD 8))) <> 0 then
|
|
begin
|
|
Dec(NextFree);
|
|
FreeList^[NextFree] := Node;
|
|
end;
|
|
end;
|
|
If NextFree <= TABLESIZE then
|
|
TableFull := FALSE;
|
|
end;
|
|
|
|
|
|
Procedure TShrinker.Table_Add(Prefix : Word; Suffix : Byte);
|
|
Var
|
|
FreeNode : Word;
|
|
Begin
|
|
If NextFree <= TABLESIZE then
|
|
begin
|
|
FreeNode := FreeList^[NextFree];
|
|
Inc(NextFree);
|
|
CodeTable^[FreeNode].Child := -1;
|
|
CodeTable^[FreeNode].Sibling := -1;
|
|
CodeTable^[FreeNode].Suffix := Suffix;
|
|
If CodeTable^[Prefix].Child = -1 then
|
|
CodeTable^[Prefix].Child := FreeNode
|
|
else
|
|
begin
|
|
Prefix := CodeTable^[Prefix].Child;
|
|
While CodeTable^[Prefix].Sibling <> -1 do
|
|
Prefix := CodeTable^[Prefix].Sibling;
|
|
CodeTable^[Prefix].Sibling := FreeNode;
|
|
end;
|
|
end;
|
|
if NextFree > TABLESIZE then
|
|
TableFull := TRUE;
|
|
end;
|
|
|
|
function TShrinker.Table_Lookup( TargetPrefix : Smallint;
|
|
TargetSuffix : Byte;
|
|
Out FoundAt : Smallint ) : Boolean;
|
|
|
|
var TempPrefix : Smallint;
|
|
|
|
begin
|
|
TempPrefix := TargetPrefix;
|
|
Table_lookup := False;
|
|
if CodeTable^[TempPrefix].Child <> -1 then
|
|
begin
|
|
TempPrefix := CodeTable^[TempPrefix].Child;
|
|
repeat
|
|
if CodeTable^[TempPrefix].Suffix = TargetSuffix then
|
|
begin
|
|
Table_lookup := True;
|
|
break;
|
|
end;
|
|
if CodeTable^[TempPrefix].Sibling = -1 then
|
|
break;
|
|
TempPrefix := CodeTable^[TempPrefix].Sibling;
|
|
until False;
|
|
end;
|
|
if Table_Lookup then
|
|
FoundAt := TempPrefix
|
|
else
|
|
FoundAt := -1;
|
|
end;
|
|
|
|
Procedure TShrinker.Shrink(Suffix : Smallint);
|
|
|
|
Const
|
|
LastCode : Smallint = 0;
|
|
|
|
Var
|
|
WhereFound : Smallint;
|
|
|
|
Begin
|
|
If FirstCh then
|
|
begin
|
|
SaveByte := $00;
|
|
BitsUsed := 0;
|
|
CodeSize := MINBITS;
|
|
MaxCode := (1 SHL CodeSize) - 1;
|
|
LastCode := Suffix;
|
|
FirstCh := FALSE;
|
|
end
|
|
else
|
|
begin
|
|
If Suffix <> -1 then
|
|
begin
|
|
If TableFull then
|
|
begin
|
|
Putcode(LastCode);
|
|
PutCode(SPECIAL);
|
|
Putcode(CLEARCODE);
|
|
Clear_Table;
|
|
Table_Add(LastCode, Suffix);
|
|
LastCode := Suffix;
|
|
end
|
|
else
|
|
begin
|
|
If Table_Lookup(LastCode, Suffix, WhereFound) then
|
|
begin
|
|
LastCode := WhereFound;
|
|
end
|
|
else
|
|
begin
|
|
PutCode(LastCode);
|
|
Table_Add(LastCode, Suffix);
|
|
LastCode := Suffix;
|
|
If (FreeList^[NextFree] > MaxCode) and (CodeSize < MaxBits) then
|
|
begin
|
|
PutCode(SPECIAL);
|
|
PutCode(INCSIZE);
|
|
Inc(CodeSize);
|
|
MaxCode := (1 SHL CodeSize) -1;
|
|
end;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
PutCode(LastCode);
|
|
PutCode(-1);
|
|
FlushOutput;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
Procedure TShrinker.ProcessLine(Const Source : String);
|
|
|
|
Var
|
|
I : Word;
|
|
|
|
Begin
|
|
If Source = '' then
|
|
Shrink(-1)
|
|
else
|
|
For I := 1 to Length(Source) do
|
|
begin
|
|
Inc(BytesIn);
|
|
If (Pred(BytesIn) MOD FOnBytes) = 0 then
|
|
DoOnProgress(100 * ( BytesIn / FInFile.Size));
|
|
UpdC32(Ord(Source[I]));
|
|
Shrink(Ord(Source[I]));
|
|
end;
|
|
end;
|
|
|
|
{ ---------------------------------------------------------------------
|
|
TZipper
|
|
---------------------------------------------------------------------}
|
|
|
|
|
|
Procedure TZipper.GetFileInfo;
|
|
|
|
Var
|
|
F : TZipFileEntry;
|
|
Info : TSearchRec;
|
|
I : integer; //zip spec allows QWord but FEntries.Count does not support it
|
|
{$IFDEF UNIX}
|
|
UnixInfo: Stat;
|
|
{$ENDIF}
|
|
Begin
|
|
For I := 0 to FEntries.Count-1 do
|
|
begin
|
|
F:=FEntries[i];
|
|
If F.Stream=Nil then
|
|
begin
|
|
If (F.DiskFileName='') then
|
|
Raise EZipError.CreateFmt(SErrMissingFileName,[I]);
|
|
If FindFirst(F.DiskFileName, STDATTR, Info)=0 then
|
|
try
|
|
F.Size:=Info.Size;
|
|
F.DateTime:=FileDateToDateTime(Info.Time);
|
|
{$IFDEF UNIX}
|
|
if fplstat(F.DiskFileName, @UnixInfo) = 0 then
|
|
F.Attributes := UnixInfo.st_mode;
|
|
{$ELSE}
|
|
F.Attributes := Info.Attr;
|
|
{$ENDIF}
|
|
finally
|
|
FindClose(Info);
|
|
end
|
|
else
|
|
Raise EZipError.CreateFmt(SErrFileDoesNotExist,[F.DiskFileName]);
|
|
end
|
|
else
|
|
begin
|
|
If (F.ArchiveFileName='') then
|
|
Raise EZipError.CreateFmt(SErrMissingArchiveName,[I]);
|
|
F.Size:=F.Stream.Size;
|
|
if (F.Attributes = 0) then
|
|
begin
|
|
{$IFDEF UNIX}
|
|
F.Attributes := UNIX_FILE or UNIX_DEFAULT;
|
|
{$ELSE}
|
|
F.Attributes := faArchive;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TZipper.SetEntries(const AValue: TZipFileEntries);
|
|
begin
|
|
if FEntries=AValue then exit;
|
|
FEntries.Assign(AValue);
|
|
end;
|
|
|
|
Function TZipper.OpenInput(Item : TZipFileEntry) : Boolean;
|
|
|
|
Begin
|
|
If (Item.Stream<>nil) then
|
|
FInFile:=Item.Stream
|
|
else
|
|
if Item.IsDirectory then
|
|
FInFile := TStringStream.Create('')
|
|
else
|
|
FInFile:=TFileStream.Create(Item.DiskFileName,fmOpenRead);
|
|
Result:=True;
|
|
If Assigned(FOnStartFile) then
|
|
FOnStartFile(Self,Item.ArchiveFileName);
|
|
End;
|
|
|
|
|
|
Procedure TZipper.CloseInput(Item : TZipFileEntry);
|
|
|
|
Begin
|
|
If (FInFile<>Item.Stream) then
|
|
FreeAndNil(FInFile)
|
|
else
|
|
FinFile:=Nil;
|
|
DoEndOfFile;
|
|
end;
|
|
|
|
|
|
Procedure TZipper.StartZipFile(Item : TZipFileEntry);
|
|
|
|
Begin
|
|
FillChar(LocalHdr,SizeOf(LocalHdr),0);
|
|
FillChar(LocalZip64Fld,SizeOf(LocalZip64Fld),0);
|
|
With LocalHdr do
|
|
begin
|
|
Signature := LOCAL_FILE_HEADER_SIGNATURE;
|
|
Extract_Version_Reqd := 20; //default value, v2.0
|
|
Bit_Flag := 0;
|
|
Compress_Method := 1;
|
|
DateTimeToZipDateTime(Item.DateTime,Last_Mod_Date,Last_Mod_Time);
|
|
Crc32 := 0;
|
|
Compressed_Size := 0;
|
|
LocalZip64Fld.Compressed_Size := 0;
|
|
if Item.Size >= $FFFFFFFF then
|
|
begin
|
|
Uncompressed_Size := $FFFFFFFF;
|
|
LocalZip64Fld.Original_Size := Item.Size;
|
|
end
|
|
else
|
|
begin
|
|
Uncompressed_Size := Item.Size;
|
|
LocalZip64Fld.Original_Size := 0;
|
|
end;
|
|
FileName_Length := 0;
|
|
if (LocalZip64Fld.Original_Size>0) or
|
|
(LocalZip64Fld.Compressed_Size>0) or
|
|
(LocalZip64Fld.Disk_Start_Number>0) or
|
|
(LocalZip64Fld.Relative_Hdr_Offset>0) then
|
|
Extra_Field_Length := SizeOf(LocalZip64ExtHdr) + SizeOf(LocalZip64Fld)
|
|
else
|
|
Extra_Field_Length := 0;
|
|
end;
|
|
End;
|
|
|
|
|
|
function TZipper.UpdateZipHeader(Item: TZipFileEntry; FZip: TStream;
|
|
ACRC: LongWord; AMethod: Word; AZipVersionReqd: Word; AZipBitFlag: Word
|
|
): Boolean;
|
|
// Update header for a single zip file (local header)
|
|
var
|
|
IsZip64 : boolean; //Must the local header be in zip64 format?
|
|
// Separate from zip64 status of entire zip file.
|
|
ZFileName : String;
|
|
Begin
|
|
ZFileName := Item.ArchiveFileName;
|
|
IsZip64 := false;
|
|
With LocalHdr do
|
|
begin
|
|
FileName_Length := Length(ZFileName);
|
|
Crc32 := ACRC;
|
|
if LocalZip64Fld.Original_Size > 0 then
|
|
Result := Not (FZip.Size >= LocalZip64Fld.Original_Size)
|
|
else
|
|
Result := Not (Compressed_Size >= Uncompressed_Size);
|
|
if Item.CompressionLevel=clNone
|
|
then Result:=false; //user wishes override or invalid compression
|
|
If Not Result then
|
|
begin
|
|
Compress_Method := 0; // No use for compression: change storage type & compression size...
|
|
if LocalZip64Fld.Original_Size>0 then
|
|
begin
|
|
IsZip64 := true;
|
|
Compressed_Size := $FFFFFFFF;
|
|
LocalZip64Fld.Compressed_Size := LocalZip64Fld.Original_Size;
|
|
end
|
|
else
|
|
begin
|
|
Compressed_Size := Uncompressed_Size;
|
|
LocalZip64Fld.Compressed_Size := 0;
|
|
end;
|
|
end
|
|
else { Using compression }
|
|
begin
|
|
Compress_method := AMethod;
|
|
Bit_Flag := Bit_Flag or AZipBitFlag;
|
|
if FZip.Size >= $FFFFFFFF then
|
|
begin
|
|
IsZip64 := true;
|
|
Compressed_Size := $FFFFFFFF;
|
|
LocalZip64Fld.Compressed_Size := FZip.Size;
|
|
end
|
|
else
|
|
begin
|
|
Compressed_Size := FZip.Size;
|
|
LocalZip64Fld.Compressed_Size := 0;
|
|
end;
|
|
if AZipVersionReqd > Extract_Version_Reqd then
|
|
Extract_Version_Reqd := AZipVersionReqd;
|
|
end;
|
|
if (IsZip64) and (Extract_Version_Reqd<45) then
|
|
Extract_Version_Reqd := 45;
|
|
end;
|
|
if IsZip64 then
|
|
LocalHdr.Extra_Field_Length:=SizeOf(LocalZip64ExtHdr)+SizeOf(LocalZip64Fld);
|
|
FOutStream.WriteBuffer({$IFDEF ENDIAN_BIG}SwapLFH{$ENDIF}(LocalHdr),SizeOf(LocalHdr));
|
|
// Append extensible field header+zip64 extensible field if needed:
|
|
FOutStream.WriteBuffer(ZFileName[1],Length(ZFileName));
|
|
if IsZip64 then
|
|
begin
|
|
LocalZip64ExtHdr.Header_ID:=ZIP64_HEADER_ID;
|
|
FOutStream.WriteBuffer({$IFDEF ENDIAN_BIG}SwapEDFH{$ENDIF}(LocalZip64ExtHdr),SizeOf(LocalZip64ExtHdr));
|
|
FOutStream.WriteBuffer({$IFDEF ENDIAN_BIG}SwapZ64EIF{$ENDIF}(LocalZip64Fld),SizeOf(LocalZip64Fld));
|
|
end;
|
|
End;
|
|
|
|
|
|
Procedure TZipper.BuildZipDirectory;
|
|
// Write out all central file headers using info from local headers
|
|
Var
|
|
SavePos : Int64;
|
|
HdrPos : Int64; //offset from disk where file begins to local header
|
|
CenDirPos : Int64;
|
|
ACount : QWord; //entry counter
|
|
ZFileName : string; //archive filename
|
|
IsZip64 : boolean; //local header=zip64 format?
|
|
MinReqdVersion: word; //minimum needed to extract
|
|
ExtInfoHeader : Extensible_Data_Field_Header_Type;
|
|
Zip64ECD : Zip64_End_of_Central_Dir_type;
|
|
Zip64ECDL : Zip64_End_of_Central_Dir_Locator_type;
|
|
Begin
|
|
ACount := 0;
|
|
MinReqdVersion:=0;
|
|
CenDirPos := FOutStream.Position;
|
|
FOutStream.Seek(0,soBeginning); { Rewind output file }
|
|
HdrPos := FOutStream.Position;
|
|
FOutStream.ReadBuffer(LocalHdr, SizeOf(LocalHdr));
|
|
{$IFDEF FPC_BIG_ENDIAN}
|
|
LocalHdr := SwapLFH(LocalHdr);
|
|
{$ENDIF}
|
|
Repeat
|
|
SetLength(ZFileName,LocalHdr.FileName_Length);
|
|
FOutStream.ReadBuffer(ZFileName[1], LocalHdr.FileName_Length);
|
|
IsZip64:=(LocalHdr.Compressed_Size=$FFFFFFFF) or (LocalHdr.Uncompressed_Size=$FFFFFFFF) or (HdrPos>=$FFFFFFFF);
|
|
FillChar(LocalZip64Fld,SizeOf(LocalZip64Fld),0); // easier to check compressed length
|
|
if LocalHdr.Extra_Field_Length>0 then
|
|
begin
|
|
SavePos := FOutStream.Position;
|
|
if (IsZip64 and (LocalHdr.Extra_Field_Length>=SizeOf(LocalZip64ExtHdr)+SizeOf(LocalZip64Fld))) then
|
|
while FOutStream.Position<SavePos+LocalHdr.Extra_Field_Length do
|
|
begin
|
|
FOutStream.ReadBuffer(ExtInfoHeader, SizeOf(ExtInfoHeader));
|
|
{$IFDEF FPC_BIG_ENDIAN}
|
|
ExtInfoHeader := SwapEDFH(ExtInfoHeader);
|
|
{$ENDIF}
|
|
if ExtInfoHeader.Header_ID=ZIP64_HEADER_ID then
|
|
begin
|
|
FOutStream.ReadBuffer(LocalZip64Fld, SizeOf(LocalZip64Fld));
|
|
{$IFDEF FPC_BIG_ENDIAN}
|
|
LocalZip64Fld := SwapZ64EIF(LocalZip64Fld);
|
|
{$ENDIF}
|
|
end
|
|
else
|
|
begin
|
|
// Read past non-zip64 extra field
|
|
FOutStream.Seek(ExtInfoHeader.Data_Size,soFromCurrent);
|
|
end;
|
|
end;
|
|
// Move past extra fields
|
|
FOutStream.Seek(SavePos+LocalHdr.Extra_Field_Length,soFromBeginning);
|
|
end;
|
|
SavePos := FOutStream.Position;
|
|
FillChar(CentralHdr,SizeOf(CentralHdr),0);
|
|
With CentralHdr do
|
|
begin
|
|
Signature := CENTRAL_FILE_HEADER_SIGNATURE;
|
|
MadeBy_Version := LocalHdr.Extract_Version_Reqd;
|
|
if (IsZip64) and (MadeBy_Version<45) then
|
|
MadeBy_Version := 45;
|
|
{$IFDEF UNIX}
|
|
{$IFDEF DARWIN} //OSX
|
|
MadeBy_Version := MadeBy_Version or (OS_OSX shl 8);
|
|
{$ELSE}
|
|
MadeBy_Version := MadeBy_Version or (OS_UNIX shl 8);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$IFDEF OS2}
|
|
MadeBy_Version := MadeBy_Version or (OS_OS2 shl 8);
|
|
{$ENDIF}
|
|
{$warning TODO: find a way to recognize VFAT and NTFS}
|
|
// Copy over extract_version_reqd..extra_field_length
|
|
Move(LocalHdr.Extract_Version_Reqd, Extract_Version_Reqd, 26);
|
|
if (IsZip64) and (Extract_Version_Reqd<45) then
|
|
Extract_Version_Reqd := 45;
|
|
// Keep track of the minimum version required to extract
|
|
// zip file as a whole
|
|
if Extract_Version_Reqd>MinReqdVersion then
|
|
MinReqdVersion:=Extract_Version_Reqd;
|
|
Last_Mod_Time:=localHdr.Last_Mod_Time;
|
|
Last_Mod_Date:=localHdr.Last_Mod_Date;
|
|
File_Comment_Length := 0;
|
|
Starting_Disk_Num := 0;
|
|
Internal_Attributes := 0;
|
|
{$IFDEF UNIX}
|
|
External_Attributes := Entries[ACount].Attributes shl 16;
|
|
{$ELSE}
|
|
External_Attributes := Entries[ACount].Attributes;
|
|
{$ENDIF}
|
|
if HdrPos>=$FFFFFFFF then
|
|
begin
|
|
FZipFileNeedsZip64:=true;
|
|
IsZip64:=true;
|
|
Local_Header_offset := $FFFFFFFF;
|
|
// LocalZip64Fld will be written out as central dir extra field later
|
|
LocalZip64Fld.Relative_Hdr_Offset := HdrPos;
|
|
end
|
|
else
|
|
Local_Header_Offset := HdrPos;
|
|
end;
|
|
FOutStream.Seek(0,soEnd);
|
|
FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapCFH{$ENDIF}(CentralHdr),SizeOf(CentralHdr));
|
|
FOutStream.WriteBuffer(ZFileName[1],Length(ZFileName));
|
|
if IsZip64 then
|
|
begin
|
|
FOutStream.Seek(0,soEnd);
|
|
FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapEDFH{$ENDIF}(LocalZip64ExtHdr),SizeOf(LocalZip64ExtHdr));
|
|
FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapZ64EIF{$ENDIF}(LocalZip64Fld),SizeOf(LocalZip64Fld));
|
|
end;
|
|
|
|
Inc(ACount);
|
|
// Move past compressed file data to next header:
|
|
if Iszip64 then
|
|
FOutStream.Seek(SavePos + LocalZip64Fld.Compressed_Size,soBeginning)
|
|
else
|
|
FOutStream.Seek(SavePos + LocalHdr.Compressed_Size,soBeginning);
|
|
HdrPos:=FOutStream.Position;
|
|
FOutStream.ReadBuffer(LocalHdr, SizeOf(LocalHdr));
|
|
{$IFDEF FPC_BIG_ENDIAN}
|
|
LocalHdr := SwapLFH(LocalHdr);
|
|
{$ENDIF}
|
|
Until LocalHdr.Signature = CENTRAL_FILE_HEADER_SIGNATURE ;
|
|
|
|
FOutStream.Seek(0,soEnd);
|
|
FillChar(EndHdr,SizeOf(EndHdr),0);
|
|
|
|
// Write end of central directory record
|
|
// We'll use the zip64 variants to store counts etc
|
|
// and copy to the old record variables if possible
|
|
// This seems to match expected behaviour of unzippers like
|
|
// unrar that only look at the zip64 record
|
|
FillChar(Zip64ECD, SizeOf(Zip64ECD), 0);
|
|
Zip64ECD.Signature:=ZIP64_END_OF_CENTRAL_DIR_SIGNATURE;
|
|
FillChar(Zip64ECDL, SizeOf(Zip64ECDL), 0);
|
|
Zip64ECDL.Signature:=ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIGNATURE;
|
|
Zip64ECDL.Total_Disks:=1; //default and no support for multi disks yet anyway
|
|
With EndHdr do
|
|
begin
|
|
Signature := END_OF_CENTRAL_DIR_SIGNATURE;
|
|
Disk_Number := 0;
|
|
Central_Dir_Start_Disk := 0;
|
|
|
|
Zip64ECD.Entries_This_Disk:=ACount;
|
|
Zip64ECD.Total_Entries:=Acount;
|
|
if ACount>$FFFF then
|
|
begin
|
|
FZipFileNeedsZip64 := true;
|
|
Entries_This_Disk := $FFFF;
|
|
Total_Entries := $FFFF;
|
|
end
|
|
else
|
|
begin
|
|
Entries_This_Disk := Zip64ECD.Entries_This_Disk;
|
|
Total_Entries := Zip64ECD.Total_Entries;
|
|
end;
|
|
|
|
Zip64ECD.Central_Dir_Size := FOutStream.Size-CenDirPos;
|
|
if (Zip64ECD.Central_Dir_Size)>$FFFFFFFF then
|
|
begin
|
|
FZipFileNeedsZip64 := true;
|
|
Central_Dir_Size := $FFFFFFFF;
|
|
end
|
|
else
|
|
begin
|
|
Central_Dir_Size := Zip64ECD.Central_Dir_Size;
|
|
end;
|
|
|
|
Zip64ECD.Start_Disk_Offset := CenDirPos;
|
|
if Zip64ECD.Start_Disk_Offset>$FFFFFFFF then
|
|
begin
|
|
FZipFileNeedsZip64 := true;
|
|
Start_Disk_Offset := $FFFFFFFF;
|
|
end
|
|
else
|
|
begin
|
|
Start_Disk_Offset := Zip64ECD.Start_Disk_Offset;
|
|
end;
|
|
|
|
ZipFile_Comment_Length := Length(FFileComment);
|
|
|
|
if FZipFileNeedsZip64 then
|
|
begin
|
|
//Write zip64 end of central directory record if needed
|
|
if MinReqdVersion<45 then
|
|
MinReqdVersion := 45;
|
|
Zip64ECD.Extract_Version_Reqd := MinReqdVersion;
|
|
Zip64ECD.Version_Made_By := MinReqdVersion;
|
|
Zip64ECD.Record_Size := SizeOf(Zip64ECD)-12; //Assumes no variable length field following
|
|
Zip64ECDL.Central_Dir_Zip64_EOCD_Offset := FOutStream.Position;
|
|
Zip64ECDL.Zip64_EOCD_Start_Disk := 0;
|
|
FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapZ64ECD{$ENDIF}(Zip64ECD), SizeOf(Zip64ECD));
|
|
|
|
//Write zip64 end of central directory locator if needed
|
|
FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapZ64ECDL{$ENDIF}(Zip64ECDL), SizeOf(Zip64ECDL));
|
|
end;
|
|
|
|
FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapECD{$ENDIF}(EndHdr), SizeOf(EndHdr));
|
|
if Length(FFileComment) > 0 then
|
|
FOutStream.WriteBuffer(FFileComment[1],Length(FFileComment));
|
|
end;
|
|
end;
|
|
|
|
Function TZipper.CreateCompressor(Item : TZipFileEntry; AInFile,AZipStream : TStream) : TCompressor;
|
|
|
|
begin
|
|
Result:=TDeflater.Create(AinFile,AZipStream,FBufSize);
|
|
(Result as TDeflater).CompressionLevel:=Item.CompressionLevel;
|
|
FCurrentCompressor:=Result;
|
|
end;
|
|
|
|
Procedure TZipper.ZipOneFile(Item : TZipFileEntry);
|
|
|
|
Var
|
|
CRC : LongWord;
|
|
ZMethod : Word;
|
|
ZVersionReqd : Word;
|
|
ZBitFlag : Word;
|
|
ZipStream : TStream;
|
|
TmpFileName : String;
|
|
|
|
Begin
|
|
OpenInput(Item);
|
|
Try
|
|
StartZipFile(Item);
|
|
If (FInfile.Size<=FInMemSize) then
|
|
ZipStream:=TMemoryStream.Create
|
|
else
|
|
begin
|
|
TmpFileName:=ChangeFileExt(FFileName,'.tmp');
|
|
if TmpFileName=FFileName then
|
|
TmpFileName:=TmpFileName+'.tmp';
|
|
ZipStream:=TFileStream.Create(TmpFileName,fmCreate);
|
|
end;
|
|
Try
|
|
With CreateCompressor(Item, FinFile,ZipStream) do
|
|
Try
|
|
OnProgress:=Self.OnProgress;
|
|
OnPercent:=Self.OnPercent;
|
|
Compress;
|
|
CRC:=Crc32Val;
|
|
ZMethod:=ZipID;
|
|
ZVersionReqd:=ZipVersionReqd;
|
|
ZBitFlag:=ZipBitFlag;
|
|
Finally
|
|
FCurrentCompressor:=Nil;
|
|
Free;
|
|
end;
|
|
If UpdateZipHeader(Item,ZipStream,CRC,ZMethod,ZVersionReqd,ZBitFlag) then
|
|
// Compressed file smaller than original file.
|
|
FOutStream.CopyFrom(ZipStream,0)
|
|
else
|
|
begin
|
|
// Original file smaller than compressed file.
|
|
FInfile.Seek(0,soBeginning);
|
|
FOutStream.CopyFrom(FInFile,0);
|
|
end;
|
|
finally
|
|
ZipStream.Free;
|
|
If (TmpFileName<>'') then
|
|
DeleteFile(TmpFileName);
|
|
end;
|
|
Finally
|
|
CloseInput(Item);
|
|
end;
|
|
end;
|
|
|
|
// Just like SaveToFile, but uses the FileName property
|
|
Procedure TZipper.ZipAllFiles;
|
|
begin
|
|
SaveToFile(FileName);
|
|
end;
|
|
|
|
procedure TZipper.SaveToFile(AFileName: RawByteString);
|
|
var
|
|
lStream: TFileStream;
|
|
begin
|
|
FFileName:=AFileName;
|
|
lStream:=TFileStream.Create(FFileName,fmCreate);
|
|
try
|
|
SaveToStream(lStream);
|
|
finally
|
|
FreeAndNil(lStream);
|
|
end;
|
|
end;
|
|
|
|
procedure TZipper.SaveToStream(AStream: TStream);
|
|
Var
|
|
I : integer; //could be qword but limited by FEntries.Count
|
|
begin
|
|
FTerminated:=False;
|
|
FOutStream := AStream;
|
|
If CheckEntries=0 then
|
|
Exit;
|
|
FZipping:=True;
|
|
Try
|
|
GetFileInfo; //get info on file entries in zip
|
|
I:=0;
|
|
While (I<FEntries.Count) and not Terminated do
|
|
begin
|
|
ZipOneFile(FEntries[i]);
|
|
Inc(I);
|
|
end;
|
|
if (FEntries.Count>0) and not Terminated then
|
|
BuildZipDirectory;
|
|
finally
|
|
FZipping:=False;
|
|
// Remove entries that have been added by CheckEntries from Files.
|
|
for I:=0 to FFiles.Count-1 do
|
|
FEntries.Delete(FEntries.Count-1);
|
|
end;
|
|
end;
|
|
|
|
|
|
Procedure TZipper.SetBufSize(Value : LongWord);
|
|
|
|
begin
|
|
If FZipping then
|
|
Raise EZipError.Create(SErrBufsizeChange);
|
|
If Value>=DefaultBufSize then
|
|
FBufSize:=Value;
|
|
end;
|
|
|
|
Procedure TZipper.SetFileName(Value : RawByteString);
|
|
|
|
begin
|
|
If FZipping then
|
|
Raise EZipError.Create(SErrFileChange);
|
|
FFileName:=Value;
|
|
end;
|
|
|
|
Procedure TZipper.ZipFiles(AFileName : RawByteString; FileList : TStrings);
|
|
|
|
begin
|
|
FFileName:=AFileName;
|
|
ZipFiles(FileList);
|
|
end;
|
|
|
|
procedure TZipper.ZipFiles(FileList: TStrings);
|
|
begin
|
|
FFiles.Assign(FileList);
|
|
ZipAllFiles;
|
|
end;
|
|
|
|
procedure TZipper.ZipFiles(AFileName: RawByteString; Entries: TZipFileEntries);
|
|
begin
|
|
FFileName:=AFileName;
|
|
ZipFiles(Entries);
|
|
end;
|
|
|
|
procedure TZipper.ZipFiles(Entries: TZipFileEntries);
|
|
begin
|
|
FEntries.Assign(Entries);
|
|
ZipAllFiles;
|
|
end;
|
|
|
|
Procedure TZipper.DoEndOfFile;
|
|
|
|
Var
|
|
ComprPct : Double;
|
|
|
|
begin
|
|
if (FZipFileNeedsZip64) and (LocalZip64Fld.Original_Size>0) then
|
|
ComprPct := (100.0 * (LocalZip64Fld.Original_size - LocalZip64Fld.Compressed_Size)) / LocalZip64Fld.Original_Size
|
|
else if (LocalHdr.Uncompressed_Size>0) then
|
|
ComprPct := (100.0 * (LocalHdr.Uncompressed_Size - LocalHdr.Compressed_Size)) / LocalHdr.Uncompressed_Size
|
|
else
|
|
ComprPct := 0;
|
|
If Assigned(FOnEndOfFile) then
|
|
FOnEndOfFile(Self,ComprPct);
|
|
end;
|
|
|
|
Constructor TZipper.Create;
|
|
|
|
begin
|
|
FBufSize:=DefaultBufSize;
|
|
FInMemSize:=DefaultInMemSize;
|
|
FFiles:=TStringList.Create;
|
|
FEntries:=TZipFileEntries.Create(TZipFileEntry);
|
|
FOnPercent:=1;
|
|
FZipFileNeedsZip64:=false;
|
|
LocalZip64ExtHdr.Header_ID:=ZIP64_HEADER_ID;
|
|
LocalZip64ExtHdr.Data_Size:=SizeOf(Zip64_Extended_Info_Field_Type);
|
|
end;
|
|
|
|
Function TZipper.CheckEntries : Integer;
|
|
|
|
Var
|
|
I : integer; //Could be QWord but limited by FFiles.Count
|
|
|
|
begin
|
|
for I:=0 to FFiles.Count-1 do
|
|
FEntries.AddFileEntry(FFiles[i]);
|
|
|
|
// Use zip64 when number of file entries
|
|
// or individual (un)compressed sizes
|
|
// require it.
|
|
if FEntries.Count >= $FFFF then
|
|
FZipFileNeedsZip64:=true;
|
|
|
|
if not(FZipFileNeedsZip64) then
|
|
begin
|
|
for I:=0 to FFiles.Count-1 do
|
|
begin
|
|
if FEntries[i].FNeedsZip64 then
|
|
begin
|
|
FZipFileNeedsZip64:=true;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
Result:=FEntries.Count;
|
|
end;
|
|
|
|
|
|
Procedure TZipper.Clear;
|
|
|
|
begin
|
|
FEntries.Clear;
|
|
FFiles.Clear;
|
|
end;
|
|
|
|
procedure TZipper.Terminate;
|
|
begin
|
|
FTerminated:=True;
|
|
if Assigned(FCurrentCompressor) then
|
|
FCurrentCompressor.Terminate;
|
|
end;
|
|
|
|
Destructor TZipper.Destroy;
|
|
|
|
begin
|
|
Clear;
|
|
FreeAndNil(FEntries);
|
|
FreeAndNil(FFiles);
|
|
Inherited;
|
|
end;
|
|
|
|
{ ---------------------------------------------------------------------
|
|
TUnZipper
|
|
---------------------------------------------------------------------}
|
|
|
|
procedure TUnZipper.OpenInput;
|
|
|
|
Begin
|
|
if Assigned(FOnOpenInputStream) then
|
|
FOnOpenInputStream(Self, FZipStream);
|
|
if FZipStream = nil then
|
|
FZipStream:=TFileStream.Create(FFileName,fmOpenRead or fmShareDenyWrite);
|
|
End;
|
|
|
|
|
|
function TUnZipper.OpenOutput(OutFileName: RawByteString;
|
|
out OutStream: TStream; Item: TFullZipFileEntry): Boolean;
|
|
Var
|
|
Path: RawByteString;
|
|
OldDirectorySeparators: set of char;
|
|
|
|
Begin
|
|
{ the default RTL behavior is broken on Unix platforms
|
|
for Windows compatibility: it allows both '/' and '\'
|
|
as directory separator. We don't want that behavior
|
|
here, since 'abc\' is a valid file name under Unix.
|
|
|
|
The zip standard appnote.txt says zip files must have '/' as path
|
|
separator, even on Windows: 4.4.17.1:
|
|
"The path stored MUST not contain a drive or device letter, or a leading
|
|
slash. All slashes MUST be forward slashes '/' as opposed to backwards
|
|
slashes '\'" See also mantis issue #15836
|
|
However, old versions of FPC on Windows (and possibly other utilities)
|
|
created incorrect zip files with \ separator, so accept these as well as
|
|
they're not valid in Windows file names anyway.
|
|
}
|
|
OldDirectorySeparators:=AllowDirectorySeparators;
|
|
{$ifdef Windows}
|
|
// Explicitly allow / and \ regardless of what Windows supports
|
|
AllowDirectorySeparators:=['\','/'];
|
|
{$else}
|
|
// Follow the standard: only allow / regardless of actual separator on OS
|
|
AllowDirectorySeparators:=['/'];
|
|
{$endif}
|
|
Path:=ExtractFilePath(OutFileName);
|
|
OutStream:=Nil;
|
|
If Assigned(FOnCreateStream) then
|
|
FOnCreateStream(Self, OutStream, Item);
|
|
// If FOnCreateStream didn't create one, we create one now.
|
|
If (OutStream=Nil) then
|
|
begin
|
|
if (Path<>'') then
|
|
ForceDirectories(Path);
|
|
AllowDirectorySeparators:=OldDirectorySeparators;
|
|
OutStream:=TFileStream.Create(OutFileName,fmCreate);
|
|
|
|
end;
|
|
|
|
AllowDirectorySeparators:=OldDirectorySeparators;
|
|
Result:=True;
|
|
If Assigned(FOnStartFile) then
|
|
FOnStartFile(Self,OutFileName);
|
|
End;
|
|
|
|
|
|
procedure TUnZipper.CloseOutput(Item: TFullZipFileEntry; var OutStream: TStream
|
|
);
|
|
|
|
Begin
|
|
if Assigned(FOnDoneStream) then
|
|
begin
|
|
FOnDoneStream(Self, OutStream, Item);
|
|
OutStream := nil;
|
|
end
|
|
else
|
|
FreeAndNil(OutStream);
|
|
DoEndOfFile;
|
|
end;
|
|
|
|
|
|
procedure TUnZipper.CloseInput;
|
|
|
|
Begin
|
|
if Assigned(FOnCloseInputStream) then
|
|
FOnCloseInputStream(Self, FZipStream);
|
|
FreeAndNil(FZipStream);
|
|
end;
|
|
|
|
|
|
procedure TUnZipper.ReadZipHeader(Item: TFullZipFileEntry; out AMethod: Word);
|
|
Var
|
|
S : String;
|
|
U : UTF8String;
|
|
D : TDateTime;
|
|
ExtraFieldHdr: Extensible_Data_Field_Header_Type;
|
|
SavePos: int64; //could be qword but limited by stream
|
|
// Infozip unicode path
|
|
Infozip_Unicode_Path_Ver:Byte;
|
|
Infozip_Unicode_Path_CRC32:DWord;
|
|
Begin
|
|
FZipStream.Seek(Item.HdrPos,soBeginning);
|
|
FZipStream.ReadBuffer(LocalHdr,SizeOf(LocalHdr));
|
|
{$IFDEF FPC_BIG_ENDIAN}
|
|
LocalHdr := SwapLFH(LocalHdr);
|
|
{$ENDIF}
|
|
FillChar(LocalZip64Fld,SizeOf(LocalZip64Fld),0); //ensure no erroneous info
|
|
With LocalHdr do
|
|
begin
|
|
Item.FBitFlags:=Bit_Flag;
|
|
SetLength(S,Filename_Length);
|
|
FZipStream.ReadBuffer(S[1],Filename_Length);
|
|
Item.ArchiveFileName:=S;
|
|
Item.DiskFileName:=S;
|
|
SavePos:=FZipStream.Position; //after filename, before extra fields
|
|
if Extra_Field_Length>0 then
|
|
begin
|
|
SavePos := FZipStream.Position;
|
|
if (LocalHdr.Extra_Field_Length>=SizeOf(ExtraFieldHdr)) then
|
|
while FZipStream.Position<SavePos+LocalHdr.Extra_Field_Length do
|
|
begin
|
|
FZipStream.ReadBuffer(ExtraFieldHdr, SizeOf(ExtraFieldHdr));
|
|
{$IFDEF FPC_BIG_ENDIAN}
|
|
ExtraFieldHdr := SwapEDFH(ExtraFieldHdr);
|
|
{$ENDIF}
|
|
if ExtraFieldHdr.Header_ID=ZIP64_HEADER_ID then
|
|
begin
|
|
FZipStream.ReadBuffer(LocalZip64Fld, SizeOf(LocalZip64Fld));
|
|
{$IFDEF FPC_BIG_ENDIAN}
|
|
LocalZip64Fld := SwapZ64EIF(LocalZip64Fld);
|
|
{$ENDIF}
|
|
end
|
|
// Infozip unicode path
|
|
else if ExtraFieldHdr.Header_ID=INFOZIP_UNICODE_PATH_ID then
|
|
begin
|
|
FZipStream.ReadBuffer(Infozip_Unicode_Path_Ver,1);
|
|
if Infozip_Unicode_Path_Ver=1 then
|
|
begin
|
|
FZipStream.ReadBuffer(Infozip_Unicode_Path_CRC32,sizeof(Infozip_Unicode_Path_CRC32));
|
|
{$IFDEF FPC_BIG_ENDIAN}
|
|
Infozip_Unicode_Path_CRC32:=SwapEndian(Infozip_Unicode_Path_CRC32);
|
|
{$ENDIF}
|
|
if CRC32Str(S)=Infozip_Unicode_Path_CRC32 then
|
|
begin
|
|
SetLength(U,ExtraFieldHdr.Data_Size-5);
|
|
FZipStream.ReadBuffer(U[1],Length(U));
|
|
Item.UTF8ArchiveFileName:=U;
|
|
Item.UTF8DiskFileName:=U;
|
|
end
|
|
else
|
|
FZipStream.Seek(ExtraFieldHdr.Data_Size-5,soFromCurrent);
|
|
end
|
|
else
|
|
FZipStream.Seek(ExtraFieldHdr.Data_Size-1,soFromCurrent);
|
|
end
|
|
else
|
|
FZipStream.Seek(ExtraFieldHdr.Data_Size,soFromCurrent);
|
|
end;
|
|
// Move past extra fields
|
|
FZipStream.Seek(SavePos+Extra_Field_Length,soFromBeginning);
|
|
end;
|
|
Item.Size:=Uncompressed_Size;
|
|
ZipDateTimeToDateTime(Last_Mod_Date,Last_Mod_Time,D);
|
|
Item.DateTime:=D;
|
|
if Crc32 <> 0 then
|
|
Item.CRC32 := Crc32;
|
|
AMethod:=Compress_method;
|
|
end;
|
|
End;
|
|
|
|
procedure TUnZipper.FindEndHeaders(
|
|
out AEndHdr: End_of_Central_Dir_Type;
|
|
out AEndHdrPos: Int64;
|
|
out AEndZip64Hdr: Zip64_End_of_Central_Dir_type;
|
|
out AEndZip64HdrPos: Int64);
|
|
// Reads backwords from the end of the zip file,
|
|
// following end of central directory, and, if present
|
|
// zip64 end of central directory locator and
|
|
// zip64 end of central directory record
|
|
|
|
// If valid regular end of directory found, AEndHdrPos>0
|
|
// If valid zip64 end of directory found, AEndZip64HdrPos>0
|
|
var
|
|
EndZip64Locator: Zip64_End_of_Central_Dir_Locator_type;
|
|
procedure SearchForSignature;
|
|
// Search for end of central directory record signature
|
|
// If failed, set AEndHdrPos to 0
|
|
var
|
|
I: Integer;
|
|
Buf: PByte;
|
|
BufSize: Integer;
|
|
result: boolean;
|
|
begin
|
|
result:=false;
|
|
// scan the last (64k + something) bytes for the END_OF_CENTRAL_DIR_SIGNATURE
|
|
// (zip file comments are 64k max).
|
|
BufSize := 65536 + SizeOf(AEndHdr) + 128;
|
|
if FZipStream.Size < BufSize then
|
|
BufSize := FZipStream.Size;
|
|
|
|
Buf := GetMem(BufSize);
|
|
try
|
|
FZipStream.Seek(FZipStream.Size - BufSize, soBeginning);
|
|
FZipStream.ReadBuffer(Buf^, BufSize);
|
|
|
|
for I := BufSize - SizeOf(AEndHdr) downto 0 do
|
|
begin
|
|
if (Buf[I] or (Buf[I + 1] shl 8) or (Buf[I + 2] shl 16) or (Buf[I + 3] shl 24)) = END_OF_CENTRAL_DIR_SIGNATURE then
|
|
begin
|
|
Move(Buf[I], AEndHdr, SizeOf(AEndHdr));
|
|
{$IFDEF FPC_BIG_ENDIAN}
|
|
AEndHdr := SwapECD(AEndHdr);
|
|
{$ENDIF}
|
|
if (AEndHdr.Signature = END_OF_CENTRAL_DIR_SIGNATURE) and
|
|
(I + SizeOf(AEndHdr) + AEndHdr.ZipFile_Comment_Length = BufSize) then
|
|
begin
|
|
AEndHdrPos := FZipStream.Size - BufSize + I;
|
|
FZipStream.Seek(AEndHdrPos + SizeOf(AEndHdr), soBeginning);
|
|
SetLength(FFileComment, AEndHdr.ZipFile_Comment_Length);
|
|
FZipStream.ReadBuffer(FFileComment[1], Length(FFileComment));
|
|
result:=true; //found it
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
FreeMem(Buf);
|
|
end;
|
|
if not(result) then
|
|
begin
|
|
AEndHdrPos := 0;
|
|
FillChar(AEndHdr, SizeOf(AEndHdr), 0);
|
|
end;
|
|
end;
|
|
|
|
procedure ZeroData;
|
|
begin
|
|
AEndHdrPos := 0;
|
|
FillChar(AEndHdr, SizeOf(AEndHdr), 0);
|
|
AEndZip64HdrPos:=0;
|
|
FillChar(AEndZip64Hdr, SizeOf(AEndZip64Hdr), 0);
|
|
end;
|
|
|
|
begin
|
|
// Zip64 records may not exist, so fill out default values
|
|
FillChar(AEndZip64Hdr,SizeOf(AEndZip64Hdr), 0);
|
|
AEndZip64HdrPos:=0;
|
|
// Look for end of central directory record from
|
|
// back of file based on signature (only way due to
|
|
// variable length zip comment etc)
|
|
FFileComment := '';
|
|
// Zip file requires end of central dir header so
|
|
// is corrupt if it is smaller than that
|
|
if FZipStream.Size < SizeOf(AEndHdr) then
|
|
begin
|
|
ZeroData;
|
|
exit;
|
|
end;
|
|
|
|
AEndHdrPos := FZipStream.Size - SizeOf(AEndHdr);
|
|
FZipStream.Seek(AEndHdrPos, soBeginning);
|
|
FZipStream.ReadBuffer(AEndHdr, SizeOf(AEndHdr));
|
|
{$IFDEF FPC_BIG_ENDIAN}
|
|
AEndHdr := SwapECD(AEndHdr);
|
|
{$ENDIF}
|
|
// Search unless record is right at the end of the file:
|
|
if (AEndHdr.Signature <> END_OF_CENTRAL_DIR_SIGNATURE) or
|
|
(AEndHdr.ZipFile_Comment_Length <> 0) then
|
|
SearchForSignature;
|
|
if AEndHdrPos=0 then
|
|
begin
|
|
ZeroData;
|
|
exit;
|
|
end;
|
|
|
|
// With a valid end of dir record, see if there's zip64
|
|
// fields:
|
|
FZipStream.Seek(AEndHdrPos-SizeOf(Zip64_End_of_Central_Dir_Locator_type),soBeginning);
|
|
FZipStream.ReadBuffer(EndZip64Locator, SizeOf(EndZip64Locator));
|
|
{$IFDEF FPC_BIG_ENDIAN}
|
|
EndZip64Locator := SwapZ64ECDL(EndZip64Locator);
|
|
{$ENDIF}
|
|
if EndZip64Locator.Signature=ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIGNATURE then
|
|
begin
|
|
//Read EndZip64Locator.Total_Disks when implementing multiple disks support
|
|
if EndZip64Locator.Central_Dir_Zip64_EOCD_Offset>High(Int64) then
|
|
raise EZipError.CreateFmt(SErrPosTooLarge,[EndZip64Locator.Central_Dir_Zip64_EOCD_Offset,High(Int64)]);
|
|
AEndZip64HdrPos:=EndZip64Locator.Central_Dir_Zip64_EOCD_Offset;
|
|
FZipStream.Seek(AEndZip64HdrPos, soBeginning);
|
|
FZipStream.ReadBuffer(AEndZip64Hdr, SizeOf(AEndZip64Hdr));
|
|
{$IFDEF FPC_BIG_ENDIAN}
|
|
AEndZip64Hdr := SwapZ64ECD(AEndZip64Hdr);
|
|
{$ENDIF}
|
|
if AEndZip64Hdr.Signature<>ZIP64_END_OF_CENTRAL_DIR_SIGNATURE then
|
|
begin
|
|
//Corrupt header
|
|
ZeroData;
|
|
Exit;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
// No zip64 data, so follow the offset in the end of central directory record
|
|
AEndZip64HdrPos:=0;
|
|
FillChar(AEndZip64Hdr, SizeOf(AEndZip64Hdr), 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TUnZipper.ReadZipDirectory;
|
|
|
|
Var
|
|
EndHdr : End_of_Central_Dir_Type;
|
|
EndZip64Hdr : Zip64_End_of_Central_Dir_type;
|
|
i : integer; //could be Qword but limited to number of items in collection
|
|
EndHdrPos,
|
|
EndZip64HdrPos,
|
|
CenDirPos,
|
|
SavePos : Int64; //could be QWord but limited to stream maximums
|
|
ExtraFieldHeader : Extensible_Data_Field_Header_Type;
|
|
EntriesThisDisk : QWord;
|
|
Zip64Field: Zip64_Extended_Info_Field_Type;
|
|
NewNode : TFullZipFileEntry;
|
|
D : TDateTime;
|
|
S : String;
|
|
U : UTF8String;
|
|
// infozip unicode path
|
|
Infozip_unicode_path_ver : byte; // always 1
|
|
Infozip_unicode_path_crc32 : DWord;
|
|
Begin
|
|
FindEndHeaders(EndHdr, EndHdrPos,
|
|
EndZip64Hdr, EndZip64HdrPos);
|
|
if EndHdrPos=0 then
|
|
raise EZipError.CreateFmt(SErrCorruptZIP,[FileName]);
|
|
if (EndZip64HdrPos>0) and (EndZip64Hdr.Start_Disk_Offset>0) then
|
|
begin
|
|
if EndZip64Hdr.Start_Disk_Offset>High(Int64) then
|
|
raise EZipError.CreateFmt(SErrPosTooLarge,[EndZip64Hdr.Start_Disk_Offset,High(Int64)]);
|
|
CenDirPos := EndZip64Hdr.Start_Disk_Offset;
|
|
end
|
|
else
|
|
CenDirPos := EndHdr.Start_Disk_Offset;
|
|
FZipStream.Seek(CenDirPos,soBeginning);
|
|
FEntries.Clear;
|
|
if (EndZip64HdrPos>0) and (EndZip64Hdr.Entries_This_Disk>0) then
|
|
begin
|
|
EntriesThisDisk := EndZip64Hdr.Entries_This_Disk;
|
|
if EntriesThisDisk<>EndZip64Hdr.Total_Entries then
|
|
raise EZipError.Create(SErrUnsupportedMultipleDisksCD);
|
|
end
|
|
else
|
|
begin
|
|
EntriesThisDisk :=EndHdr.Entries_This_Disk;
|
|
if EntriesThisDisk<>EndHdr.Total_Entries then
|
|
raise EZipError.Create(SErrUnsupportedMultipleDisksCD);
|
|
end;
|
|
|
|
// Entries are added to a collection. The max number of items
|
|
// in a collection limits the entries we can process.
|
|
if EntriesThisDisk>MaxInt then
|
|
raise EZipError.CreateFmt(SErrMaxEntries,[EntriesThisDisk,MaxInt]);
|
|
|
|
// Using while instead of for loop so qword can be used on 32 bit as well.
|
|
for i:=0 to EntriesThisDisk-1 do
|
|
begin
|
|
FZipStream.ReadBuffer(CentralHdr, SizeOf(CentralHdr));
|
|
{$IFDEF FPC_BIG_ENDIAN}
|
|
CentralHdr := SwapCFH(CentralHdr);
|
|
{$ENDIF}
|
|
With CentralHdr do
|
|
begin
|
|
if Signature<>CENTRAL_FILE_HEADER_SIGNATURE then
|
|
raise EZipError.CreateFmt(SErrCorruptZIP,[FileName]);
|
|
NewNode:=FEntries.Add as TFullZipFileEntry;
|
|
// Header position will be corrected later with zip64 version, if needed..
|
|
NewNode.HdrPos := Local_Header_Offset;
|
|
NewNode.FBitFlags:=Bit_Flag;
|
|
SetLength(S,Filename_Length);
|
|
FZipStream.ReadBuffer(S[1],Filename_Length);
|
|
SavePos:=FZipStream.Position; //After fixed part of central directory...
|
|
// and the filename; before any extra field(s)
|
|
NewNode.ArchiveFileName:=S;
|
|
// Size/compressed size will be adjusted by zip64 entries if needed...
|
|
NewNode.Size:=Uncompressed_Size;
|
|
NewNode.FCompressedSize:=Compressed_Size;
|
|
NewNode.CRC32:=CRC32;
|
|
NewNode.OS := MadeBy_Version shr 8;
|
|
if NewNode.OS = OS_UNIX then
|
|
NewNode.Attributes := External_Attributes shr 16
|
|
else
|
|
NewNode.Attributes := External_Attributes;
|
|
ZipDateTimeToDateTime(Last_Mod_Date,Last_Mod_Time,D);
|
|
NewNode.DateTime:=D;
|
|
|
|
// Go through any extra fields and extract any zip64 info
|
|
if Extra_Field_Length>0 then
|
|
begin
|
|
while (FZipStream.Position<SavePos+Extra_Field_Length) do
|
|
begin
|
|
FZipStream.ReadBuffer(ExtraFieldHeader, SizeOf(ExtraFieldHeader));
|
|
{$IFDEF FPC_BIG_ENDIAN}
|
|
ExtraFieldHeader := SwapEDFH(ExtraFieldHeader);
|
|
{$ENDIF}
|
|
if ExtraFieldHeader.Header_ID = ZIP64_HEADER_ID then
|
|
begin
|
|
FZipStream.ReadBuffer(Zip64Field, SizeOf(Zip64Field));
|
|
{$IFDEF FPC_BIG_ENDIAN}
|
|
Zip64Field := SwapZ64EIF(Zip64Field);
|
|
{$ENDIF}
|
|
if Zip64Field.Compressed_Size > 0 then
|
|
NewNode.FCompressedSize := Zip64Field.Compressed_Size;
|
|
if Zip64Field.Original_Size>0 then
|
|
NewNode.Size := Zip64Field.Original_Size;
|
|
if Zip64Field.Relative_Hdr_Offset<>0 then
|
|
begin
|
|
if Zip64Field.Relative_Hdr_Offset>High(Int64) then
|
|
raise EZipError.CreateFmt(SErrPosTooLarge,[Zip64Field.Relative_Hdr_Offset,High(Int64)]);
|
|
NewNode.HdrPos := Zip64Field.Relative_Hdr_Offset;
|
|
end;
|
|
end
|
|
// infozip unicode path extra field
|
|
else if ExtraFieldHeader.Header_ID = INFOZIP_UNICODE_PATH_ID then
|
|
begin
|
|
FZipStream.ReadBuffer(Infozip_unicode_path_ver,1);
|
|
if Infozip_unicode_path_ver=1 then
|
|
begin
|
|
FZipStream.ReadBuffer(Infozip_unicode_path_crc32,sizeof(Infozip_unicode_path_crc32));
|
|
{$IFDEF FPC_BIG_ENDIAN}
|
|
Infozip_unicode_path_crc32:=SwapEndian(Infozip_unicode_path_crc32);
|
|
{$ENDIF}
|
|
if CRC32Str(S)=Infozip_unicode_path_crc32 then
|
|
begin
|
|
SetLength(U,ExtraFieldHeader.Data_Size-5);
|
|
FZipStream.ReadBuffer(U[1],Length(U));
|
|
NewNode.UTF8ArchiveFileName:=U;
|
|
end
|
|
else
|
|
FZipStream.Seek(ExtraFieldHeader.Data_Size-5,soFromCurrent);
|
|
end
|
|
else
|
|
FZipStream.Seek(ExtraFieldHeader.Data_Size-1,soFromCurrent);
|
|
end
|
|
else
|
|
begin
|
|
// Read past non-Zip64 extra field
|
|
FZipStream.Seek(ExtraFieldHeader.Data_Size,soFromCurrent);
|
|
end;
|
|
end;
|
|
end;
|
|
// Move past extra fields and file comment to next header
|
|
FZipStream.Seek(SavePos+Extra_Field_Length+File_Comment_Length,soFromBeginning);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TUnZipper.CreateDeCompressor(Item: TZipFileEntry; AMethod: Word;
|
|
AZipFile, AOutFile: TStream): TDeCompressor;
|
|
begin
|
|
case AMethod of
|
|
8 :
|
|
Result:=TInflater.Create(AZipFile,AOutFile,FBufSize);
|
|
else
|
|
raise EZipError.CreateFmt(SErrUnsupportedCompressionFormat,[AMethod]);
|
|
end;
|
|
FCurrentDecompressor:=Result;
|
|
end;
|
|
|
|
procedure TUnZipper.UnZipOneFile(Item: TFullZipFileEntry);
|
|
|
|
Var
|
|
ZMethod : Word;
|
|
{$ifdef unix}
|
|
LinkTargetStream: TStringStream;
|
|
{$endif}
|
|
OutputFileName: RawByteString;
|
|
FOutStream: TStream;
|
|
IsLink: Boolean;
|
|
IsCustomStream: Boolean;
|
|
U : UnicodeString;
|
|
|
|
Procedure SetAttributes;
|
|
Var
|
|
Attrs : Longint;
|
|
begin
|
|
// set attributes
|
|
FileSetDate(OutputFileName, DateTimeToFileDate(Item.DateTime));
|
|
if (Item.Attributes <> 0) then
|
|
begin
|
|
Attrs := 0;
|
|
{$IFDEF UNIX}
|
|
if (Item.OS in [OS_UNIX,OS_OSX]) then Attrs := Item.Attributes;
|
|
if (Item.OS in [OS_FAT,OS_NTFS,OS_OS2,OS_VFAT]) then
|
|
Attrs := ZipFatAttrsToUnixAttrs(Item.Attributes);
|
|
{$ELSE}
|
|
if (Item.OS in [OS_FAT,OS_NTFS,OS_OS2,OS_VFAT]) then Attrs := Item.Attributes;
|
|
if (Item.OS in [OS_UNIX,OS_OSX]) then
|
|
Attrs := ZipUnixAttrsToFatAttrs(ExtractFileName(Item.ArchiveFileName), Item.Attributes);
|
|
{$ENDIF}
|
|
if Attrs <> 0 then
|
|
begin
|
|
{$IFDEF UNIX}
|
|
FpChmod(OutputFileName, Attrs);
|
|
{$ELSE}
|
|
FileSetAttr(OutputFileName, Attrs);
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure DoUnzip(const Dest: TStream);
|
|
|
|
begin
|
|
if ZMethod=0 then
|
|
begin
|
|
if (LocalHdr.Compressed_Size<>0) then
|
|
begin
|
|
if LocalZip64Fld.Compressed_Size>0 then
|
|
Dest.CopyFrom(FZipStream,LocalZip64Fld.Compressed_Size)
|
|
else
|
|
Dest.CopyFrom(FZipStream,LocalHdr.Compressed_Size);
|
|
{$warning TODO: Implement CRC Check}
|
|
end;
|
|
end
|
|
else
|
|
With CreateDecompressor(Item, ZMethod, FZipStream, Dest) do
|
|
Try
|
|
FTotPos := Self.FTotPos;
|
|
FTotSize := Self.FTotSize;
|
|
OnProgress:=Self.OnProgress;
|
|
OnProgressEx := Self.OnProgressEx;
|
|
OnPercent:=Self.OnPercent;
|
|
OnProgress:=Self.OnProgress;
|
|
OnPercent:=Self.OnPercent;
|
|
DeCompress;
|
|
Self.FTotPos := FTotPos;
|
|
if Item.CRC32 <> Crc32Val then
|
|
raise EZipError.CreateFmt(SErrInvalidCRC,[Item.ArchiveFileName]);
|
|
Finally
|
|
FCurrentDecompressor:=Nil;
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
Procedure GetOutputFileName;
|
|
|
|
Var
|
|
I : Integer;
|
|
|
|
begin
|
|
if Not UseUTF8 then
|
|
OutputFileName:=StringReplace(Item.DiskFileName,'/',DirectorySeparator,[rfReplaceAll])
|
|
else
|
|
begin
|
|
// Sets codepage.
|
|
OutputFileName:=Item.UTF8DiskFileName;
|
|
U:=UTF8Decode(OutputFileName);
|
|
// Do not use stringreplace, it will mess up the codepage.
|
|
if '/'<>DirectorySeparator then
|
|
For I:=1 to Length(U) do
|
|
if U[i]='/' then
|
|
U[i]:=DirectorySeparator;
|
|
OutputFileName:=UTF8Encode(U);
|
|
end;
|
|
if (Not IsCustomStream) and (FOutputPath<>'') then
|
|
begin
|
|
// Do not use IncludeTrailingPathdelimiter
|
|
OutputFileName:=FOutputPath+OutputFileName;
|
|
end;
|
|
end;
|
|
|
|
Begin
|
|
ReadZipHeader(Item, ZMethod);
|
|
if (Item.BitFlags and 1)<>0 then
|
|
Raise EZipError.CreateFmt(SErrEncryptionNotSupported,[Item.ArchiveFileName]);
|
|
if (Item.BitFlags and (1 shl 5))<>0 then
|
|
Raise EZipError.CreateFmt(SErrPatchSetNotSupported,[Item.ArchiveFileName]);
|
|
// Normalize output filename to conventions of target platform.
|
|
// Zip file always has / path separators
|
|
IsCustomStream := Assigned(FOnCreateStream);
|
|
GetOutputFileName;
|
|
IsLink := Item.IsLink;
|
|
{$IFNDEF UNIX}
|
|
if IsLink and Not IsCustomStream then
|
|
begin
|
|
{$warning TODO: Implement symbolic link creation for non-unix, e.g.
|
|
Windows NTFS}
|
|
IsLink := False;
|
|
end;
|
|
{$ENDIF}
|
|
if IsCustomStream then
|
|
begin
|
|
try
|
|
OpenOutput(OutputFileName, FOutStream, Item);
|
|
if (IsLink = False) and (Item.IsDirectory = False) then
|
|
DoUnzip(FOutStream);
|
|
Finally
|
|
CloseOutput(Item, FOutStream);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if IsLink then
|
|
begin
|
|
{$IFDEF UNIX}
|
|
LinkTargetStream := TStringStream.Create('');
|
|
try
|
|
DoUnzip(LinkTargetStream);
|
|
fpSymlink(PChar(LinkTargetStream.DataString), PChar(OutputFileName));
|
|
finally
|
|
LinkTargetStream.Free;
|
|
end;
|
|
{$ENDIF}
|
|
end
|
|
else if Item.IsDirectory then
|
|
CreateDir(OutputFileName)
|
|
else
|
|
begin
|
|
try
|
|
OpenOutput(OutputFileName, FOutStream, Item);
|
|
DoUnzip(FOutStream);
|
|
Finally
|
|
CloseOutput(Item, FOutStream);
|
|
end;
|
|
end;
|
|
SetAttributes;
|
|
end;
|
|
end;
|
|
|
|
Function TUnZipper.IsMatch(I : TFullZipFileEntry) : Boolean;
|
|
|
|
begin
|
|
if UseUTF8 then
|
|
Result:=(FFiles.IndexOf(I.UTF8ArchiveFileName)<>-1)
|
|
else
|
|
Result:=(FFiles.IndexOf(I.ArchiveFileName)<>-1)
|
|
end;
|
|
|
|
Function TUnZipper.CalcTotalSize(AllFiles : Boolean) : Int64;
|
|
|
|
Var
|
|
I : Integer;
|
|
Item : TFullZipFileEntry;
|
|
|
|
begin
|
|
Result:=0;
|
|
for i:=0 to FEntries.Count-1 do
|
|
begin
|
|
Item := FEntries[i];
|
|
if AllFiles or IsMatch(Item) then
|
|
Result := Result + TZipFileEntry(Item).Size;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnZipper.UnZipAllFiles;
|
|
|
|
|
|
Var
|
|
Item : TFullZipFileEntry;
|
|
I : integer; //Really QWord but limited to FEntries.Count
|
|
AllFiles : Boolean;
|
|
|
|
Begin
|
|
FTerminated:=False;
|
|
FUnZipping:=True;
|
|
Try
|
|
AllFiles:=(FFiles.Count=0);
|
|
OpenInput;
|
|
Try
|
|
ReadZipDirectory;
|
|
FTotPos := 0;
|
|
FTotSize := CalcTotalSize(AllFiles);
|
|
i:=0;
|
|
While (I<FEntries.Count) and not Terminated do
|
|
begin
|
|
Item:=FEntries[i];
|
|
if AllFiles or IsMatch(Item) then
|
|
UnZipOneFile(Item);
|
|
inc(I);
|
|
end;
|
|
if Assigned(FOnProgressEx) and not Terminated then
|
|
FOnProgressEx(Self, FTotPos, FTotSize);
|
|
Finally
|
|
CloseInput;
|
|
end;
|
|
finally
|
|
FUnZipping:=False;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TUnZipper.SetBufSize(Value: LongWord);
|
|
|
|
begin
|
|
If FUnZipping then
|
|
Raise EZipError.Create(SErrBufsizeChange);
|
|
If Value>=DefaultBufSize then
|
|
FBufSize:=Value;
|
|
end;
|
|
|
|
procedure TUnZipper.SetFileName(Value: RawByteString);
|
|
|
|
begin
|
|
If FUnZipping then
|
|
Raise EZipError.Create(SErrFileChange);
|
|
FFileName:=Value;
|
|
end;
|
|
|
|
procedure TUnZipper.SetOutputPath(Value: RawByteString);
|
|
|
|
Var
|
|
DS : RawByteString;
|
|
|
|
begin
|
|
If FUnZipping then
|
|
Raise EZipError.Create(SErrFileChange);
|
|
FOutputPath:=Value;
|
|
If (FOutputPath<>'') and (FoutputPath[Length(FoutputPath)]<>DirectorySeparator) then
|
|
begin
|
|
// Preserve codepage of outputpath
|
|
DS:=DirectorySeparator;
|
|
SetCodePage(DS,StringCodePage(FoutputPath),False);
|
|
FOutputPath:=FoutputPath+DS;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnZipper.UnZipFiles(AFileName: RawByteString; FileList: TStrings);
|
|
|
|
begin
|
|
FFileName:=AFileName;
|
|
UNzipFiles(FileList);
|
|
end;
|
|
|
|
procedure TUnZipper.UnZipFiles(FileList: TStrings);
|
|
begin
|
|
FFiles.Assign(FileList);
|
|
UnZipAllFiles;
|
|
end;
|
|
|
|
procedure TUnZipper.UnZipAllFiles(AFileName: RawByteString);
|
|
|
|
begin
|
|
FFileName:=AFileName;
|
|
UnZipAllFiles;
|
|
end;
|
|
|
|
procedure TUnZipper.DoEndOfFile;
|
|
|
|
Var
|
|
ComprPct : Double;
|
|
Uncompressed: QWord;
|
|
Compressed: QWord;
|
|
begin
|
|
If LocalZip64Fld.Original_Size > 0 then
|
|
Uncompressed := LocalZip64Fld.Original_Size
|
|
else
|
|
Uncompressed := LocalHdr.Uncompressed_Size;
|
|
|
|
If LocalZip64Fld.Compressed_Size > 0 then
|
|
Compressed := LocalZip64Fld.Compressed_Size
|
|
else
|
|
Compressed := LocalHdr.Compressed_Size;
|
|
|
|
If (Compressed>0) and (Uncompressed>0) then
|
|
if (Compressed>Uncompressed) then
|
|
ComprPct := (-100.0 * (Compressed - Uncompressed)) / Uncompressed
|
|
else
|
|
ComprPct := (100.0 * (Uncompressed - Compressed)) / Uncompressed
|
|
else
|
|
ComprPct := 0;
|
|
If Assigned(FOnEndOfFile) then
|
|
FOnEndOfFile(Self,ComprPct);
|
|
end;
|
|
|
|
constructor TUnZipper.Create;
|
|
|
|
begin
|
|
FBufSize:=DefaultBufSize;
|
|
FFiles:=TStringList.Create;
|
|
TStringlist(FFiles).Sorted:=True;
|
|
FEntries:=TFullZipFileEntries.Create(TFullZipFileEntry);
|
|
FOnPercent:=1;
|
|
end;
|
|
|
|
procedure TUnZipper.Clear;
|
|
|
|
begin
|
|
FFiles.Clear;
|
|
FEntries.Clear;
|
|
end;
|
|
|
|
procedure TUnZipper.Examine;
|
|
begin
|
|
if (FOnOpenInputStream = nil) and (FFileName='') then
|
|
Raise EZipError.Create(SErrNoFileName);
|
|
OpenInput;
|
|
If (FZipStream=nil) then
|
|
Raise EZipError.Create(SErrNoStream);
|
|
Try
|
|
ReadZipDirectory;
|
|
Finally
|
|
CloseInput;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnZipper.Terminate;
|
|
begin
|
|
FTerminated:=True;
|
|
if Assigned(FCurrentDecompressor) then
|
|
FCurrentDecompressor.Terminate;
|
|
end;
|
|
|
|
destructor TUnZipper.Destroy;
|
|
|
|
begin
|
|
Clear;
|
|
FreeAndNil(FFiles);
|
|
FreeAndNil(FEntries);
|
|
Inherited;
|
|
end;
|
|
|
|
{ TZipFileEntry }
|
|
|
|
function TZipFileEntry.GetArchiveFileName: String;
|
|
begin
|
|
Result:=FArchiveFileName;
|
|
If (Result='') then
|
|
Result:=FDiskFileName;
|
|
end;
|
|
|
|
function TZipFileEntry.GetUTF8ArchiveFileName: UTF8String;
|
|
begin
|
|
Result:=FUTF8FileName;
|
|
If Result='' then
|
|
Result:=ArchiveFileName;
|
|
end;
|
|
|
|
function TZipFileEntry.GetUTF8DiskFileName: UTF8String;
|
|
begin
|
|
Result:=FUTF8DiskFileName;
|
|
If Result='' then
|
|
Result:=DiskFileName;
|
|
end;
|
|
|
|
constructor TZipFileEntry.Create(ACollection: TCollection);
|
|
|
|
begin
|
|
{$IFDEF UNIX}
|
|
FOS := OS_UNIX;
|
|
{$ELSE}
|
|
FOS := OS_FAT;
|
|
{$ENDIF}
|
|
FCompressionLevel:=cldefault;
|
|
FDateTime:=now;
|
|
FNeedsZip64:=false;
|
|
FAttributes:=0;
|
|
|
|
inherited create(ACollection);
|
|
end;
|
|
|
|
function TZipFileEntry.IsDirectory: Boolean;
|
|
begin
|
|
Result := (DiskFileName <> '') and (DiskFileName[Length(DiskFileName)] = DirectorySeparator);
|
|
if Attributes <> 0 then
|
|
begin
|
|
case OS of
|
|
OS_FAT: Result := (faDirectory and Attributes) > 0;
|
|
OS_UNIX: Result := (Attributes and UNIX_MASK) = UNIX_DIR;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TZipFileEntry.IsLink: Boolean;
|
|
begin
|
|
Result := False;
|
|
if Attributes <> 0 then
|
|
begin
|
|
case OS of
|
|
OS_FAT: Result := (faSymLink and Attributes) > 0;
|
|
OS_UNIX: Result := (Attributes and UNIX_MASK) = UNIX_LINK;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TZipFileEntry.SetArchiveFileName(const AValue: String);
|
|
|
|
begin
|
|
if FArchiveFileName=AValue then Exit;
|
|
// Zip standard: filenames inside the zip archive have / path separator
|
|
if DirectorySeparator='/' then
|
|
FArchiveFileName:=AValue
|
|
else
|
|
FArchiveFileName:=StringReplace(AValue, DirectorySeparator, '/', [rfReplaceAll]);
|
|
end;
|
|
|
|
procedure TZipFileEntry.SetDiskFileName(const AValue: String);
|
|
begin
|
|
if FDiskFileName=AValue then Exit;
|
|
// Zip file uses / as directory separator on all platforms
|
|
// so convert to separator used on current OS
|
|
if DirectorySeparator='/' then
|
|
FDiskFileName:=AValue
|
|
else
|
|
FDiskFileName:=StringReplace(AValue,'/',DirectorySeparator,[rfReplaceAll]);
|
|
end;
|
|
|
|
procedure TZipFileEntry.SetUTF8ArchiveFileName(AValue: UTF8String);
|
|
begin
|
|
FUTF8FileName:=AValue;
|
|
If ArchiveFileName='' then
|
|
if DefaultSystemCodePage<>CP_UTF8 then
|
|
ArchiveFileName:=Utf8ToAnsi(AValue)
|
|
else
|
|
ArchiveFileName:=AValue;
|
|
end;
|
|
|
|
procedure TZipFileEntry.SetUTF8DiskFileName(AValue: UTF8String);
|
|
begin
|
|
FUTF8DiskFileName:=AValue;
|
|
If DiskFileName='' then
|
|
if DefaultRTLFileSystemCodePage<>CP_UTF8 then
|
|
DiskFileName:=Utf8ToAnsi(AValue)
|
|
else
|
|
DiskFileName:=AValue;
|
|
end;
|
|
|
|
|
|
procedure TZipFileEntry.Assign(Source: TPersistent);
|
|
|
|
Var
|
|
Z : TZipFileEntry;
|
|
|
|
begin
|
|
if Source is TZipFileEntry then
|
|
begin
|
|
Z:=Source as TZipFileEntry;
|
|
FArchiveFileName:=Z.FArchiveFileName;
|
|
FDiskFileName:=Z.FDiskFileName;
|
|
FSize:=Z.FSize;
|
|
FDateTime:=Z.FDateTime;
|
|
FStream:=Z.FStream;
|
|
FOS:=Z.OS;
|
|
FAttributes:=Z.Attributes;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
{ TZipFileEntries }
|
|
|
|
function TZipFileEntries.GetZ(AIndex : Integer): TZipFileEntry;
|
|
begin
|
|
Result:=TZipFileEntry(Items[AIndex]);
|
|
end;
|
|
|
|
procedure TZipFileEntries.SetZ(AIndex : Integer; const AValue: TZipFileEntry);
|
|
begin
|
|
Items[AIndex]:=AValue;
|
|
end;
|
|
|
|
function TZipFileEntries.AddFileEntry(const ADiskFileName: String): TZipFileEntry;
|
|
begin
|
|
Result:=Add as TZipFileEntry;
|
|
Result.DiskFileName:=ADiskFileName;
|
|
end;
|
|
|
|
function TZipFileEntries.AddFileEntry(const ADiskFileName,
|
|
AArchiveFileName: String): TZipFileEntry;
|
|
begin
|
|
Result:=AddFileEntry(ADiskFileName);
|
|
Result.ArchiveFileName:=AArchiveFileName;
|
|
end;
|
|
|
|
function TZipFileEntries.AddFileEntry(const AStream: TSTream;
|
|
const AArchiveFileName: String): TZipFileEntry;
|
|
begin
|
|
Result:=Add as TZipFileEntry;
|
|
Result.Stream:=AStream;
|
|
Result.ArchiveFileName:=AArchiveFileName;
|
|
end;
|
|
|
|
Procedure TZipFileEntries.AddFileEntries(Const List : TStrings);
|
|
|
|
Var
|
|
I : integer;
|
|
|
|
begin
|
|
For I:=0 to List.Count-1 do
|
|
AddFileEntry(List[i]);
|
|
end;
|
|
|
|
{ TFullZipFileEntries }
|
|
|
|
function TFullZipFileEntries.GetFZ(AIndex : Integer): TFullZipFileEntry;
|
|
begin
|
|
Result:=TFullZipFileEntry(Items[AIndex]);
|
|
end;
|
|
|
|
procedure TFullZipFileEntries.SetFZ(AIndex : Integer;
|
|
const AValue: TFullZipFileEntry);
|
|
begin
|
|
Items[AIndex]:=AValue;
|
|
end;
|
|
|
|
End.
|