From 1c8198256176d4b2ab7d6921b2b87a8075b4ba88 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Fri, 4 Aug 2023 22:19:16 +0000 Subject: [PATCH] fpspreadsheet: Use patched zipper unit, remove dependence on Abbrevia. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8911 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../laz_fpspreadsheet_crypto.lpk | 11 +- .../source/common/fpsxmlcommon.pas | 7 +- .../fpspreadsheet/source/common/fpszipper.pp | 2203 +++++++++++++---- .../fpspreadsheet/source/common/xlsxooxml.pas | 6 +- .../source/crypto/fpsopendocument_crypto.pas | 2 +- components/fpspreadsheet/source/fps.inc | 5 + 6 files changed, 1747 insertions(+), 487 deletions(-) diff --git a/components/fpspreadsheet/laz_fpspreadsheet_crypto.lpk b/components/fpspreadsheet/laz_fpspreadsheet_crypto.lpk index 486abd975..8a6f5d778 100644 --- a/components/fpspreadsheet/laz_fpspreadsheet_crypto.lpk +++ b/components/fpspreadsheet/laz_fpspreadsheet_crypto.lpk @@ -33,18 +33,15 @@ - + - - - - - + + - + diff --git a/components/fpspreadsheet/source/common/fpsxmlcommon.pas b/components/fpspreadsheet/source/common/fpsxmlcommon.pas index 92840120e..40adb6cd7 100644 --- a/components/fpspreadsheet/source/common/fpsxmlcommon.pas +++ b/components/fpspreadsheet/source/common/fpsxmlcommon.pas @@ -4,16 +4,17 @@ unit fpsXMLCommon; {$mode objfpc}{$H+} +{$include ..\fps.inc} interface uses Classes, SysUtils, laz2_xmlread, laz2_DOM, - {$IF FPC_FULLVERSION >= 20701} - zipper, - {$ELSE} + {$IFDEF FPS_PATCHED_ZIPPER} fpszipper, + {$ELSE} + zipper, {$ENDIF} fpstypes, fpsreaderwriter; diff --git a/components/fpspreadsheet/source/common/fpszipper.pp b/components/fpspreadsheet/source/common/fpszipper.pp index c2b480bad..7572897c6 100644 --- a/components/fpspreadsheet/source/common/fpszipper.pp +++ b/components/fpspreadsheet/source/common/fpszipper.pp @@ -1,7 +1,7 @@ { - $Id: header,v 1.1 2000/07/13 06:33:45 michael Exp $ + $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-2000 by the Free Pascal development team + Copyright (c) 1999-2014 by the Free Pascal development team See the file COPYING.FPC, included in this distribution, for details about the copyright. @@ -10,46 +10,19 @@ but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - ******************************************************************************} - (* - Copy from the zipper unit from FPC 2.7.1 + **********************************************************************} - Remove it after a new FPC with the fixes from this unit is released - - definitely any version based on FPC 2.7.1, but probably works with FPC - 2.6.4+ as well. +(****************************************************************************** + This is a copy of the zipper unit from FPC 3.3.1 - TODO: Make sure that the following adjustments are contained in the new official - version: - - TUnzipper.OpenInput: use fmOpenRead + fmShareDenyNone - - const declarations: Add directive {%H-} to unused items UNIX_WRGP, - UNIX_XRGP, UNIT_WOTH, UNIX_XOTH - - TUnzipper.UnzipOneFile: Remove unused variable LinkTargetStream - - TUnzipper.UnzipOneFile: Initialize FOutStream with nil. - - TZipper.CreateCompressor: Use directive {%H-} for unused parameter - "Item : TZipFileEntry" - - TUnzipper.CreateDeCompressor: Use directive {%H-} for unused - parameter "Item : TZipFileEntry" - - TCompressor.UpdC32(Octet: Byte); cast "Octet" to LongWord instead of LongInt - - TDecompressor.UpdC32: dto. - - TUnZipper.ReadZipDirectory: in "FZipStream.Seek()", at end, cast - "Extra_field_length" to Int64 to avoid compiler warning. - ******************************************************************************) + Deactivate the FPS_PATCHED_ZIPPER define in fps.inc after a new FPC with + the fixes from this unit is released - definitely any version based on + FPC 3.3.1, but probably works with FPC 3.2.4+ as well. +******************************************************************************) {$mode objfpc} {$h+} -unit fpszipper; - -{$IF FPC_FULLVERSION >= 20701} -// Empty shell; just load fpc zipper unit -Interface - -Uses - {%H-}zipper; - -Implementation -End. -{$ELSE} -// FPC 2.6.x or lower: use this custom version +unit fpsZipper; Interface @@ -62,58 +35,139 @@ Uses Const { Signatures } - END_OF_CENTRAL_DIR_SIGNATURE = $06054B50; - LOCAL_FILE_HEADER_SIGNATURE = $04034B50; - CENTRAL_FILE_HEADER_SIGNATURE = $02014B50; + 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; + EFS_LANGUAGE_ENCODING_FLAG = $800; + +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 - Signature : LongInt; - Extract_Version_Reqd : Word; - Bit_Flag : Word; + 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 : LongInt; - Uncompressed_Size : LongInt; + Compressed_Size : LongWord; + Uncompressed_Size : LongWord; Filename_Length : Word; - Extra_Field_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; - MadeBy_Version : Word; - Extract_Version_Reqd : Word; - Bit_Flag : Word; + 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 : LongInt; - Uncompressed_Size : LongInt; + 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 : LongInt; - Local_Header_Offset : LongInt; + External_Attributes : LongWord; + Local_Header_Offset : LongWord; // if zip64: 0xFFFFFFFF End; - End_of_Central_Dir_Type = Packed Record - Signature : LongInt; + 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 : LongInt; - Start_Disk_Offset : LongInt; + 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, @@ -153,13 +207,16 @@ Const 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; + TOnStartFileEvent = Procedure(Sender : TObject; Const AFileName : AnsiString) of object; Type { TCompressor } TCompressor = Class(TObject) + private + FTerminated: Boolean; Protected FInFile : TStream; { I/O file variables } FOutFile : TStream; @@ -172,10 +229,14 @@ Type 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 } @@ -187,15 +248,22 @@ Type 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 } @@ -231,7 +299,7 @@ Type { 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 } + InBufIdx, { Points to next AnsiChar in buffer to be read } OutBufIdx : LongWord; { Points to next free space in output buffer } InBuf, { I/O buffers } OutBuf : BufPtr; @@ -239,9 +307,9 @@ Type TableFull : Boolean; { Flag indicating a full symbol table } SaveByte : Byte; { Output code buffer } BitsUsed : Byte; { Index into output code buffer } - BytesIn : LongInt; { Count of input file bytes processed } - BytesOut : LongInt; { Count of output bytes } - FOnBytes : Longint; + BytesIn : LongWord; { Count of input file bytes processed } + BytesOut : LongWord; { Count of output bytes } + FOnBytes : LongWord; Procedure FillInputBuffer; Procedure WriteOutputBuffer; Procedure FlushOutput; @@ -255,13 +323,15 @@ Type TargetSuffix : Byte; Out FoundAt : Smallint) : Boolean; Procedure Shrink(Suffix : Smallint); - Procedure ProcessLine(Const Source : String); + Procedure ProcessLine(Const Source : AnsiString); 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 } @@ -273,6 +343,8 @@ Type 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; @@ -289,17 +361,30 @@ Type TZipFileEntry = Class(TCollectionItem) private - FArchiveFileName: String; - FAttributes: LongInt; + FArchiveFileName: AnsiString; //Name of the file as it appears in the zip file list + FUTF8FileName : UTF8String; + FUTF8DiskFileName : UTF8String; + FAttributes: LongWord; FDateTime: TDateTime; - FDiskFileName: String; - FHeaderPos: Longint; + FDiskFileName: AnsiString; {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: Integer; + FSize: Int64; FStream: TStream; - function GetArchiveFileName: String; + FCompressionLevel: TCompressionlevel; + function GetArchiveFileName: AnsiString; + function GetUTF8ArchiveFileName: UTF8String; + function GetUTF8DiskFileName: UTF8String; + procedure SetArchiveFileName(Const AValue: AnsiString); + procedure SetDiskFileName(Const AValue: AnsiString); + procedure SetUTF8ArchiveFileName(AValue: UTF8String); + procedure SetUTF8DiskFileName(AValue: UTF8String); Protected - Property HdrPos : Longint Read FHeaderPos Write FheaderPos; + // 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; @@ -307,12 +392,15 @@ Type Procedure Assign(Source : TPersistent); override; Property Stream : TStream Read FStream Write FStream; Published - Property ArchiveFileName : String Read GetArchiveFileName Write FArchiveFileName; - Property DiskFileName : String Read FDiskFileName Write FDiskFileName; - Property Size : Integer Read FSize Write FSize; + Property ArchiveFileName : AnsiString Read GetArchiveFileName Write SetArchiveFileName; + Property UTF8ArchiveFileName : UTF8String Read GetUTF8ArchiveFileName Write SetUTF8ArchiveFileName; + Property DiskFileName : AnsiString 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: LongInt read FAttributes write FAttributes; + property Attributes: LongWord read FAttributes write FAttributes; + Property CompressionLevel: TCompressionlevel read FCompressionLevel write FCompressionLevel; end; { TZipFileEntries } @@ -322,9 +410,9 @@ Type 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; + Function AddFileEntry(Const ADiskFileName : AnsiString): TZipFileEntry; + Function AddFileEntry(Const ADiskFileName, AArchiveFileName : AnsiString): TZipFileEntry; + Function AddFileEntry(Const AStream : TSTream; Const AArchiveFileName : AnsiString): TZipFileEntry; Procedure AddFileEntries(Const List : TStrings); Property Entries[AIndex : Integer] : TZipFileEntry Read GetZ Write SetZ; default; end; @@ -333,71 +421,98 @@ Type TZipper = Class(TObject) Private - FEntries: TZipFileEntries; - FZipping : Boolean; - FBufSize : LongWord; - FFileName : String; { Name of resulting Zip file } - FFiles : TStrings; - FInMemSize : Integer; - FOutStream : TStream; - FInFile : TStream; { I/O file variables } - LocalHdr : Local_File_Header_Type; - CentralHdr : Central_File_Header_Type; - EndHdr : End_of_Central_Dir_Type; - FOnPercent : LongInt; - FOnProgress : TProgressEvent; - FOnEndOfFile : TOnEndOfFileEvent; - FOnStartFile : TOnStartFileEvent; + FEntries : TZipFileEntries; + FTerminated: Boolean; + FZipping : Boolean; + FBufSize : LongWord; + FFileName : RawByteString; { Name of resulting Zip file } + FFileComment : AnsiString; + 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; + FUseLanguageEncoding: Boolean; 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) : Boolean; - Procedure BuildZipDirectory; + 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 : String); - Function CreateCompressor({%H-}Item : TZipFileEntry; - AinFile,AZipStream : TStream) : TCompressor; virtual; + 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; - Procedure SaveToFile(AFileName: string); + // Saves zip to file and changes FileName + Procedure SaveToFile(const AFileName: RawByteString); + // Saves zip to stream Procedure SaveToStream(AStream: TStream); - Procedure ZipFiles(AFileName : String; FileList : TStrings); + // Zips specified files into a zip with name AFileName + Procedure ZipFile(const aFileToBeZipped : RawByteString); + Procedure ZipFile(const AZipFileName,aFileToBeZipped : RawByteString); + Procedure ZipFiles(const AZipFileName : RawByteString; FileList : TStrings); + Procedure ZipFiles(const AZipFileName : RawByteString; const FileList : Array of RawbyteString); + Procedure ZipFiles(const aFileList : Array of RawbyteString); Procedure ZipFiles(FileList : TStrings); - Procedure ZipFiles(AFileName : String; Entries : TZipFileEntries); + // Zips specified entries into a zip with name AFileName + Procedure ZipFiles(const AZipFileName : RawByteString; Entries : TZipFileEntries); Procedure ZipFiles(Entries : TZipFileEntries); + // Easy access method + // Zip single file + Class Procedure Zip(const AZipFileName : RawByteString; const aFileToBeZipped: RawByteString); + // Zip multiple file + Class Procedure Zip(const AZipFileName : RawByteString; aFileList : Array of RawByteString); + Class Procedure Zip(const AZipFileName : RawByteString; aFileList : TStrings); 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 : String Read FFileName Write SetFileName; + Property FileName : RawByteString Read FFileName Write SetFileName; + Property FileComment: AnsiString Read FFileComment Write FFileComment; // Deprecated. Use Entries.AddFileEntry(FileName) or Entries.AddFileEntries(List) instead. Property Files : TStrings Read FFiles; deprecated; - Property InMemSize : Integer Read FInMemSize Write FInMemSize; + Property InMemSize : Int64 Read FInMemSize Write FInMemSize; Property Entries : TZipFileEntries Read FEntries Write SetEntries; + Property Terminated : Boolean Read FTerminated; + // EFS/language encoding using UTF-8 + Property UseLanguageEncoding : Boolean Read FUseLanguageEncoding Write FUseLanguageEncoding; end; { TFullZipFileEntry } TFullZipFileEntry = Class(TZipFileEntry) private - FCompressedSize: LongInt; + FBitFlags: Word; + FCompressedSize: QWord; FCompressMethod: Word; FCRC32: LongWord; Public + Property BitFlags : Word Read FBitFlags; Property CompressMethod : Word Read FCompressMethod; - Property CompressedSize : LongInt Read FCompressedSize; + Property CompressedSize : QWord Read FCompressedSize; property CRC32: LongWord read FCRC32 write FCRC32; end; @@ -424,41 +539,70 @@ Type FOnOpenInputStream: TCustomInputStreamEvent; FUnZipping : Boolean; FBufSize : LongWord; - FFileName : String; { Name of resulting Zip file } - FOutputPath : String; + FFileName : RawByteString; { Name of resulting Zip file } + FOutputPath : RawByteString; + FFileComment: AnsiString; FEntries : TFullZipFileEntries; FFiles : TStrings; + FUseUTF8 : Boolean; + FFlat : Boolean; FZipStream : TStream; { I/O file variables } - LocalHdr : Local_File_Header_Type; + 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; - EndHdr : End_of_Central_Dir_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 : String; var OutStream: TStream; Item : TFullZipFileEntry) : Boolean; + Function OpenOutput(OutFileName : RawByteString; Out OutStream: TStream; Item : TFullZipFileEntry) : Boolean; Procedure SetBufSize(Value : LongWord); - Procedure SetFileName(Value : String); - Procedure SetOutputPath(Value:String); - Function CreateDeCompressor({%H-}Item : TZipFileEntry; AMethod : Word;AZipFile,AOutFile : TStream) : TDeCompressor; virtual; + 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 : String; FileList : TStrings); - Procedure UnZipFiles(FileList : TStrings); - Procedure UnZipAllFiles(AFileName : String); + Procedure UnZipFile(const aExtractFileName: RawByteString); + Procedure UnZipFile(const AZipFileName, aExtractFileName: RawByteString); + Procedure UnZipFiles(const AZipFileName : RawByteString; FileList : TStrings); + Procedure UnZipFiles(const AZipFileName : RawByteString; aFileList : Array of RawBytestring); + Procedure UnZipFiles(aFileList : TStrings); + Procedure UnZipAllFiles(const AZipFileName : RawByteString); + // Easy access methods. No instance needed, uses default options. + // Unzip all files + Class Procedure Unzip(const AZipFileName : RawByteString); + // Unzip a single file. + Class Procedure Unzip(const AZipFileName : RawByteString;aExtractFileName : RawByteString); + Class Procedure UnZip(const AZipFileName, aExtractFileName: RawByteString; aOutputFileName : AnsiString); + // Unzip several files + Class Procedure Unzip(const AZipFileName : RawByteString; aFileList : Array of RawByteString); + Class Procedure Unzip(const AZipFileName : RawByteString; aFileList : TStrings); + Class Procedure Unzip(const AZipFileName : RawByteString; aFileList : Array of RawByteString; aOutputDir : RawByteString; aFlat : Boolean = false); + Class Procedure Unzip(const AZipFileName : RawByteString; aFileList : TStrings; aOutputDir : RawByteString; aFlat : Boolean = false); Procedure Clear; Procedure Examine; + Procedure Terminate; Public Property BufferSize : LongWord Read FBufSize Write SetBufSize; Property OnOpenInputStream: TCustomInputStreamEvent read FOnOpenInputStream write FOnOpenInputStream; @@ -467,33 +611,106 @@ Type 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 : String Read FFileName Write SetFileName; - Property OutputPath : String Read FOutputPath Write SetOutputPath; + Property FileName : RawByteString Read FFileName Write SetFileName; + Property OutputPath : RawByteString Read FOutputPath Write SetOutputPath; + Property FileComment: AnsiString Read FFileComment; Property Files : TStrings Read FFiles; Property Entries : TFullZipFileEntries Read FEntries; + Property UseUTF8 : Boolean Read FUseUTF8 Write FUseUTF8; + Property Flat : Boolean Read FFlat Write FFlat; // enable flat extraction, like -j when using unzip + 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'; + 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'; - SErrMissingFileName = 'Missing filename in entry %d'; - SErrMissingArchiveName = 'Missing archive filename in streamed entry %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); + {$ifdef Windows} + function FixLongFilename(const Fn: RawByteString): RawByteString; + begin + Result := Fn; + if (Length(Fn)>MAX_PATH) and not ((Pos('\\?\', Fn)=1) or (Pos('\\.\', Fn)=1) or (Pos('\\?\UNC\', Fn)=1)) then + begin + if (Pos('\\', Fn)=1) and (length(FN)>2) then + Insert('?\UNC\',Result,3) + else + Result:='\\?\'+Fn; + end; + end; + {$endif} + + Var + H : Thandle; + + begin + {$ifdef Windows} + FFileName:=FixLongFilename(AFileName); + {$else} + FFileName:=AFileName; + {$endif} + If (Mode and fmCreate) > 0 then + H:=FileCreate(FFileName,Mode,Rights) + else + H:=FileOpen(FFileName,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; @@ -514,6 +731,26 @@ begin 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 @@ -552,9 +789,38 @@ begin 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; @@ -584,51 +850,34 @@ Procedure ZipDateTimeToDateTime(ZD,ZT : Word;out DT : TDateTime); Var Y,M,D,H,N,S,MS : Word; + aDate,aTime : TDateTime; begin MS:=0; S:=(ZT and 31) shl 1; N:=(ZT shr 5) and 63; - H:=(ZT shr 12) and 31; + H:=ZT shr 11; D:=ZD and 31; M:=(ZD shr 5) and 15; Y:=((ZD shr 9) and 127)+1980; - + // Some corrections if M < 1 then M := 1; + if M > 12 then M:=12; if D < 1 then D := 1; - DT:=ComposeDateTime(EncodeDate(Y,M,D),EncodeTime(H,N,S,MS)); + if D>MonthDays[IsLeapYear(Y)][M] then + D:=MonthDays[IsLeapYear(Y)][M]; + // Try to encode the result, fall back on today if it fails + if Not TryEncodeDate(Y,M,D,aDate) then + aDate:=Date; + if not TryEncodeTime(H,N,S,MS,aTime) then + aTime:=Time; + // Return result + DT:=ComposeDateTime(aDate,ATime); end; -const - OS_FAT = 0; - OS_UNIX = 3; - - 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; - {%H-}UNIX_WGRP = $0010; - {%H-}UNIX_XGRP = $0008; - - UNIX_ROTH = $0004; - {%H-}UNIX_WOTH = $0002; - {%H-}UNIX_XOTH = $0001; - - UNIX_DEFAULT = UNIX_RUSR or UNIX_WUSR or UNIX_XUSR or UNIX_RGRP or UNIX_ROTH; - - -function ZipUnixAttrsToFatAttrs(const Name: String; Attrs: Longint): Longint; +function ZipUnixAttrsToFatAttrs(const Name: AnsiString; Attrs: Longint): Longint; begin Result := faArchive; @@ -660,6 +909,17 @@ begin Result := Result or UNIX_FILE; end; +function CRC32Str(const s:AnsiString):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 ---------------------------------------------------------------------} @@ -668,8 +928,7 @@ end; Procedure TDeCompressor.UpdC32(Octet: Byte); Begin - FCrc32Val := Crc_32_Tab[Byte(FCrc32Val XOR LongWord(Octet))] XOR - ((FCrc32Val SHR 8) AND $00FFFFFF); + FCrc32Val := Crc_32_Tab[Byte(FCrc32Val XOR LongInt(Octet))] XOR ((FCrc32Val SHR 8) AND $00FFFFFF); end; constructor TDeCompressor.Create(AInFile, AOutFile: TStream; ABufSize: LongWord); @@ -680,6 +939,11 @@ begin CRC32Val:=$FFFFFFFF; end; +procedure TDeCompressor.Terminate; +begin + FTerminated:=True; +end; + { --------------------------------------------------------------------- TCompressor @@ -689,8 +953,7 @@ end; Procedure TCompressor.UpdC32(Octet: Byte); Begin - FCrc32Val := Crc_32_Tab[Byte(FCrc32Val XOR LongWord(Octet))] XOR - ((FCrc32Val SHR 8) AND $00FFFFFF); + FCrc32Val := Crc_32_Tab[Byte(FCrc32Val XOR LongInt(Octet))] XOR ((FCrc32Val SHR 8) AND $00FFFFFF); end; constructor TCompressor.Create(AInFile, AOutFile: TStream; ABufSize: LongWord); @@ -701,6 +964,11 @@ begin CRC32Val:=$FFFFFFFF; end; +procedure TCompressor.Terminate; +begin + FTerminated:=True; +end; + { --------------------------------------------------------------------- TDeflater @@ -714,22 +982,22 @@ end; procedure TDeflater.Compress; - Var Buf : PByte; - I,Count,NewCount : Integer; + I,Count : integer; C : TCompressionStream; - BytesNow : Integer; - NextMark : Integer; - OnBytes : Integer; - FSize : Integer; + 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; + BytesNow:=0; + NextMark := OnBytes; FSize:=FInfile.Size; Try C:=TCompressionStream.Create(FCompressionLevel,FOutFile,True); @@ -740,9 +1008,8 @@ begin 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); + // Writebuffer will loop + C.WriteBuffer(Buf^,Count); inc(BytesNow,Count); if BytesNow>NextMark Then begin @@ -750,7 +1017,7 @@ begin FOnProgress(self,100 * ( BytesNow / FSize)); inc(NextMark,OnBytes); end; - Until (Count=0); + Until (Count=0) or Terminated; Finally C.Free; end; @@ -767,6 +1034,23 @@ 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 ---------------------------------------------------------------------} @@ -807,15 +1091,18 @@ begin Count:=C.Read(Buf^,FBufferSize); For I:=0 to Count-1 do UpdC32(Buf[i]); - FOutFile.Write(Buf^,Count); + FOutFile.WriteBuffer(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); + Until (Count=0) or Terminated; + FTotPos := FTotPos + FOutFile.Size; Finally C.Free; end; @@ -824,6 +1111,8 @@ begin end; if assigned(FOnProgress) then fOnProgress(self,100.0); + if assigned(FOnProgressEx) then + FOnProgressEx(Self, FTotPos, FTotSize); Crc32Val:=NOT Crc32Val; end; @@ -869,7 +1158,7 @@ end; Procedure TShrinker.Compress; Var - OneString : String; + OneString : AnsiString; Remaining : Word; begin @@ -880,7 +1169,7 @@ begin FirstCh:= TRUE; Crc32Val:=$FFFFFFFF; FOnBytes:=Round((FInFile.Size * FOnPercent) / 100); - While NOT InputEof do + While Not InputEof do begin Remaining:=Succ(MaxInBufIdx - InBufIdx); If Remaining>255 then @@ -895,7 +1184,7 @@ begin ProcessLine(OneString); end; end; - Crc32Val := NOT Crc32Val; + Crc32Val := Not Crc32Val; ProcessLine(''); end; @@ -904,6 +1193,16 @@ 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); @@ -1008,7 +1307,7 @@ Var 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 + While (CurrChild <> -1) and (CodeTable^[CurrChild].Child = -1) do begin CodeTable^[Parent].Child := CodeTable^[CurrChild].Sibling; CodeTable^[CurrChild].Sibling := -1; @@ -1177,7 +1476,7 @@ Begin end; end; -Procedure TShrinker.ProcessLine(Const Source : String); +Procedure TShrinker.ProcessLine(Const Source : AnsiString); Var I : Word; @@ -1204,9 +1503,9 @@ end; Procedure TZipper.GetFileInfo; Var - F : TZipFileEntry; + F : TZipFileEntry; Info : TSearchRec; - I : Longint; + I : integer; //zip spec allows QWord but FEntries.Count does not support it {$IFDEF UNIX} UnixInfo: Stat; {$ENDIF} @@ -1220,7 +1519,10 @@ Begin Raise EZipError.CreateFmt(SErrMissingFileName,[I]); If FindFirst(F.DiskFileName, STDATTR, Info)=0 then try - F.Size:=Info.Size; + if Info.Attr and faDirectory <> 0 then //in Linux directory Size <> 0 + F.Size := 0 + else + F.Size:=Info.Size; F.DateTime:=FileDateToDateTime(Info.Time); {$IFDEF UNIX} if fplstat(F.DiskFileName, @UnixInfo) = 0 then @@ -1235,17 +1537,20 @@ Begin Raise EZipError.CreateFmt(SErrFileDoesNotExist,[F.DiskFileName]); end else - begin + begin If (F.ArchiveFileName='') then Raise EZipError.CreateFmt(SErrMissingArchiveName,[I]); F.Size:=F.Stream.Size; - {$IFDEF UNIX} - F.Attributes := UNIX_FILE or UNIX_DEFAULT; - {$ELSE} - F.Attributes := faArchive; - {$ENDIF} - end; + if (F.Attributes = 0) then + begin + {$IFDEF UNIX} + F.Attributes := UNIX_FILE or UNIX_DEFAULT; + {$ELSE} + F.Attributes := faArchive; + {$ENDIF} + end; end; + end; end; @@ -1278,6 +1583,7 @@ Begin FreeAndNil(FInFile) else FinFile:=Nil; + DoEndOfFile; end; @@ -1285,119 +1591,332 @@ 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 := 10; + 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; - Uncompressed_Size := Item.Size; + 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; - Extra_Field_Length := 0; - end ; + 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) : Boolean; +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 - ZFileName : ShortString; + IsZip64 : boolean; //Must the local header be in zip64 format? + // Separate from zip64 status of entire zip file. + ZFileName : RawByteString; Begin - ZFileName:=Item.ArchiveFileName; + ZFileName := Item.ArchiveFileName; + IsZip64 := false; With LocalHdr do begin - FileName_Length := Length(ZFileName); - Compressed_Size := FZip.Size; - Crc32 := ACRC; - Compress_method:=AMethod; - Result:=Not (Compressed_Size >= Uncompressed_Size); - If Not Result then - begin { No... } - Compress_Method := 0; { ...change stowage type } - Compressed_Size := Uncompressed_Size; { ...update compressed size } - end; + if FUseLanguageEncoding then begin + SetCodePage(ZFileName, CP_UTF8, True); + Bit_Flag := Bit_Flag or EFS_LANGUAGE_ENCODING_FLAG; end; + 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; + if LocalZip64Fld.Original_Size > 0 then + IsZip64 := true; + 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 + 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 : LongInt; - HdrPos : LongInt; - CenDirPos : LongInt; - ACount : Word; - ZFileName : ShortString; - + SavePos : Int64; + HdrPos : Int64; //offset from disk where file begins to local header + CenDirPos : Int64; + ACount : QWord; //entry counter + ZFileName : AnsiString; //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; - CenDirPos := FOutStream.Position; - FOutStream.Seek(0,soFrombeginning); { Rewind output file } - HdrPos := FOutStream.Position; - FOutStream.ReadBuffer(LocalHdr, SizeOf(LocalHdr)); + 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); + LocalHdr := SwapLFH(LocalHdr); {$ENDIF} - Repeat - SetLength(ZFileName,LocalHdr.FileName_Length); - FOutStream.ReadBuffer(ZFileName[1], LocalHdr.FileName_Length); - SavePos := FOutStream.Position; - FillChar(CentralHdr,SizeOf(CentralHdr),0); - With CentralHdr do - begin - Signature := CENTRAL_FILE_HEADER_SIGNATURE; - MadeBy_Version := LocalHdr.Extract_Version_Reqd; - {$IFDEF UNIX} - MadeBy_Version := MadeBy_Version or (OS_UNIX shl 8); - {$ENDIF} - Move(LocalHdr.Extract_Version_Reqd, Extract_Version_Reqd, 26); - 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} - Local_Header_Offset := HdrPos; - end; - FOutStream.Seek(0,soFromEnd); - FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapCFH{$ENDIF}(CentralHdr),SizeOf(CentralHdr)); - FOutStream.WriteBuffer(ZFileName[1],Length(ZFileName)); - Inc(ACount); - FOutStream.Seek(SavePos + LocalHdr.Compressed_Size,soFromBeginning); - 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,soFromEnd); - FillChar(EndHdr,SizeOf(EndHdr),0); - With EndHdr do - begin - Signature := END_OF_CENTRAL_DIR_SIGNATURE; - Disk_Number := 0; - Central_Dir_Start_Disk := 0; - Entries_This_Disk := ACount; - Total_Entries := ACount; - Central_Dir_Size := FOutStream.Size-CenDirPos; - Start_Disk_Offset := CenDirPos; - ZipFile_Comment_Length := 0; - FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapECD{$ENDIF}(EndHdr), SizeOf(EndHdr)); - end; + 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.PositionMinReqdVersion 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; + + if IsZip64 then + begin + CentralHdr.Extra_Field_Length:=SizeOf(LocalZip64ExtHdr)+SizeOf(LocalZip64Fld); + end else CentralHdr.Extra_Field_Length :=0; + + 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 LocalZip64Fld.Compressed_Size > 0 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); @@ -1405,8 +1924,11 @@ Procedure TZipper.ZipOneFile(Item : TZipFileEntry); Var CRC : LongWord; ZMethod : Word; + ZVersionReqd : Word; + ZBitFlag : Word; ZipStream : TStream; - TmpFileName : String; + TmpFileName, Start : AnsiString; + I : Integer; Begin OpenInput(Item); @@ -1416,7 +1938,12 @@ Begin ZipStream:=TMemoryStream.Create else begin - TmpFileName:=ChangeFileExt(FFileName,'.tmp'); + Start := ChangeFileExt(FFileName, ''); + I := 0; + repeat + TmpFileName := Format('%s%.5d.tmp', [Start, I]); + Inc(I); + until not FileExists(TmpFileName); ZipStream:=TFileStream.Create(TmpFileName,fmCreate); end; Try @@ -1427,16 +1954,19 @@ Begin Compress; CRC:=Crc32Val; ZMethod:=ZipID; + ZVersionReqd:=ZipVersionReqd; + ZBitFlag:=ZipBitFlag; Finally + FCurrentCompressor:=Nil; Free; end; - If UpdateZipHeader(Item,ZipStream,CRC,ZMethod) then + 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,soFromBeginning); + FInfile.Seek(0,soBeginning); FOutStream.CopyFrom(FInFile,0); end; finally @@ -1451,16 +1981,16 @@ end; // Just like SaveToFile, but uses the FileName property Procedure TZipper.ZipAllFiles; - -Begin +begin SaveToFile(FileName); end; -procedure TZipper.SaveToFile(AFileName: string); +procedure TZipper.SaveToFile(const AFileName: RawByteString); var lStream: TFileStream; begin - lStream:=TFileStream.Create(AFileName,fmCreate); + FFileName:=AFileName; + lStream:=TFileStream.Create(FFileName,fmCreate); try SaveToStream(lStream); finally @@ -1470,33 +2000,42 @@ end; procedure TZipper.SaveToStream(AStream: TStream); Var - I : Integer; - filecnt : integer; + I : integer; //could be qword but limited by FEntries.Count begin + FTerminated:=False; FOutStream := AStream; - If CheckEntries=0 then Exit; FZipping:=True; Try - GetFileInfo; - - filecnt:=0; - for I:=0 to FEntries.Count-1 do - begin + GetFileInfo; //get info on file entries in zip + I:=0; + While (I0 then + 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 + for I:=0 to FFiles.Count-1 do FEntries.Delete(FEntries.Count-1); end; end; +procedure TZipper.ZipFile(const aFileToBeZipped: RawByteString); +begin + ZipFiles([aFileToBeZipped]); +end; + +procedure TZipper.ZipFile(const AZipFileName, aFileToBeZipped: RawByteString); +begin + FileName:=aZipFileName; + ZipFile(aFileToBeZipped); +end; + Procedure TZipper.SetBufSize(Value : LongWord); @@ -1507,7 +2046,7 @@ begin FBufSize:=Value; end; -Procedure TZipper.SetFileName(Value : String); +Procedure TZipper.SetFileName(Value : RawByteString); begin If FZipping then @@ -1515,22 +2054,45 @@ begin FFileName:=Value; end; -Procedure TZipper.ZipFiles(AFileName : String; FileList : TStrings); +Procedure TZipper.ZipFiles(Const AZipFileName : RawByteString; FileList : TStrings); begin - FFileName:=AFileName; + FFileName:=AZipFileName; ZipFiles(FileList); end; +procedure TZipper.ZipFiles(const AZipFileName: RawByteString; const FileList: array of RawbyteString); + +begin + FileName:=aZipFileName; + ZipFiles(FileList); +end; + +procedure TZipper.ZipFiles(const aFileList: array of RawbyteString); +Var + L : TStringList; + S : RawByteString; +begin + L:=TStringList.Create; + try + L.Capacity:=Length(aFileList); + for S in aFileList do + L.Add(S); + ZipFiles(L); + finally + L.Free; + end; +end; + procedure TZipper.ZipFiles(FileList: TStrings); begin FFiles.Assign(FileList); ZipAllFiles; end; -procedure TZipper.ZipFiles(AFileName: String; Entries: TZipFileEntries); +procedure TZipper.ZipFiles(const AZipFileName: RawByteString; Entries: TZipFileEntries); begin - FFileName:=AFileName; + FFileName:=AZipFileName; ZipFiles(Entries); end; @@ -1540,13 +2102,45 @@ begin ZipAllFiles; end; +class procedure TZipper.Zip(const AZipFileName: RawByteString; const aFileToBeZipped: RawByteString); +begin + With Self.Create do + try + ZipFile(aZipFileName,aFileToBeZipped); + finally + Free; + end; +end; + +class procedure TZipper.Zip(const AZipFileName: RawByteString; aFileList: array of RawByteString); +begin + With Self.Create do + try + ZipFiles(aZipFileName,aFileList); + finally + Free; + end; +end; + +class procedure TZipper.Zip(const AZipFileName: RawByteString; aFileList: TStrings); +begin + With Self.Create do + try + ZipFiles(aZipFileName,aFileList); + finally + Free; + end; +end; + Procedure TZipper.DoEndOfFile; Var ComprPct : Double; begin - If (LocalHdr.Uncompressed_Size>0) then + 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; @@ -1562,16 +2156,38 @@ begin 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; + I : integer; //Could be QWord but limited by FFiles.Count begin - For I:=0 to FFiles.Count-1 do + 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; @@ -1583,6 +2199,13 @@ begin FFiles.Clear; end; +procedure TZipper.Terminate; +begin + FTerminated:=True; + if Assigned(FCurrentCompressor) then + FCurrentCompressor.Terminate; +end; + Destructor TZipper.Destroy; begin @@ -1592,61 +2215,72 @@ begin Inherited; end; - { --------------------------------------------------------------------- TUnZipper ---------------------------------------------------------------------} -Procedure TUnZipper.OpenInput; +procedure TUnZipper.OpenInput; Begin if Assigned(FOnOpenInputStream) then FOnOpenInputStream(Self, FZipStream); if FZipStream = nil then - FZipStream:=TFileStream.Create(FFileName,fmOpenRead + fmShareDenyNone); + FZipStream:=TFileStream.Create(FFileName,fmOpenRead or fmShareDenyWrite); End; -Function TUnZipper.OpenOutput(OutFileName : String; var OutStream: TStream; Item : TFullZipFileEntry) : Boolean; +function TUnZipper.OpenOutput(OutFileName: RawByteString; + out OutStream: TStream; Item: TFullZipFileEntry): Boolean; Var - Path: String; - OldDirectorySeparators: set of char; -Begin - { the default RTL behaviour is broken on Unix platforms - for Windows compatibility: it allows both '/' and '\' - as directory separator. We don't want that behaviour - here, since 'abc\' is a valid file name under Unix. + Path: RawByteString; + OldDirectorySeparators: set of AnsiChar; - (mantis 15836) On the other hand, many archives on - windows have '/' as pathseparator, even Windows - generated .odt files. So we disable this for windows. +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; - {$ifndef Windows} - AllowDirectorySeparators:=[DirectorySeparator]; + {$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 (OutStream=Nil) and (not Item.IsDirectory) 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); +procedure TUnZipper.CloseOutput(Item: TFullZipFileEntry; var OutStream: TStream + ); Begin if Assigned(FOnDoneStream) then @@ -1655,11 +2289,13 @@ Begin OutStream := nil; end else - FreeAndNil(OutStream); + if Assigned(OutStream) then + FreeAndNil(OutStream); + DoEndOfFile; end; -Procedure TUnZipper.CloseInput; +procedure TUnZipper.CloseInput; Begin if Assigned(FOnCloseInputStream) then @@ -1668,25 +2304,87 @@ Begin end; -Procedure TUnZipper.ReadZipHeader(Item : TFullZipFileEntry; out AMethod : Word); +procedure TUnZipper.ReadZipHeader(Item: TFullZipFileEntry; out AMethod: Word); Var - S : String; + S : RawByteString; + 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,soFromBeginning); + 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; + Item.FCompressMethod := Compress_Method; SetLength(S,Filename_Length); FZipStream.ReadBuffer(S[1],Filename_Length); - //SetLength(E,Extra_Field_Length); - //FZipStream.ReadBuffer(E[1],Extra_Field_Length); - FZipStream.Seek(Extra_Field_Length,soCurrent); + if Bit_Flag and EFS_LANGUAGE_ENCODING_FLAG <> 0 then + SetCodePage(S, CP_UTF8, False); Item.ArchiveFileName:=S; Item.DiskFileName:=S; + if (Item.FCompressMethod = 0) and (Item.Size <> 0) then + begin + if (Uncompressed_Size = 0) then + Uncompressed_Size := Item.Size; + if (Compressed_Size = 0) then + Compressed_Size := Item.Size; + end; + 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.Position0 +// 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 - i, + 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, - CenDirPos : LongInt; + 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; + S : RawByteString; + U : UTF8String; + // infozip unicode path + Infozip_unicode_path_ver : byte; // always 1 + Infozip_unicode_path_crc32 : DWord; Begin - EndHdrPos:=FZipStream.Size-SizeOf(EndHdr); - if EndHdrPos < 0 then + FindEndHeaders(EndHdr, EndHdrPos, + EndZip64Hdr, EndZip64HdrPos); + if EndHdrPos=0 then raise EZipError.CreateFmt(SErrCorruptZIP,[FileName]); - FZipStream.Seek(EndHdrPos,soFromBeginning); - FZipStream.ReadBuffer(EndHdr, SizeOf(EndHdr)); -{$IFDEF FPC_BIG_ENDIAN} - EndHdr := SwapECD(EndHdr); -{$ENDIF} - With EndHdr do + if (EndZip64HdrPos>0) and (EndZip64Hdr.Start_Disk_Offset>0) then begin - if Signature <> END_OF_CENTRAL_DIR_SIGNATURE then - raise EZipError.CreateFmt(SErrCorruptZIP,[FileName]); - CenDirPos:=Start_Disk_Offset; - end; - FZipStream.Seek(CenDirPos,soFrombeginning); + 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; - for i:=0 to EndHdr.Entries_This_Disk-1 do + 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} @@ -1734,27 +2597,94 @@ 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); + if Bit_Flag and EFS_LANGUAGE_ENCODING_FLAG <> 0 then + SetCodePage(S, CP_UTF8, False); + 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; - FZipStream.Seek(Int64(Extra_Field_Length)+File_Comment_Length, soCurrent); + + // Go through any extra fields and extract any zip64 info + if Extra_Field_Length>0 then + begin + while (FZipStream.Position 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 + if File_Comment_Length > 0 then + FZipStream.Seek(File_Comment_Length,soFromCurrent); + // this doesn't work properly when zip file size is over 4Gb, so commented off + //FZipStream.Seek(SavePos+Extra_Field_Length+File_Comment_Length,soFromBeginning); end; - end; + end; end; -Function TUnZipper.CreateDeCompressor(Item : TZipFileEntry; AMethod : Word;AZipFile,AOutFile : TStream) : TDeCompressor; +function TUnZipper.CreateDeCompressor(Item: TZipFileEntry; AMethod: Word; + AZipFile, AOutFile: TStream): TDeCompressor; begin case AMethod of 8 : @@ -1762,69 +2692,138 @@ begin else raise EZipError.CreateFmt(SErrUnsupportedCompressionFormat,[AMethod]); end; + FCurrentDecompressor:=Result; end; -Procedure TUnZipper.UnZipOneFile(Item : TFullZipFileEntry); +procedure TUnZipper.UnZipOneFile(Item: TFullZipFileEntry); Var - {$IFDEF UNIX} - LinkTargetStream: TStringStream; - {$ENDIF} - {%H-}Count, Attrs: Longint; ZMethod : Word; - OutputFileName: string; - FOutStream: TStream = nil; +{$ifdef unix} + LinkTargetStream: TStringStream; +{$endif} + OutputFileName: RawByteString; + FOutStream: TStream; IsLink: Boolean; IsCustomStream: Boolean; + U : UnicodeString; - - procedure DoUnzip(const Dest: TStream); + Procedure SetAttributes; + Var + Attrs : Longint; begin - if ZMethod=0 then - begin - if (LocalHdr.Compressed_Size<>0) then + // 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 - Count:=Dest.CopyFrom(FZipStream,LocalHdr.Compressed_Size) - {$warning TODO: Implement CRC Check} - end - else - Count:=0; - end - else - With CreateDecompressor(Item, ZMethod, FZipStream, Dest) do - Try - OnProgress:=Self.OnProgress; - OnPercent:=Self.OnPercent; - DeCompress; - if Item.CRC32 <> Crc32Val then - raise EZipError.CreateFmt(SErrInvalidCRC,[Item.ArchiveFileName]); - Finally - Free; + {$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) then + begin + if Flat then + OutputFileName:=ExtractFileName(OutputFileName); + if (FOutputPath<>'') then + begin + // Do not use IncludeTrailingPathdelimiter + OutputFileName:=FOutputPath+OutputFileName; + end; + end; + end; + Begin ReadZipHeader(Item, ZMethod); - OutputFileName:=Item.DiskFileName; - + 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); - - - if (IsCustomStream = False) and (FOutputPath<>'') then - OutputFileName:=IncludeTrailingPathDelimiter(FOutputPath)+OutputFileName; - + GetOutputFileName; IsLink := Item.IsLink; - {$IFNDEF UNIX} if IsLink and Not IsCustomStream then - begin - {$warning TODO: Implement symbolic link creation for non-unix} + begin + {$warning TODO: Implement symbolic link creation for non-unix, e.g. + Windows NTFS} IsLink := False; - end; + end; {$ENDIF} - - if IsCustomStream then - begin + begin try OpenOutput(OutputFileName, FOutStream, Item); if (IsLink = False) and (Item.IsDirectory = False) then @@ -1832,88 +2831,91 @@ Begin 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 + else begin - if Item.IsDirectory then - CreateDir(OutputFileName) - else + if IsLink then begin + {$IFDEF UNIX} + LinkTargetStream := TStringStream.Create(''); try - OpenOutput(OutputFileName, FOutStream, Item); - DoUnzip(FOutStream); - Finally - CloseOutput(Item, FOutStream); + DoUnzip(LinkTargetStream); + fpSymlink(PAnsiChar(LinkTargetStream.DataString), PAnsiChar(OutputFileName)); + finally + LinkTargetStream.Free; end; - end; - end; - end; - - - if Not IsCustomStream then - begin - // set attributes - FileSetDate(OutputFileName, DateTimeToFileDate(Item.DateTime)); - - if (Item.Attributes <> 0) then - begin - Attrs := 0; - {$IFDEF UNIX} - if Item.OS = OS_UNIX then Attrs := Item.Attributes; - if Item.OS = OS_FAT then - Attrs := ZipFatAttrsToUnixAttrs(Item.Attributes); - {$ELSE} - if Item.OS = OS_FAT then Attrs := Item.Attributes; - if Item.OS = OS_UNIX then - Attrs := ZipUnixAttrsToFatAttrs(ExtractFileName(Item.ArchiveFileName), Item.Attributes); - {$ENDIF} - - if Attrs <> 0 then + {$ENDIF} + end + else if Item.IsDirectory then begin - {$IFDEF UNIX} - FpChmod(OutputFileName, Attrs); - {$ELSE} - FileSetAttr(OutputFileName, Attrs); - {$ENDIF} + if (NOT Flat) then ForceDirectories(OutputFileName); + end + else + begin + try + OpenOutput(OutputFileName, FOutStream, Item); + DoUnzip(FOutStream); + Finally + CloseOutput(Item, FOutStream); end; + end; + SetAttributes; end; - 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; -Procedure TUnZipper.UnZipAllFiles; Var - Item : TFullZipFileEntry; - I : Integer; - AllFiles : Boolean; + 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; - For I:=0 to FEntries.Count-1 do + FTotPos := 0; + FTotSize := CalcTotalSize(AllFiles); + i:=0; + While (I-1) then + 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; @@ -1923,7 +2925,7 @@ Begin end; -Procedure TUnZipper.SetBufSize(Value : LongWord); +procedure TUnZipper.SetBufSize(Value: LongWord); begin If FUnZipping then @@ -1932,7 +2934,7 @@ begin FBufSize:=Value; end; -Procedure TUnZipper.SetFileName(Value : String); +procedure TUnZipper.SetFileName(Value: RawByteString); begin If FUnZipping then @@ -1940,48 +2942,234 @@ begin FFileName:=Value; end; -Procedure TUnZipper.SetOutputPath(Value:String); +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 : String; FileList : TStrings); - +procedure TUnZipper.UnZipFile(const aExtractFileName: RawByteString); begin - FFileName:=AFileName; - UNzipFiles(FileList); + UnzipFile(FFileName, aExtractFileName); end; -procedure TUnZipper.UnZipFiles(FileList: TStrings); +procedure TUnZipper.UnZipFile(const AZipFileName, aExtractFileName: RawByteString); +var + L: TStrings; begin - FFiles.Assign(FileList); + FFileName := AZipFileName; + L := TStringList.Create; + try + L.Add(aExtractFileName); + UnzipFiles(L); + finally + L.Free; + end; +end; + +procedure TUnZipper.UnZipFiles(const AZipFileName: RawByteString; FileList: TStrings); + +begin + FFileName:=AZipFileName; + UnZipFiles(FileList); +end; + +procedure TUnZipper.UnZipFiles(const AZipFileName: RawByteString; aFileList: array of RawBytestring); + +Var + L : TStringList; + S : RawByteString; + +begin + L:=TStringList.Create; + try + L.Capacity:=Length(aFileList); + for S in aFileList do + L.Add(S); + UnZipFiles(aZipFileName,L); + finally + L.Free; + end; +end; + +procedure TUnZipper.UnZipFiles(aFileList: TStrings); +begin + FFiles.Assign(aFileList); UnZipAllFiles; end; -Procedure TUnZipper.UnZipAllFiles(AFileName : String); +procedure TUnZipper.UnZipAllFiles(const AZipFileName: RawByteString); begin - FFileName:=AFileName; + FFileName:=AZipFileName; UnZipAllFiles; end; -Procedure TUnZipper.DoEndOfFile; +class procedure TUnZipper.Unzip(const AZipFileName: RawByteString); + +begin + With Self.Create do + try + FileName:=aZipFileName; + UnZipAllFiles; + finally + Free; + end; +end; + +class procedure TUnZipper.Unzip(const AZipFileName: RawByteString; aExtractFileName: RawByteString); + +begin + With Self.Create do + try + UnZipFile(aZipFileName,aExtractFileName); + finally + Free; + end; +end; + +Type + + { TCustomExtractor } + + TCustomExtractor = Class(TObject) + Private + FStream : TStream; + FunZipper : TUnzipper; + procedure DoCreateStream(Sender: TObject; var AStream: TStream; AItem: TFullZipFileEntry); + Public + Constructor Create(aUnZipper : TUnzipper); + Destructor Destroy; override; + Procedure UnZip(const AZipFileName, aExtractFileName: RawByteString; aOutputFileName: AnsiString); + end; + +{ TCustomExtractor } + +procedure TCustomExtractor.DoCreateStream(Sender: TObject; var AStream: TStream; AItem: TFullZipFileEntry); +begin + aStream:=FStream; + FStream:=Nil; +end; + +constructor TCustomExtractor.Create(aUnZipper: TUnzipper); +begin + FStream:=Nil; + FUnzipper:=aUnzipper; +end; + +destructor TCustomExtractor.Destroy; +begin + FreeAndNil(FUnZipper); + FreeAndNil(FStream); + Inherited; +end; + +procedure TCustomExtractor.UnZip(const AZipFileName, aExtractFileName: RawByteString; aOutputFileName: AnsiString); +begin + FStream:=TFileStream.Create(aOutputFileName,fmCreate); + FUnZipper.OnCreateStream:=@DoCreateStream; + FUnzipper.UnzipFile(aZipFileName,aExtractFileName); +end; + +class procedure TUnZipper.UnZip(const AZipFileName, aExtractFileName: RawByteString; aOutputFileName: AnsiString); + + + +begin + With TCustomExtractor.Create(Self.Create) do + try + Unzip(aZipFileName,aExtractFileName,aOutputFileName); + Finally + Free; + end; +end; + +class procedure TUnZipper.Unzip(const AZipFileName: RawByteString; aFileList: array of RawByteString); +begin + With Self.Create do + try + UnZipFiles(aZipFileName,aFileList); + finally + Free; + end; +end; + +class procedure TUnZipper.Unzip(const AZipFileName: RawByteString; aFileList: TStrings); +begin + With Self.Create do + try + UnZipFiles(aZipFileName,aFileList); + finally + Free; + end; +end; + +class procedure TUnZipper.Unzip(const AZipFileName: RawByteString; aFileList: array of RawByteString; aOutputDir: RawByteString; + aFlat: Boolean); +begin + With Self.Create do + try + Flat:=aFlat; + OutputPath:=aOutputDir; + UnZipFiles(aZipFileName,aFileList); + finally + Free; + end; +end; + +class procedure TUnZipper.Unzip(const AZipFileName: RawByteString; aFileList: TStrings; aOutputDir: RawByteString; aFlat: Boolean); +begin + With Self.Create do + try + Flat:=aFlat; + OutputPath:=aOutputDir; + UnZipFiles(aZipFileName,aFileList); + finally + Free; + end; +end; + +procedure TUnZipper.DoEndOfFile; Var ComprPct : Double; - + Uncompressed: QWord; + Compressed: QWord; begin - If (LocalHdr.Uncompressed_Size>0) then - ComprPct := (100.0 * (LocalHdr.Uncompressed_Size - LocalHdr.Compressed_Size)) / LocalHdr.Uncompressed_Size + 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; +constructor TUnZipper.Create; begin FBufSize:=DefaultBufSize; @@ -1991,7 +3179,7 @@ begin FOnPercent:=1; end; -Procedure TUnZipper.Clear; +procedure TUnZipper.Clear; begin FFiles.Clear; @@ -2012,7 +3200,14 @@ begin end; end; -Destructor TUnZipper.Destroy; +procedure TUnZipper.Terminate; +begin + FTerminated:=True; + if Assigned(FCurrentDecompressor) then + FCurrentDecompressor.Terminate; +end; + +destructor TUnZipper.Destroy; begin Clear; @@ -2023,13 +3218,27 @@ end; { TZipFileEntry } -function TZipFileEntry.GetArchiveFileName: String; +function TZipFileEntry.GetArchiveFileName: AnsiString; 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 @@ -2038,12 +3247,17 @@ begin {$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)] in ['/', '\']); + Result := (DiskFileName <> '') and (DiskFileName[Length(DiskFileName)] = DirectorySeparator); if Attributes <> 0 then begin case OS of @@ -2065,6 +3279,49 @@ begin end; end; +procedure TZipFileEntry.SetArchiveFileName(const AValue: AnsiString); + +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: AnsiString); +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 @@ -2098,21 +3355,21 @@ begin Items[AIndex]:=AValue; end; -function TZipFileEntries.AddFileEntry(const ADiskFileName: String): TZipFileEntry; +function TZipFileEntries.AddFileEntry(const ADiskFileName: AnsiString): TZipFileEntry; begin Result:=Add as TZipFileEntry; Result.DiskFileName:=ADiskFileName; end; function TZipFileEntries.AddFileEntry(const ADiskFileName, - AArchiveFileName: String): TZipFileEntry; + AArchiveFileName: AnsiString): TZipFileEntry; begin Result:=AddFileEntry(ADiskFileName); Result.ArchiveFileName:=AArchiveFileName; end; function TZipFileEntries.AddFileEntry(const AStream: TSTream; - const AArchiveFileName: String): TZipFileEntry; + const AArchiveFileName: AnsiString): TZipFileEntry; begin Result:=Add as TZipFileEntry; Result.Stream:=AStream; @@ -2128,6 +3385,7 @@ begin For I:=0 to List.Count-1 do AddFileEntry(List[i]); end; + { TFullZipFileEntries } function TFullZipFileEntries.GetFZ(AIndex : Integer): TFullZipFileEntry; @@ -2142,4 +3400,3 @@ begin end; End. -{$ENDIF} diff --git a/components/fpspreadsheet/source/common/xlsxooxml.pas b/components/fpspreadsheet/source/common/xlsxooxml.pas index 88b938d4a..1703344af 100644 --- a/components/fpspreadsheet/source/common/xlsxooxml.pas +++ b/components/fpspreadsheet/source/common/xlsxooxml.pas @@ -37,10 +37,10 @@ interface uses Classes, SysUtils, laz2_xmlread, laz2_DOM, avglvltree, - {$IF FPC_FULLVERSION >= 20701} - zipper, - {$ELSE} + {$IFDEF FPS_PATCHED_ZIPPER} fpszipper, + {$ELSE} + zipper, {$ENDIF} fpsTypes, fpsUtils, fpsReaderWriter, fpsNumFormat, fpsPalette, fpsConditionalFormat, diff --git a/components/fpspreadsheet/source/crypto/fpsopendocument_crypto.pas b/components/fpspreadsheet/source/crypto/fpsopendocument_crypto.pas index 79d7f7154..f10b21b55 100644 --- a/components/fpspreadsheet/source/crypto/fpsopendocument_crypto.pas +++ b/components/fpspreadsheet/source/crypto/fpsopendocument_crypto.pas @@ -1,7 +1,7 @@ unit fpsOpenDocument_Crypto; {$MODE ObjFPC}{$H+} -{$DEFINE UNZIP_ABBREVIA} // Remove this define when zipper is fixed. +{.$DEFINE UNZIP_ABBREVIA} // Remove this define when zipper is fixed. interface diff --git a/components/fpspreadsheet/source/fps.inc b/components/fpspreadsheet/source/fps.inc index c4c819b17..d2ff3b046 100644 --- a/components/fpspreadsheet/source/fps.inc +++ b/components/fpspreadsheet/source/fps.inc @@ -62,3 +62,8 @@ e.g. before v3.0 } {.$DEFINE FPS_NO_STRING_SPLIT} +{ Very old FPC versions do not contain zip support in the unit zipper, and + until v3.3 zipper did not read pass-word protected ods files correctly. + Therefore, the following define must be activated if FPC is v3.3 or older. } +{$DEFINE FPS_PATCHED_ZIPPER} +