1{ 2 $Id: header,v 1.3 2013/05/26 06:33:45 michael Exp $ 3 This file is part of the Free Component Library (FCL) 4 Copyright (c) 1999-2014 by the Free Pascal development team 5 6 See the file COPYING.FPC, included in this distribution, 7 for details about the copyright. 8 9 This program is distributed in the hope that it will be useful, 10 but WITHOUT ANY WARRANTY; without even the implied warranty of 11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 12 13 **********************************************************************} 14{$mode objfpc} 15{$h+} 16unit Zipper; 17 18Interface 19 20Uses 21 {$IFDEF UNIX} 22 BaseUnix, 23 {$ENDIF} 24 SysUtils,Classes,zstream; 25 26 27Const 28 { Signatures } 29 END_OF_CENTRAL_DIR_SIGNATURE = $06054B50; 30 ZIP64_END_OF_CENTRAL_DIR_SIGNATURE = $06064B50; 31 ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIGNATURE = $07064B50; 32 LOCAL_FILE_HEADER_SIGNATURE = $04034B50; 33 CENTRAL_FILE_HEADER_SIGNATURE = $02014B50; 34 ZIP64_HEADER_ID = $0001; 35 // infozip unicode path 36 INFOZIP_UNICODE_PATH_ID = $7075; 37 EFS_LANGUAGE_ENCODING_FLAG = $800; 38 39const 40 OS_FAT = 0; //MS-DOS and OS/2 (FAT/VFAT/FAT32) 41 OS_UNIX = 3; 42 OS_OS2 = 6; //OS/2 HPFS 43 OS_NTFS = 10; 44 OS_VFAT = 14; 45 OS_OSX = 19; 46 47 UNIX_MASK = $F000; 48 UNIX_FIFO = $1000; 49 UNIX_CHAR = $2000; 50 UNIX_DIR = $4000; 51 UNIX_BLK = $6000; 52 UNIX_FILE = $8000; 53 UNIX_LINK = $A000; 54 UNIX_SOCK = $C000; 55 56 57 UNIX_RUSR = $0100; 58 UNIX_WUSR = $0080; 59 UNIX_XUSR = $0040; 60 61 UNIX_RGRP = $0020; 62 UNIX_WGRP = $0010; 63 UNIX_XGRP = $0008; 64 65 UNIX_ROTH = $0004; 66 UNIX_WOTH = $0002; 67 UNIX_XOTH = $0001; 68 69 UNIX_DEFAULT = UNIX_RUSR or UNIX_WUSR or UNIX_XUSR or UNIX_RGRP or UNIX_ROTH; 70 71Type 72 Local_File_Header_Type = Packed Record //1 per zipped file 73 Signature : LongInt; //4 bytes 74 Extract_Version_Reqd : Word; //if zip64: >= 45 75 Bit_Flag : Word; //"General purpose bit flag in PKZip appnote 76 Compress_Method : Word; 77 Last_Mod_Time : Word; 78 Last_Mod_Date : Word; 79 Crc32 : LongWord; 80 Compressed_Size : LongWord; 81 Uncompressed_Size : LongWord; 82 Filename_Length : Word; 83 Extra_Field_Length : Word; //refers to Extensible data field size 84 end; 85 86 Extensible_Data_Field_Header_Type = Packed Record 87 // Beginning of extra field 88 // after local file header 89 // after central directory header 90 Header_ID : Word; 91 //e.g. $0001 (ZIP64_HEADER_ID) Zip64 extended information extra field 92 // $0009 OS/2: extended attributes 93 // $000a NTFS: (Win32 really) 94 // $000d UNIX: uid, gid etc 95 Data_Size : Word; //size of following field data 96 //... field data should follow... 97 end; 98 99 Zip64_Extended_Info_Field_Type = Packed Record //goes after Extensible_Data_Field_Header_Type 100 // overrides Local and Central Directory data 101 // stored in extra field 102 Original_Size : QWord; //Uncompressed file 103 Compressed_Size : QWord; //Compressed data 104 Relative_Hdr_Offset : QWord; //Offset that leads to local header record 105 Disk_Start_Number : LongWord; //on which disk this file starts 106 end; 107 108 { Define the Central Directory record types } 109 110 Central_File_Header_Type = Packed Record 111 Signature : LongInt; //4 bytes 112 MadeBy_Version : Word; //if zip64: lower byte >= 45 113 Extract_Version_Reqd : Word; //if zip64: >=45 114 Bit_Flag : Word; //General purpose bit flag in PKZip appnote 115 Compress_Method : Word; 116 Last_Mod_Time : Word; 117 Last_Mod_Date : Word; 118 Crc32 : LongWord; 119 Compressed_Size : LongWord; 120 Uncompressed_Size : LongWord; 121 Filename_Length : Word; 122 Extra_Field_Length : Word; 123 File_Comment_Length : Word; 124 Starting_Disk_Num : Word; 125 Internal_Attributes : Word; 126 External_Attributes : LongWord; 127 Local_Header_Offset : LongWord; // if zip64: 0xFFFFFFFF 128 End; 129 130 End_of_Central_Dir_Type = Packed Record //End of central directory record 131 //1 per zip file, near end, before comment 132 Signature : LongInt; //4 bytes 133 Disk_Number : Word; 134 Central_Dir_Start_Disk : Word; 135 Entries_This_Disk : Word; 136 Total_Entries : Word; 137 Central_Dir_Size : LongWord; 138 Start_Disk_Offset : LongWord; 139 ZipFile_Comment_Length : Word; 140 end; 141 142 Zip64_End_of_Central_Dir_type = Packed Record 143 Signature : LongInt; 144 Record_Size : QWord; 145 Version_Made_By : Word; //lower byte >= 45 146 Extract_Version_Reqd : Word; //version >= 45 147 Disk_Number : LongWord; 148 Central_Dir_Start_Disk : LongWord; 149 Entries_This_Disk : QWord; 150 Total_Entries : QWord; 151 Central_Dir_Size : QWord; 152 Start_Disk_Offset : QWord; 153 end; 154 155 Zip64_End_of_Central_Dir_Locator_type = Packed Record //comes after Zip64_End_of_Central_Dir_type 156 Signature : LongInt; 157 Zip64_EOCD_Start_Disk : LongWord; //Starting disk for Zip64 End of Central Directory record 158 Central_Dir_Zip64_EOCD_Offset : QWord; //offset of Zip64 End of Central Directory record 159 Total_Disks : LongWord; //total number of disks (contained in zip) 160 end; 161 162Const 163 Crc_32_Tab : Array[0..255] of LongWord = ( 164 $00000000, $77073096, $ee0e612c, $990951ba, $076dc419, $706af48f, $e963a535, $9e6495a3, 165 $0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd, $e7b82d07, $90bf1d91, 166 $1db71064, $6ab020f2, $f3b97148, $84be41de, $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7, 167 $136c9856, $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9, $fa0f3d63, $8d080df5, 168 $3b6e20c8, $4c69105e, $d56041e4, $a2677172, $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b, 169 $35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940, $32d86ce3, $45df5c75, $dcd60dcf, $abd13d59, 170 $26d930ac, $51de003a, $c8d75180, $bfd06116, $21b4f4b5, $56b3c423, $cfba9599, $b8bda50f, 171 $2802b89e, $5f058808, $c60cd9b2, $b10be924, $2f6f7c87, $58684c11, $c1611dab, $b6662d3d, 172 $76dc4190, $01db7106, $98d220bc, $efd5102a, $71b18589, $06b6b51f, $9fbfe4a5, $e8b8d433, 173 $7807c9a2, $0f00f934, $9609a88e, $e10e9818, $7f6a0dbb, $086d3d2d, $91646c97, $e6635c01, 174 $6b6b51f4, $1c6c6162, $856530d8, $f262004e, $6c0695ed, $1b01a57b, $8208f4c1, $f50fc457, 175 $65b0d9c6, $12b7e950, $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3, $fbd44c65, 176 $4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, $4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb, 177 $4369e96a, $346ed9fc, $ad678846, $da60b8d0, $44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9, 178 $5005713c, $270241aa, $be0b1010, $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f, 179 $5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, $2eb40d81, $b7bd5c3b, $c0ba6cad, 180 $edb88320, $9abfb3b6, $03b6e20c, $74b1d29a, $ead54739, $9dd277af, $04db2615, $73dc1683, 181 $e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8, $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1, 182 $f00f9344, $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb, $196c3671, $6e6b06e7, 183 $fed41b76, $89d32be0, $10da7a5a, $67dd4acc, $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5, 184 $d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252, $d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b, 185 $d80d2bda, $af0a1b4c, $36034af6, $41047a60, $df60efc3, $a867df55, $316e8eef, $4669be79, 186 $cb61b38c, $bc66831a, $256fd2a0, $5268e236, $cc0c7795, $bb0b4703, $220216b9, $5505262f, 187 $c5ba3bbe, $b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31, $2cd99e8b, $5bdeae1d, 188 $9b64c2b0, $ec63f226, $756aa39c, $026d930a, $9c0906a9, $eb0e363f, $72076785, $05005713, 189 $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38, $92d28e9b, $e5d5be0d, $7cdcefb7, $0bdbdf21, 190 $86d3d2d4, $f1d4e242, $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1, $18b74777, 191 $88085ae6, $ff0f6a70, $66063bca, $11010b5c, $8f659eff, $f862ae69, $616bffd3, $166ccf45, 192 $a00ae278, $d70dd2ee, $4e048354, $3903b3c2, $a7672661, $d06016f7, $4969474d, $3e6e77db, 193 $aed16a4a, $d9d65adc, $40df0b66, $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9, 194 $bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605, $cdd70693, $54de5729, $23d967bf, 195 $b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94, $b40bbe37, $c30c8ea1, $5a05df1b, $2d02ef8d 196 ); 197 198Type 199 200 TProgressEvent = Procedure(Sender : TObject; Const Pct : Double) of object; 201 TProgressEventEx = Procedure(Sender : TObject; Const ATotPos, ATotSize: Int64) of object; 202 TOnEndOfFileEvent = Procedure(Sender : TObject; Const Ratio : Double) of object; 203 TOnStartFileEvent = Procedure(Sender : TObject; Const AFileName : String) of object; 204 205Type 206 207 { TCompressor } 208 TCompressor = Class(TObject) 209 private 210 FTerminated: Boolean; 211 Protected 212 FInFile : TStream; { I/O file variables } 213 FOutFile : TStream; 214 FCrc32Val : LongWord; { CRC calculation variable } 215 FBufferSize : LongWord; 216 FOnPercent : Integer; 217 FOnProgress : TProgressEvent; 218 Procedure UpdC32(Octet: Byte); 219 Public 220 Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord); virtual; 221 Procedure Compress; Virtual; Abstract; 222 Class Function ZipID : Word; virtual; Abstract; 223 Class Function ZipVersionReqd: Word; virtual; Abstract; 224 Function ZipBitFlag: Word; virtual; Abstract; 225 Procedure Terminate; 226 Property BufferSize : LongWord read FBufferSize; 227 Property OnPercent : Integer Read FOnPercent Write FOnPercent; 228 Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress; 229 Property Crc32Val : LongWord Read FCrc32Val Write FCrc32Val; 230 Property Terminated : Boolean Read FTerminated; 231 end; 232 233 { TDeCompressor } 234 TDeCompressor = Class(TObject) 235 Protected 236 FInFile : TStream; { I/O file variables } 237 FOutFile : TStream; 238 FCrc32Val : LongWord; { CRC calculation variable } 239 FBufferSize : LongWord; 240 FOnPercent : Integer; 241 FOnProgress : TProgressEvent; 242 FOnProgressEx: TProgressEventEx; 243 FTotPos : Int64; 244 FTotSize : Int64; 245 FTerminated : Boolean; 246 Procedure UpdC32(Octet: Byte); 247 Public 248 Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord); virtual; 249 Procedure DeCompress; Virtual; Abstract; 250 Procedure Terminate; 251 Class Function ZipID : Word; virtual; Abstract; 252 Property BufferSize : LongWord read FBufferSize; 253 Property OnPercent : Integer Read FOnPercent Write FOnPercent; 254 Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress; 255 Property OnProgressEx : TProgressEventEx Read FOnProgressEx Write FOnProgressEx; 256 Property Crc32Val : LongWord Read FCrc32Val Write FCrc32Val; 257 Property Terminated : Boolean Read FTerminated; 258 end; 259 260 { TShrinker } 261 262Const 263 TABLESIZE = 8191; 264 FIRSTENTRY = 257; 265 266Type 267 CodeRec = Packed Record 268 Child : Smallint; 269 Sibling : Smallint; 270 Suffix : Byte; 271 end; 272 CodeArray = Array[0..TABLESIZE] of CodeRec; 273 TablePtr = ^CodeArray; 274 275 FreeListPtr = ^FreeListArray; 276 FreeListArray = Array[FIRSTENTRY..TABLESIZE] of Word; 277 278 BufPtr = PByte; 279 280 TShrinker = Class(TCompressor) 281 Private 282 FBufSize : LongWord; 283 MaxInBufIdx : LongWord; { Count of valid chars in input buffer } 284 InputEof : Boolean; { End of file indicator } 285 CodeTable : TablePtr; { Points to code table for LZW compression } 286 FreeList : FreeListPtr; { Table of free code table entries } 287 NextFree : Word; { Index into free list table } 288 289 ClearList : Array[0..1023] of Byte; { Bit mapped structure used in } 290 { during adaptive resets } 291 CodeSize : Byte; { Size of codes (in bits) currently being written } 292 MaxCode : Word; { Largest code that can be written in CodeSize bits } 293 InBufIdx, { Points to next char in buffer to be read } 294 OutBufIdx : LongWord; { Points to next free space in output buffer } 295 InBuf, { I/O buffers } 296 OutBuf : BufPtr; 297 FirstCh : Boolean; { Flag indicating the START of a shrink operation } 298 TableFull : Boolean; { Flag indicating a full symbol table } 299 SaveByte : Byte; { Output code buffer } 300 BitsUsed : Byte; { Index into output code buffer } 301 BytesIn : LongWord; { Count of input file bytes processed } 302 BytesOut : LongWord; { Count of output bytes } 303 FOnBytes : LongWord; 304 Procedure FillInputBuffer; 305 Procedure WriteOutputBuffer; 306 Procedure FlushOutput; 307 Procedure PutChar(B : Byte); 308 procedure PutCode(Code : Smallint); 309 Procedure InitializeCodeTable; 310 Procedure Prune(Parent : Word); 311 Procedure Clear_Table; 312 Procedure Table_Add(Prefix : Word; Suffix : Byte); 313 function Table_Lookup(TargetPrefix : Smallint; 314 TargetSuffix : Byte; 315 Out FoundAt : Smallint) : Boolean; 316 Procedure Shrink(Suffix : Smallint); 317 Procedure ProcessLine(Const Source : String); 318 Procedure DoOnProgress(Const Pct : Double); Virtual; 319 Public 320 Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord); override; 321 Destructor Destroy; override; 322 Procedure Compress; override; 323 Class Function ZipID : Word; override; 324 Class Function ZipVersionReqd : Word; override; 325 Function ZipBitFlag : Word; override; 326 end; 327 328 { TDeflater } 329 330 TDeflater = Class(TCompressor) 331 private 332 FCompressionLevel: TCompressionlevel; 333 Public 334 Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord);override; 335 Procedure Compress; override; 336 Class Function ZipID : Word; override; 337 Class Function ZipVersionReqd : Word; override; 338 Function ZipBitFlag : Word; override; 339 Property CompressionLevel : TCompressionlevel Read FCompressionLevel Write FCompressionLevel; 340 end; 341 342 { TInflater } 343 344 TInflater = Class(TDeCompressor) 345 Public 346 Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord);override; 347 Procedure DeCompress; override; 348 Class Function ZipID : Word; override; 349 end; 350 351 { TZipFileEntry } 352 353 TZipFileEntry = Class(TCollectionItem) 354 private 355 FArchiveFileName: String; //Name of the file as it appears in the zip file list 356 FUTF8FileName : UTF8String; 357 FUTF8DiskFileName : UTF8String; 358 FAttributes: LongWord; 359 FDateTime: TDateTime; 360 FDiskFileName: String; {Name of the file on disk (i.e. uncompressed. Can be empty if based on a stream.); 361 uses local OS/filesystem directory separators} 362 FHeaderPos: int64; 363 FNeedsZip64: Boolean; //flags whether filesize is big enough so we need a zip64 entry 364 FOS: Byte; 365 FSize: Int64; 366 FStream: TStream; 367 FCompressionLevel: TCompressionlevel; 368 function GetArchiveFileName: String; 369 function GetUTF8ArchiveFileName: UTF8String; 370 function GetUTF8DiskFileName: UTF8String; 371 procedure SetArchiveFileName(Const AValue: String); 372 procedure SetDiskFileName(Const AValue: String); 373 procedure SetUTF8ArchiveFileName(AValue: UTF8String); 374 procedure SetUTF8DiskFileName(AValue: UTF8String); 375 Protected 376 // For multi-disk support, a disk number property could be added here. 377 Property HdrPos : int64 Read FHeaderPos Write FheaderPos; 378 Property NeedsZip64 : boolean Read FNeedsZip64 Write FNeedsZip64; 379 Public 380 constructor Create(ACollection: TCollection); override; 381 function IsDirectory: Boolean; 382 function IsLink: Boolean; 383 Procedure Assign(Source : TPersistent); override; 384 Property Stream : TStream Read FStream Write FStream; 385 Published 386 Property ArchiveFileName : String Read GetArchiveFileName Write SetArchiveFileName; 387 Property UTF8ArchiveFileName : UTF8String Read GetUTF8ArchiveFileName Write SetUTF8ArchiveFileName; 388 Property DiskFileName : String Read FDiskFileName Write SetDiskFileName; 389 Property UTF8DiskFileName : UTF8String Read GetUTF8DiskFileName Write SetUTF8DiskFileName; 390 Property Size : Int64 Read FSize Write FSize; 391 Property DateTime : TDateTime Read FDateTime Write FDateTime; 392 property OS: Byte read FOS write FOS; 393 property Attributes: LongWord read FAttributes write FAttributes; 394 Property CompressionLevel: TCompressionlevel read FCompressionLevel write FCompressionLevel; 395 end; 396 397 { TZipFileEntries } 398 399 TZipFileEntries = Class(TCollection) 400 private 401 function GetZ(AIndex : Integer): TZipFileEntry; 402 procedure SetZ(AIndex : Integer; const AValue: TZipFileEntry); 403 Public 404 Function AddFileEntry(Const ADiskFileName : String): TZipFileEntry; 405 Function AddFileEntry(Const ADiskFileName, AArchiveFileName : String): TZipFileEntry; 406 Function AddFileEntry(Const AStream : TSTream; Const AArchiveFileName : String): TZipFileEntry; 407 Procedure AddFileEntries(Const List : TStrings); 408 Property Entries[AIndex : Integer] : TZipFileEntry Read GetZ Write SetZ; default; 409 end; 410 411 { TZipper } 412 413 TZipper = Class(TObject) 414 Private 415 FEntries : TZipFileEntries; 416 FTerminated: Boolean; 417 FZipping : Boolean; 418 FBufSize : LongWord; 419 FFileName : RawByteString; { Name of resulting Zip file } 420 FFileComment : String; 421 FFiles : TStrings; 422 FInMemSize : Int64; 423 FZipFileNeedsZip64 : Boolean; //flags whether at least one file is big enough to require a zip64 record 424 FOutStream : TStream; 425 FInFile : TStream; { I/O file variables } 426 LocalHdr : Local_File_Header_Type; 427 LocalZip64ExtHdr: Extensible_Data_Field_Header_Type; //Extra field header fixed to zip64 (i.e. .ID=1) 428 LocalZip64Fld : Zip64_Extended_Info_Field_Type; //header is in LocalZip64ExtHdr 429 CentralHdr : Central_File_Header_Type; 430 EndHdr : End_of_Central_Dir_Type; 431 FOnPercent : LongInt; 432 FOnProgress : TProgressEvent; 433 FOnEndOfFile : TOnEndOfFileEvent; 434 FOnStartFile : TOnStartFileEvent; 435 FCurrentCompressor : TCompressor; 436 FUseLanguageEncoding: Boolean; 437 function CheckEntries: Integer; 438 procedure SetEntries(const AValue: TZipFileEntries); 439 Protected 440 Procedure CloseInput(Item : TZipFileEntry); 441 Procedure StartZipFile(Item : TZipFileEntry); 442 Function UpdateZipHeader(Item : TZipFileEntry; FZip : TStream; ACRC : LongWord;AMethod : Word; AZipVersionReqd : Word; AZipBitFlag : Word) : Boolean; 443 Procedure BuildZipDirectory; //Builds central directory based on local headers 444 Procedure DoEndOfFile; 445 Procedure ZipOneFile(Item : TZipFileEntry); virtual; 446 Function OpenInput(Item : TZipFileEntry) : Boolean; 447 Procedure GetFileInfo; 448 Procedure SetBufSize(Value : LongWord); 449 Procedure SetFileName(Value : RawByteString); 450 Function CreateCompressor(Item : TZipFileEntry; AinFile,AZipStream : TStream) : TCompressor; virtual; 451 Property NeedsZip64 : boolean Read FZipFileNeedsZip64 Write FZipFileNeedsZip64; 452 Public 453 Constructor Create; 454 Destructor Destroy;override; 455 Procedure ZipAllFiles; virtual; 456 // Saves zip to file and changes FileName 457 Procedure SaveToFile(const AFileName: RawByteString); 458 // Saves zip to stream 459 Procedure SaveToStream(AStream: TStream); 460 // Zips specified files into a zip with name AFileName 461 Procedure ZipFile(const aFileToBeZipped : RawByteString); 462 Procedure ZipFile(const AZipFileName,aFileToBeZipped : RawByteString); 463 Procedure ZipFiles(const AZipFileName : RawByteString; FileList : TStrings); 464 Procedure ZipFiles(const AZipFileName : RawByteString; const FileList : Array of RawbyteString); 465 Procedure ZipFiles(const aFileList : Array of RawbyteString); 466 Procedure ZipFiles(FileList : TStrings); 467 // Zips specified entries into a zip with name AFileName 468 Procedure ZipFiles(const AZipFileName : RawByteString; Entries : TZipFileEntries); 469 Procedure ZipFiles(Entries : TZipFileEntries); 470 // Easy access method 471 // Zip single file 472 Class Procedure Zip(const AZipFileName : RawByteString; const aFileToBeZipped: RawByteString); 473 // Zip multiple file 474 Class Procedure Zip(const AZipFileName : RawByteString; aFileList : Array of RawByteString); 475 Class Procedure Zip(const AZipFileName : RawByteString; aFileList : TStrings); 476 Procedure Clear; 477 Procedure Terminate; 478 Public 479 Property BufferSize : LongWord Read FBufSize Write SetBufSize; 480 Property OnPercent : Integer Read FOnPercent Write FOnPercent; 481 Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress; 482 Property OnStartFile : TOnStartFileEvent Read FOnStartFile Write FOnStartFile; 483 Property OnEndFile : TOnEndOfFileEvent Read FOnEndOfFile Write FOnEndOfFile; 484 Property FileName : RawByteString Read FFileName Write SetFileName; 485 Property FileComment: String Read FFileComment Write FFileComment; 486 // Deprecated. Use Entries.AddFileEntry(FileName) or Entries.AddFileEntries(List) instead. 487 Property Files : TStrings Read FFiles; deprecated; 488 Property InMemSize : Int64 Read FInMemSize Write FInMemSize; 489 Property Entries : TZipFileEntries Read FEntries Write SetEntries; 490 Property Terminated : Boolean Read FTerminated; 491 // EFS/language encoding using UTF-8 492 Property UseLanguageEncoding : Boolean Read FUseLanguageEncoding Write FUseLanguageEncoding; 493 end; 494 495 { TFullZipFileEntry } 496 497 TFullZipFileEntry = Class(TZipFileEntry) 498 private 499 FBitFlags: Word; 500 FCompressedSize: QWord; 501 FCompressMethod: Word; 502 FCRC32: LongWord; 503 Public 504 Property BitFlags : Word Read FBitFlags; 505 Property CompressMethod : Word Read FCompressMethod; 506 Property CompressedSize : QWord Read FCompressedSize; 507 property CRC32: LongWord read FCRC32 write FCRC32; 508 end; 509 510 TOnCustomStreamEvent = Procedure(Sender : TObject; var AStream : TStream; AItem : TFullZipFileEntry) of object; 511 TCustomInputStreamEvent = Procedure(Sender: TObject; var AStream: TStream) of object; 512 513 { TFullZipFileEntries } 514 515 TFullZipFileEntries = Class(TZipFileEntries) 516 private 517 function GetFZ(AIndex : Integer): TFullZipFileEntry; 518 procedure SetFZ(AIndex : Integer; const AValue: TFullZipFileEntry); 519 Public 520 Property FullEntries[AIndex : Integer] : TFullZipFileEntry Read GetFZ Write SetFZ; default; 521 end; 522 523 { TUnZipper } 524 525 TUnZipper = Class(TObject) 526 Private 527 FOnCloseInputStream: TCustomInputStreamEvent; 528 FOnCreateStream: TOnCustomStreamEvent; 529 FOnDoneStream: TOnCustomStreamEvent; 530 FOnOpenInputStream: TCustomInputStreamEvent; 531 FUnZipping : Boolean; 532 FBufSize : LongWord; 533 FFileName : RawByteString; { Name of resulting Zip file } 534 FOutputPath : RawByteString; 535 FFileComment: String; 536 FEntries : TFullZipFileEntries; 537 FFiles : TStrings; 538 FUseUTF8 : Boolean; 539 FFlat : Boolean; 540 FZipStream : TStream; { I/O file variables } 541 LocalHdr : Local_File_Header_Type; //Local header, before compressed file data 542 LocalZip64Fld : Zip64_Extended_Info_Field_Type; //header is in LocalZip64ExtHdr 543 CentralHdr : Central_File_Header_Type; 544 FTotPos : Int64; 545 FTotSize : Int64; 546 FTerminated: Boolean; 547 FOnPercent : LongInt; 548 FOnProgress : TProgressEvent; 549 FOnProgressEx : TProgressEventEx; 550 FOnEndOfFile : TOnEndOfFileEvent; 551 FOnStartFile : TOnStartFileEvent; 552 FCurrentDecompressor: TDecompressor; 553 function CalcTotalSize(AllFiles: Boolean): Int64; 554 function IsMatch(I: TFullZipFileEntry): Boolean; 555 Protected 556 Procedure OpenInput; 557 Procedure CloseOutput(Item : TFullZipFileEntry; var OutStream: TStream); 558 Procedure CloseInput; 559 Procedure FindEndHeaders( 560 out AEndHdr: End_of_Central_Dir_Type; 561 out AEndHdrPos: Int64; 562 out AEndZip64Hdr: Zip64_End_of_Central_Dir_type; 563 out AEndZip64HdrPos: Int64); 564 Procedure ReadZipDirectory; 565 Procedure ReadZipHeader(Item : TFullZipFileEntry; out AMethod : Word); 566 Procedure DoEndOfFile; 567 Procedure UnZipOneFile(Item : TFullZipFileEntry); virtual; 568 Function OpenOutput(OutFileName : RawByteString; Out OutStream: TStream; Item : TFullZipFileEntry) : Boolean; 569 Procedure SetBufSize(Value : LongWord); 570 Procedure SetFileName(Value : RawByteString); 571 Procedure SetOutputPath(Value: RawByteString); 572 Function CreateDeCompressor(Item : TZipFileEntry; AMethod : Word;AZipFile,AOutFile : TStream) : TDeCompressor; virtual; 573 Public 574 Constructor Create; 575 Destructor Destroy;override; 576 Procedure UnZipAllFiles; virtual; 577 Procedure UnZipFile(const aExtractFileName: RawByteString); 578 Procedure UnZipFile(const AZipFileName, aExtractFileName: RawByteString); 579 Procedure UnZipFiles(const AZipFileName : RawByteString; FileList : TStrings); 580 Procedure UnZipFiles(const AZipFileName : RawByteString; aFileList : Array of RawBytestring); 581 Procedure UnZipFiles(aFileList : TStrings); 582 Procedure UnZipAllFiles(const AZipFileName : RawByteString); 583 // Easy access methods. No instance needed, uses default options. 584 // Unzip all files 585 Class Procedure Unzip(const AZipFileName : RawByteString); 586 // Unzip a single file. 587 Class Procedure Unzip(const AZipFileName : RawByteString;aExtractFileName : RawByteString); 588 // Unzip several files 589 Class Procedure Unzip(const AZipFileName : RawByteString; aFileList : Array of RawByteString); 590 Class Procedure Unzip(const AZipFileName : RawByteString; aFileList : TStrings); 591 Procedure Clear; 592 Procedure Examine; 593 Procedure Terminate; 594 Public 595 Property BufferSize : LongWord Read FBufSize Write SetBufSize; 596 Property OnOpenInputStream: TCustomInputStreamEvent read FOnOpenInputStream write FOnOpenInputStream; 597 Property OnCloseInputStream: TCustomInputStreamEvent read FOnCloseInputStream write FOnCloseInputStream; 598 Property OnCreateStream : TOnCustomStreamEvent Read FOnCreateStream Write FOnCreateStream; 599 Property OnDoneStream : TOnCustomStreamEvent Read FOnDoneStream Write FOnDoneStream; 600 Property OnPercent : Integer Read FOnPercent Write FOnPercent; 601 Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress; 602 Property OnProgressEx : TProgressEventEx Read FOnProgressEx Write FOnProgressEx; 603 Property OnStartFile : TOnStartFileEvent Read FOnStartFile Write FOnStartFile; 604 Property OnEndFile : TOnEndOfFileEvent Read FOnEndOfFile Write FOnEndOfFile; 605 Property FileName : RawByteString Read FFileName Write SetFileName; 606 Property OutputPath : RawByteString Read FOutputPath Write SetOutputPath; 607 Property FileComment: String Read FFileComment; 608 Property Files : TStrings Read FFiles; 609 Property Entries : TFullZipFileEntries Read FEntries; 610 Property UseUTF8 : Boolean Read FUseUTF8 Write FUseUTF8; 611 Property Flat : Boolean Read FFlat Write FFlat; // enable flat extraction, like -j when using unzip 612 Property Terminated : Boolean Read FTerminated; 613 end; 614 615 EZipError = Class(Exception); 616 617Implementation 618 619uses rtlconsts; 620 621ResourceString 622 SErrBufsizeChange = 'Changing buffer size is not allowed while (un)zipping.'; 623 SErrFileChange = 'Changing output file name is not allowed while (un)zipping.'; 624 SErrInvalidCRC = 'Invalid CRC checksum while unzipping %s.'; 625 SErrCorruptZIP = 'Corrupt ZIP file %s.'; 626 SErrUnsupportedCompressionFormat = 'Unsupported compression format %d'; 627 SErrUnsupportedMultipleDisksCD = 'A central directory split over multiple disks is unsupported.'; 628 SErrMaxEntries = 'Encountered %d file entries; maximum supported is %d.'; 629 SErrMissingFileName = 'Missing filename in entry %d.'; 630 SErrMissingArchiveName = 'Missing archive filename in streamed entry %d.'; 631 SErrFileDoesNotExist = 'File "%s" does not exist.'; 632 SErrPosTooLarge = 'Position/offset %d is larger than maximum supported %d.'; 633 SErrNoFileName = 'No archive filename for examine operation.'; 634 SErrNoStream = 'No stream is opened.'; 635 SErrEncryptionNotSupported = 'Cannot unzip item "%s" : encryption is not supported.'; 636 SErrPatchSetNotSupported = 'Cannot unzip item "%s" : Patch sets are not supported.'; 637 638{ --------------------------------------------------------------------- 639 Auxiliary 640 ---------------------------------------------------------------------} 641Type 642 // A local version of TFileStream which uses rawbytestring. It 643 TFileStream = class(THandleStream) 644 Private 645 FFileName : RawBytestring; 646 public 647 constructor Create(const AFileName: RawBytestring; Mode: Word); 648 constructor Create(const AFileName: RawBytestring; Mode: Word; Rights: Cardinal); 649 destructor Destroy; override; 650 property FileName : RawBytestring Read FFilename; 651 end; 652 constructor TFileStream.Create(const AFileName: rawbytestring; Mode: Word); 653 654 begin 655 Create(AFileName,Mode,438); 656 end; 657 658 659 constructor TFileStream.Create(const AFileName: rawbytestring; Mode: Word; Rights: Cardinal); 660 {$ifdef Windows} 661 function FixLongFilename(const Fn: RawByteString): RawByteString; 662 begin 663 Result := Fn; 664 if (Length(Fn)>MAX_PATH) and not ((Pos('\\?\', Fn)=1) or (Pos('\\.\', Fn)=1) or (Pos('\\?\UNC\', Fn)=1)) then 665 begin 666 if (Pos('\\', Fn)=1) and (length(FN)>2) then 667 Insert('?\UNC\',Result,3) 668 else 669 Result:='\\?\'+Fn; 670 end; 671 end; 672 {$endif} 673 674 Var 675 H : Thandle; 676 677 begin 678 {$ifdef Windows} 679 FFileName:=FixLongFilename(AFileName); 680 {$else} 681 FFileName:=AFileName; 682 {$endif} 683 If (Mode and fmCreate) > 0 then 684 H:=FileCreate(FFileName,Mode,Rights) 685 else 686 H:=FileOpen(FFileName,Mode); 687 688 If (THandle(H)=feInvalidHandle) then 689 If Mode=fmcreate then 690 raise EFCreateError.createfmt(SFCreateError,[AFileName]) 691 else 692 raise EFOpenError.Createfmt(SFOpenError,[AFilename]); 693 Inherited Create(H); 694 end; 695 696 697 destructor TFileStream.Destroy; 698 699 begin 700 FileClose(Handle); 701 end; 702 703{$IFDEF FPC_BIG_ENDIAN} 704function SwapLFH(const Values: Local_File_Header_Type): Local_File_Header_Type; 705begin 706 with Values do 707 begin 708 Result.Signature := SwapEndian(Signature); 709 Result.Extract_Version_Reqd := SwapEndian(Extract_Version_Reqd); 710 Result.Bit_Flag := SwapEndian(Bit_Flag); 711 Result.Compress_Method := SwapEndian(Compress_Method); 712 Result.Last_Mod_Time := SwapEndian(Last_Mod_Time); 713 Result.Last_Mod_Date := SwapEndian(Last_Mod_Date); 714 Result.Crc32 := SwapEndian(Crc32); 715 Result.Compressed_Size := SwapEndian(Compressed_Size); 716 Result.Uncompressed_Size := SwapEndian(Uncompressed_Size); 717 Result.Filename_Length := SwapEndian(Filename_Length); 718 Result.Extra_Field_Length := SwapEndian(Extra_Field_Length); 719 end; 720end; 721 722function SwapEDFH(const Values: Extensible_Data_Field_Header_Type): Extensible_Data_Field_Header_Type; 723begin 724 with Values do 725 begin 726 Result.Header_ID := SwapEndian(Header_ID); 727 Result.Data_Size := SwapEndian(Data_Size); 728 end; 729end; 730 731function SwapZ64EIF(const Values: Zip64_Extended_Info_Field_Type): Zip64_Extended_Info_Field_Type; 732begin 733 with Values do 734 begin 735 Result.Original_Size := SwapEndian(Original_Size); 736 Result.Compressed_Size := SwapEndian(Compressed_Size); 737 Result.Relative_Hdr_Offset := SwapEndian(Relative_Hdr_Offset); 738 Result.Disk_Start_Number := SwapEndian(Disk_Start_Number); 739 end; 740end; 741 742function SwapCFH(const Values: Central_File_Header_Type): Central_File_Header_Type; 743begin 744 with Values do 745 begin 746 Result.Signature := SwapEndian(Signature); 747 Result.MadeBy_Version := SwapEndian(MadeBy_Version); 748 Result.Extract_Version_Reqd := SwapEndian(Extract_Version_Reqd); 749 Result.Bit_Flag := SwapEndian(Bit_Flag); 750 Result.Compress_Method := SwapEndian(Compress_Method); 751 Result.Last_Mod_Time := SwapEndian(Last_Mod_Time); 752 Result.Last_Mod_Date := SwapEndian(Last_Mod_Date); 753 Result.Crc32 := SwapEndian(Crc32); 754 Result.Compressed_Size := SwapEndian(Compressed_Size); 755 Result.Uncompressed_Size := SwapEndian(Uncompressed_Size); 756 Result.Filename_Length := SwapEndian(Filename_Length); 757 Result.Extra_Field_Length := SwapEndian(Extra_Field_Length); 758 Result.File_Comment_Length := SwapEndian(File_Comment_Length); 759 Result.Starting_Disk_Num := SwapEndian(Starting_Disk_Num); 760 Result.Internal_Attributes := SwapEndian(Internal_Attributes); 761 Result.External_Attributes := SwapEndian(External_Attributes); 762 Result.Local_Header_Offset := SwapEndian(Local_Header_Offset); 763 end; 764end; 765 766function SwapECD(const Values: End_of_Central_Dir_Type): End_of_Central_Dir_Type; 767begin 768 with Values do 769 begin 770 Result.Signature := SwapEndian(Signature); 771 Result.Disk_Number := SwapEndian(Disk_Number); 772 Result.Central_Dir_Start_Disk := SwapEndian(Central_Dir_Start_Disk); 773 Result.Entries_This_Disk := SwapEndian(Entries_This_Disk); 774 Result.Total_Entries := SwapEndian(Total_Entries); 775 Result.Central_Dir_Size := SwapEndian(Central_Dir_Size); 776 Result.Start_Disk_Offset := SwapEndian(Start_Disk_Offset); 777 Result.ZipFile_Comment_Length := SwapEndian(ZipFile_Comment_Length); 778 end; 779end; 780 781function SwapZ64ECD(const Values: Zip64_End_of_Central_Dir_Type): Zip64_End_of_Central_Dir_Type; 782begin 783 with Values do 784 begin 785 Result.Signature := SwapEndian(Signature); 786 Result.Record_Size := SwapEndian(Record_Size); 787 Result.Version_Made_By := SwapEndian(Version_Made_By); 788 Result.Extract_Version_Reqd := SwapEndian(Extract_Version_Reqd); 789 Result.Disk_Number := SwapEndian(Disk_Number); 790 Result.Central_Dir_Start_Disk := SwapEndian(Central_Dir_Start_Disk); 791 Result.Entries_This_Disk := SwapEndian(Entries_This_Disk); 792 Result.Total_Entries := SwapEndian(Total_Entries); 793 Result.Central_Dir_Size := SwapEndian(Central_Dir_Size); 794 Result.Start_Disk_Offset := SwapEndian(Start_Disk_Offset); 795 end; 796end; 797 798function SwapZ64ECDL(const Values: Zip64_End_of_Central_Dir_Locator_type): Zip64_End_of_Central_Dir_Locator_type; 799begin 800 with Values do 801 begin 802 Result.Signature := SwapEndian(Signature); 803 Result.Zip64_EOCD_Start_Disk := SwapEndian(Zip64_EOCD_Start_Disk); 804 Result.Central_Dir_Zip64_EOCD_Offset := SwapEndian(Central_Dir_Zip64_EOCD_Offset); 805 Result.Total_Disks := SwapEndian(Total_Disks); 806 end; 807end; 808{$ENDIF FPC_BIG_ENDIAN} 809 810Procedure DateTimeToZipDateTime(DT : TDateTime; out ZD,ZT : Word); 811 812Var 813 Y,M,D,H,N,S,MS : Word; 814 815begin 816 DecodeDate(DT,Y,M,D); 817 DecodeTime(DT,H,N,S,MS); 818 if Y<1980 then 819 begin 820 // Invalid date/time; set to earliest possible 821 Y:=0; 822 M:=1; 823 D:=1; 824 H:=0; 825 N:=0; 826 S:=0; 827 MS:=0; 828 end 829 else 830 begin 831 Y:=Y-1980; 832 end; 833 ZD:=d+(32*M)+(512*Y); 834 ZT:=(S div 2)+(32*N)+(2048*h); 835end; 836 837Procedure ZipDateTimeToDateTime(ZD,ZT : Word;out DT : TDateTime); 838 839Var 840 Y,M,D,H,N,S,MS : Word; 841 aDate,aTime : TDateTime; 842 843begin 844 MS:=0; 845 S:=(ZT and 31) shl 1; 846 N:=(ZT shr 5) and 63; 847 H:=ZT shr 11; 848 D:=ZD and 31; 849 M:=(ZD shr 5) and 15; 850 Y:=((ZD shr 9) and 127)+1980; 851 // Some corrections 852 if M < 1 then M := 1; 853 if M > 12 then M:=12; 854 if D < 1 then D := 1; 855 if D>MonthDays[IsLeapYear(Y)][M] then 856 D:=MonthDays[IsLeapYear(Y)][M]; 857 // Try to encode the result, fall back on today if it fails 858 if Not TryEncodeDate(Y,M,D,aDate) then 859 aDate:=Date; 860 if not TryEncodeTime(H,N,S,MS,aTime) then 861 aTime:=Time; 862 // Return result 863 DT:=ComposeDateTime(aDate,ATime); 864end; 865 866 867 868function ZipUnixAttrsToFatAttrs(const Name: String; Attrs: Longint): Longint; 869begin 870 Result := faArchive; 871 872 if (Pos('.', Name) = 1) and (Name <> '.') and (Name <> '..') then 873 Result := Result + faHidden; 874 case (Attrs and UNIX_MASK) of 875 UNIX_DIR: Result := Result + faDirectory; 876 UNIX_LINK: Result := Result + faSymLink; 877 UNIX_FIFO, UNIX_CHAR, UNIX_BLK, UNIX_SOCK: 878 Result := Result + faSysFile; 879 end; 880 881 if (Attrs and UNIX_WUSR) = 0 then 882 Result := Result + faReadOnly; 883end; 884 885function ZipFatAttrsToUnixAttrs(Attrs: Longint): Longint; 886begin 887 Result := UNIX_DEFAULT; 888 if (faReadOnly and Attrs) > 0 then 889 Result := Result and not (UNIX_WUSR); 890 891 if (faSymLink and Attrs) > 0 then 892 Result := Result or UNIX_LINK 893 else 894 if (faDirectory and Attrs) > 0 then 895 Result := Result or UNIX_DIR 896 else 897 Result := Result or UNIX_FILE; 898end; 899 900function CRC32Str(const s:string):DWord; 901var 902 i:Integer; 903begin 904 Result:=$FFFFFFFF; 905 if Length(S)>0 then 906 for i:=1 to Length(s) do 907 Result:=Crc_32_Tab[Byte(Result XOR LongInt(s[i]))] XOR ((Result SHR 8) AND $00FFFFFF); 908 Result:=not Result; 909end; 910 911{ --------------------------------------------------------------------- 912 TDeCompressor 913 ---------------------------------------------------------------------} 914 915 916Procedure TDeCompressor.UpdC32(Octet: Byte); 917 918Begin 919 FCrc32Val := Crc_32_Tab[Byte(FCrc32Val XOR LongInt(Octet))] XOR ((FCrc32Val SHR 8) AND $00FFFFFF); 920end; 921 922constructor TDeCompressor.Create(AInFile, AOutFile: TStream; ABufSize: LongWord); 923begin 924 FinFile:=AInFile; 925 FoutFile:=AOutFile; 926 FBufferSize:=ABufSize; 927 CRC32Val:=$FFFFFFFF; 928end; 929 930procedure TDeCompressor.Terminate; 931begin 932 FTerminated:=True; 933end; 934 935 936{ --------------------------------------------------------------------- 937 TCompressor 938 ---------------------------------------------------------------------} 939 940 941Procedure TCompressor.UpdC32(Octet: Byte); 942 943Begin 944 FCrc32Val := Crc_32_Tab[Byte(FCrc32Val XOR LongInt(Octet))] XOR ((FCrc32Val SHR 8) AND $00FFFFFF); 945end; 946 947constructor TCompressor.Create(AInFile, AOutFile: TStream; ABufSize: LongWord); 948begin 949 FinFile:=AInFile; 950 FoutFile:=AOutFile; 951 FBufferSize:=ABufSize; 952 CRC32Val:=$FFFFFFFF; 953end; 954 955procedure TCompressor.Terminate; 956begin 957 FTerminated:=True; 958end; 959 960 961{ --------------------------------------------------------------------- 962 TDeflater 963 ---------------------------------------------------------------------} 964 965constructor TDeflater.Create(AInFile, AOutFile: TStream; ABufSize: LongWord); 966begin 967 Inherited; 968 FCompressionLevel:=clDefault; 969end; 970 971 972procedure TDeflater.Compress; 973Var 974 Buf : PByte; 975 I,Count,NewCount : integer; 976 C : TCompressionStream; 977 BytesNow : Int64; 978 NextMark : Int64; 979 OnBytes : Int64; 980 FSize : Int64; 981begin 982 CRC32Val:=$FFFFFFFF; 983 Buf:=GetMem(FBufferSize); 984 if FOnPercent = 0 then 985 FOnPercent := 1; 986 OnBytes:=Round((FInFile.Size * FOnPercent) / 100); 987 BytesNow:=0; 988 NextMark := OnBytes; 989 FSize:=FInfile.Size; 990 Try 991 C:=TCompressionStream.Create(FCompressionLevel,FOutFile,True); 992 Try 993 if assigned(FOnProgress) then 994 fOnProgress(self,0); 995 Repeat 996 Count:=FInFile.Read(Buf^,FBufferSize); 997 For I:=0 to Count-1 do 998 UpdC32(Buf[i]); 999 NewCount:=Count; 1000 while (NewCount>0) do 1001 NewCount:=NewCount-C.Write(Buf^,NewCount); 1002 inc(BytesNow,Count); 1003 if BytesNow>NextMark Then 1004 begin 1005 if (FSize>0) and assigned(FOnProgress) Then 1006 FOnProgress(self,100 * ( BytesNow / FSize)); 1007 inc(NextMark,OnBytes); 1008 end; 1009 Until (Count=0) or Terminated; 1010 Finally 1011 C.Free; 1012 end; 1013 Finally 1014 FreeMem(Buf); 1015 end; 1016 if assigned(FOnProgress) then 1017 fOnProgress(self,100.0); 1018 Crc32Val:=NOT Crc32Val; 1019end; 1020 1021class function TDeflater.ZipID: Word; 1022begin 1023 Result:=8; 1024end; 1025 1026class function TDeflater.ZipVersionReqd: Word; 1027begin 1028 Result:=20; 1029end; 1030 1031function TDeflater.ZipBitFlag: Word; 1032begin 1033 case CompressionLevel of 1034 clnone: Result := %110; 1035 clfastest: Result := %100; 1036 cldefault: Result := %000; 1037 clmax: Result := %010; 1038 else 1039 Result := 0; 1040 end; 1041end; 1042 1043{ --------------------------------------------------------------------- 1044 TInflater 1045 ---------------------------------------------------------------------} 1046 1047constructor TInflater.Create(AInFile, AOutFile: TStream; ABufSize: LongWord); 1048begin 1049 Inherited; 1050end; 1051 1052 1053procedure TInflater.DeCompress; 1054 1055Var 1056 Buf : PByte; 1057 I,Count : Integer; 1058 C : TDeCompressionStream; 1059 BytesNow : Integer; 1060 NextMark : Integer; 1061 OnBytes : Integer; 1062 FSize : Integer; 1063 1064begin 1065 CRC32Val:=$FFFFFFFF; 1066 if FOnPercent = 0 then 1067 FOnPercent := 1; 1068 OnBytes:=Round((FInFile.Size * FOnPercent) / 100); 1069 BytesNow:=0; NextMark := OnBytes; 1070 FSize:=FInfile.Size; 1071 1072 If Assigned(FOnProgress) then 1073 fOnProgress(self,0); 1074 1075 Buf:=GetMem(FBufferSize); 1076 Try 1077 C:=TDeCompressionStream.Create(FInFile,True); 1078 Try 1079 Repeat 1080 Count:=C.Read(Buf^,FBufferSize); 1081 For I:=0 to Count-1 do 1082 UpdC32(Buf[i]); 1083 FOutFile.WriteBuffer(Buf^,Count); 1084 inc(BytesNow,Count); 1085 if BytesNow>NextMark Then 1086 begin 1087 if (FSize>0) and assigned(FOnProgress) Then 1088 FOnProgress(self,100 * ( BytesNow / FSize)); 1089 if assigned(FOnProgressEx) Then 1090 FOnProgressEx(Self, FTotPos + BytesNow, FTotSize); 1091 inc(NextMark,OnBytes); 1092 end; 1093 Until (Count=0) or Terminated; 1094 FTotPos := FTotPos + FOutFile.Size; 1095 Finally 1096 C.Free; 1097 end; 1098 Finally 1099 FreeMem(Buf); 1100 end; 1101 if assigned(FOnProgress) then 1102 fOnProgress(self,100.0); 1103 if assigned(FOnProgressEx) then 1104 FOnProgressEx(Self, FTotPos, FTotSize); 1105 Crc32Val:=NOT Crc32Val; 1106end; 1107 1108class function TInflater.ZipID: Word; 1109begin 1110 Result:=8; 1111end; 1112 1113 1114{ --------------------------------------------------------------------- 1115 TShrinker 1116 ---------------------------------------------------------------------} 1117 1118Const 1119 DefaultInMemSize = 256*1024; { Files larger than 256k are processed on disk } 1120 DefaultBufSize = 16384; { Use 16K file buffers } 1121 MINBITS = 9; { Starting code size of 9 bits } 1122 MAXBITS = 13; { Maximum code size of 13 bits } 1123 SPECIAL = 256; { Special function code } 1124 INCSIZE = 1; { Code indicating a jump in code size } 1125 CLEARCODE = 2; { Code indicating code table has been cleared } 1126 STDATTR = faAnyFile; { Standard file attribute for DOS Find First/Next } 1127 1128constructor TShrinker.Create(AInFile, AOutFile : TStream; ABufSize : LongWord); 1129begin 1130 Inherited; 1131 FBufSize:=ABufSize; 1132 InBuf:=GetMem(FBUFSIZE); 1133 OutBuf:=GetMem(FBUFSIZE); 1134 CodeTable:=GetMem(SizeOf(CodeTable^)); 1135 FreeList:=GetMem(SizeOf(FreeList^)); 1136end; 1137 1138destructor TShrinker.Destroy; 1139begin 1140 FreeMem(CodeTable); 1141 FreeMem(FreeList); 1142 FreeMem(InBuf); 1143 FreeMem(OutBuf); 1144 inherited Destroy; 1145end; 1146 1147Procedure TShrinker.Compress; 1148 1149Var 1150 OneString : String; 1151 Remaining : Word; 1152 1153begin 1154 BytesIn := 1; 1155 BytesOut := 1; 1156 InitializeCodeTable; 1157 FillInputBuffer; 1158 FirstCh:= TRUE; 1159 Crc32Val:=$FFFFFFFF; 1160 FOnBytes:=Round((FInFile.Size * FOnPercent) / 100); 1161 While Not InputEof do 1162 begin 1163 Remaining:=Succ(MaxInBufIdx - InBufIdx); 1164 If Remaining>255 then 1165 Remaining:=255; 1166 If Remaining=0 then 1167 FillInputBuffer 1168 else 1169 begin 1170 SetLength(OneString,Remaining); 1171 Move(InBuf[InBufIdx], OneString[1], Remaining); 1172 Inc(InBufIdx, Remaining); 1173 ProcessLine(OneString); 1174 end; 1175 end; 1176 Crc32Val := Not Crc32Val; 1177 ProcessLine(''); 1178end; 1179 1180class function TShrinker.ZipID: Word; 1181begin 1182 Result:=1; 1183end; 1184 1185class function TShrinker.ZipVersionReqd: Word; 1186begin 1187 Result:=10; 1188end; 1189 1190function TShrinker.ZipBitFlag: Word; 1191begin 1192 Result:=0; 1193end; 1194 1195 1196Procedure TShrinker.DoOnProgress(Const Pct: Double); 1197 1198begin 1199 If Assigned(FOnProgress) then 1200 FOnProgress(Self,Pct); 1201end; 1202 1203 1204Procedure TShrinker.FillInputBuffer; 1205 1206Begin 1207 MaxInbufIDx:=FInfile.Read(InBuf[0], FBufSize); 1208 If MaxInbufIDx=0 then 1209 InputEof := TRUE 1210 else 1211 InputEOF := FALSE; 1212 InBufIdx := 0; 1213end; 1214 1215 1216Procedure TShrinker.WriteOutputBuffer; 1217Begin 1218 FOutFile.WriteBuffer(OutBuf[0], OutBufIdx); 1219 OutBufIdx := 0; 1220end; 1221 1222 1223Procedure TShrinker.PutChar(B : Byte); 1224 1225Begin 1226 OutBuf[OutBufIdx] := B; 1227 Inc(OutBufIdx); 1228 If OutBufIdx>=FBufSize then 1229 WriteOutputBuffer; 1230 Inc(BytesOut); 1231end; 1232 1233Procedure TShrinker.FlushOutput; 1234Begin 1235 If OutBufIdx>0 then 1236 WriteOutputBuffer; 1237End; 1238 1239 1240procedure TShrinker.PutCode(Code : Smallint); 1241 1242var 1243 ACode : LongInt; 1244 XSize : Smallint; 1245 1246begin 1247 if (Code=-1) then 1248 begin 1249 if BitsUsed>0 then 1250 PutChar(SaveByte); 1251 end 1252 else 1253 begin 1254 ACode := Longint(Code); 1255 XSize := CodeSize+BitsUsed; 1256 ACode := (ACode shl BitsUsed) or SaveByte; 1257 while (XSize div 8) > 0 do 1258 begin 1259 PutChar(Lo(ACode)); 1260 ACode := ACode shr 8; 1261 Dec(XSize,8); 1262 end; 1263 BitsUsed := XSize; 1264 SaveByte := Lo(ACode); 1265 end; 1266end; 1267 1268 1269Procedure TShrinker.InitializeCodeTable; 1270 1271Var 1272 I : Word; 1273Begin 1274 For I := 0 to TableSize do 1275 begin 1276 With CodeTable^[I] do 1277 begin 1278 Child := -1; 1279 Sibling := -1; 1280 If (I<=255) then 1281 Suffix := I; 1282 end; 1283 If (I>=257) then 1284 FreeList^[I] := I; 1285 end; 1286 NextFree := FIRSTENTRY; 1287 TableFull := FALSE; 1288end; 1289 1290 1291Procedure TShrinker.Prune(Parent : Word); 1292 1293Var 1294 CurrChild : Smallint; 1295 NextSibling : Smallint; 1296Begin 1297 CurrChild := CodeTable^[Parent].Child; 1298 { Find first Child that has descendants .. clear any that don't } 1299 While (CurrChild <> -1) and (CodeTable^[CurrChild].Child = -1) do 1300 begin 1301 CodeTable^[Parent].Child := CodeTable^[CurrChild].Sibling; 1302 CodeTable^[CurrChild].Sibling := -1; 1303 { Turn on ClearList bit to indicate a cleared entry } 1304 ClearList[CurrChild DIV 8] := (ClearList[CurrChild DIV 8] OR (1 SHL (CurrChild MOD 8))); 1305 CurrChild := CodeTable^[Parent].Child; 1306 end; 1307 If CurrChild <> -1 then 1308 begin { If there are any children left ...} 1309 Prune(CurrChild); 1310 NextSibling := CodeTable^[CurrChild].Sibling; 1311 While NextSibling <> -1 do 1312 begin 1313 If CodeTable^[NextSibling].Child = -1 then 1314 begin 1315 CodeTable^[CurrChild].Sibling := CodeTable^[NextSibling].Sibling; 1316 CodeTable^[NextSibling].Sibling := -1; 1317 { Turn on ClearList bit to indicate a cleared entry } 1318 ClearList[NextSibling DIV 8] := (ClearList[NextSibling DIV 8] OR (1 SHL (NextSibling MOD 8))); 1319 NextSibling := CodeTable^[CurrChild].Sibling; 1320 end 1321 else 1322 begin 1323 CurrChild := NextSibling; 1324 Prune(CurrChild); 1325 NextSibling := CodeTable^[CurrChild].Sibling; 1326 end; 1327 end; 1328 end; 1329end; 1330 1331 1332Procedure TShrinker.Clear_Table; 1333Var 1334 Node : Word; 1335Begin 1336 FillChar(ClearList, SizeOf(ClearList), $00); 1337 For Node := 0 to 255 do 1338 Prune(Node); 1339 NextFree := Succ(TABLESIZE); 1340 For Node := TABLESIZE downto FIRSTENTRY do 1341 begin 1342 If (ClearList[Node DIV 8] AND (1 SHL (Node MOD 8))) <> 0 then 1343 begin 1344 Dec(NextFree); 1345 FreeList^[NextFree] := Node; 1346 end; 1347 end; 1348 If NextFree <= TABLESIZE then 1349 TableFull := FALSE; 1350end; 1351 1352 1353Procedure TShrinker.Table_Add(Prefix : Word; Suffix : Byte); 1354Var 1355 FreeNode : Word; 1356Begin 1357 If NextFree <= TABLESIZE then 1358 begin 1359 FreeNode := FreeList^[NextFree]; 1360 Inc(NextFree); 1361 CodeTable^[FreeNode].Child := -1; 1362 CodeTable^[FreeNode].Sibling := -1; 1363 CodeTable^[FreeNode].Suffix := Suffix; 1364 If CodeTable^[Prefix].Child = -1 then 1365 CodeTable^[Prefix].Child := FreeNode 1366 else 1367 begin 1368 Prefix := CodeTable^[Prefix].Child; 1369 While CodeTable^[Prefix].Sibling <> -1 do 1370 Prefix := CodeTable^[Prefix].Sibling; 1371 CodeTable^[Prefix].Sibling := FreeNode; 1372 end; 1373 end; 1374 if NextFree > TABLESIZE then 1375 TableFull := TRUE; 1376end; 1377 1378function TShrinker.Table_Lookup( TargetPrefix : Smallint; 1379 TargetSuffix : Byte; 1380 Out FoundAt : Smallint ) : Boolean; 1381 1382var TempPrefix : Smallint; 1383 1384begin 1385 TempPrefix := TargetPrefix; 1386 Table_lookup := False; 1387 if CodeTable^[TempPrefix].Child <> -1 then 1388 begin 1389 TempPrefix := CodeTable^[TempPrefix].Child; 1390 repeat 1391 if CodeTable^[TempPrefix].Suffix = TargetSuffix then 1392 begin 1393 Table_lookup := True; 1394 break; 1395 end; 1396 if CodeTable^[TempPrefix].Sibling = -1 then 1397 break; 1398 TempPrefix := CodeTable^[TempPrefix].Sibling; 1399 until False; 1400 end; 1401 if Table_Lookup then 1402 FoundAt := TempPrefix 1403 else 1404 FoundAt := -1; 1405end; 1406 1407Procedure TShrinker.Shrink(Suffix : Smallint); 1408 1409Const 1410 LastCode : Smallint = 0; 1411 1412Var 1413 WhereFound : Smallint; 1414 1415Begin 1416 If FirstCh then 1417 begin 1418 SaveByte := $00; 1419 BitsUsed := 0; 1420 CodeSize := MINBITS; 1421 MaxCode := (1 SHL CodeSize) - 1; 1422 LastCode := Suffix; 1423 FirstCh := FALSE; 1424 end 1425 else 1426 begin 1427 If Suffix <> -1 then 1428 begin 1429 If TableFull then 1430 begin 1431 Putcode(LastCode); 1432 PutCode(SPECIAL); 1433 Putcode(CLEARCODE); 1434 Clear_Table; 1435 Table_Add(LastCode, Suffix); 1436 LastCode := Suffix; 1437 end 1438 else 1439 begin 1440 If Table_Lookup(LastCode, Suffix, WhereFound) then 1441 begin 1442 LastCode := WhereFound; 1443 end 1444 else 1445 begin 1446 PutCode(LastCode); 1447 Table_Add(LastCode, Suffix); 1448 LastCode := Suffix; 1449 If (FreeList^[NextFree] > MaxCode) and (CodeSize < MaxBits) then 1450 begin 1451 PutCode(SPECIAL); 1452 PutCode(INCSIZE); 1453 Inc(CodeSize); 1454 MaxCode := (1 SHL CodeSize) -1; 1455 end; 1456 end; 1457 end; 1458 end 1459 else 1460 begin 1461 PutCode(LastCode); 1462 PutCode(-1); 1463 FlushOutput; 1464 end; 1465 end; 1466end; 1467 1468Procedure TShrinker.ProcessLine(Const Source : String); 1469 1470Var 1471 I : Word; 1472 1473Begin 1474 If Source = '' then 1475 Shrink(-1) 1476 else 1477 For I := 1 to Length(Source) do 1478 begin 1479 Inc(BytesIn); 1480 If (Pred(BytesIn) MOD FOnBytes) = 0 then 1481 DoOnProgress(100 * ( BytesIn / FInFile.Size)); 1482 UpdC32(Ord(Source[I])); 1483 Shrink(Ord(Source[I])); 1484 end; 1485end; 1486 1487{ --------------------------------------------------------------------- 1488 TZipper 1489 ---------------------------------------------------------------------} 1490 1491 1492Procedure TZipper.GetFileInfo; 1493 1494Var 1495 F : TZipFileEntry; 1496 Info : TSearchRec; 1497 I : integer; //zip spec allows QWord but FEntries.Count does not support it 1498{$IFDEF UNIX} 1499 UnixInfo: Stat; 1500{$ENDIF} 1501Begin 1502 For I := 0 to FEntries.Count-1 do 1503 begin 1504 F:=FEntries[i]; 1505 If F.Stream=Nil then 1506 begin 1507 If (F.DiskFileName='') then 1508 Raise EZipError.CreateFmt(SErrMissingFileName,[I]); 1509 If FindFirst(F.DiskFileName, STDATTR, Info)=0 then 1510 try 1511 if Info.Attr and faDirectory <> 0 then //in Linux directory Size <> 0 1512 F.Size := 0 1513 else 1514 F.Size:=Info.Size; 1515 F.DateTime:=FileDateToDateTime(Info.Time); 1516 {$IFDEF UNIX} 1517 if fplstat(F.DiskFileName, @UnixInfo) = 0 then 1518 F.Attributes := UnixInfo.st_mode; 1519 {$ELSE} 1520 F.Attributes := Info.Attr; 1521 {$ENDIF} 1522 finally 1523 FindClose(Info); 1524 end 1525 else 1526 Raise EZipError.CreateFmt(SErrFileDoesNotExist,[F.DiskFileName]); 1527 end 1528 else 1529 begin 1530 If (F.ArchiveFileName='') then 1531 Raise EZipError.CreateFmt(SErrMissingArchiveName,[I]); 1532 F.Size:=F.Stream.Size; 1533 if (F.Attributes = 0) then 1534 begin 1535 {$IFDEF UNIX} 1536 F.Attributes := UNIX_FILE or UNIX_DEFAULT; 1537 {$ELSE} 1538 F.Attributes := faArchive; 1539 {$ENDIF} 1540 end; 1541 end; 1542 end; 1543end; 1544 1545 1546procedure TZipper.SetEntries(const AValue: TZipFileEntries); 1547begin 1548 if FEntries=AValue then exit; 1549 FEntries.Assign(AValue); 1550end; 1551 1552Function TZipper.OpenInput(Item : TZipFileEntry) : Boolean; 1553 1554Begin 1555 If (Item.Stream<>nil) then 1556 FInFile:=Item.Stream 1557 else 1558 if Item.IsDirectory then 1559 FInFile := TStringStream.Create('') 1560 else 1561 FInFile:=TFileStream.Create(Item.DiskFileName,fmOpenRead); 1562 Result:=True; 1563 If Assigned(FOnStartFile) then 1564 FOnStartFile(Self,Item.ArchiveFileName); 1565End; 1566 1567 1568Procedure TZipper.CloseInput(Item : TZipFileEntry); 1569 1570Begin 1571 If (FInFile<>Item.Stream) then 1572 FreeAndNil(FInFile) 1573 else 1574 FinFile:=Nil; 1575 DoEndOfFile; 1576end; 1577 1578 1579Procedure TZipper.StartZipFile(Item : TZipFileEntry); 1580 1581Begin 1582 FillChar(LocalHdr,SizeOf(LocalHdr),0); 1583 FillChar(LocalZip64Fld,SizeOf(LocalZip64Fld),0); 1584 With LocalHdr do 1585 begin 1586 Signature := LOCAL_FILE_HEADER_SIGNATURE; 1587 Extract_Version_Reqd := 20; //default value, v2.0 1588 Bit_Flag := 0; 1589 Compress_Method := 1; 1590 DateTimeToZipDateTime(Item.DateTime,Last_Mod_Date,Last_Mod_Time); 1591 Crc32 := 0; 1592 Compressed_Size := 0; 1593 LocalZip64Fld.Compressed_Size := 0; 1594 if Item.Size >= $FFFFFFFF then 1595 begin 1596 Uncompressed_Size := $FFFFFFFF; 1597 LocalZip64Fld.Original_Size := Item.Size; 1598 end 1599 else 1600 begin 1601 Uncompressed_Size := Item.Size; 1602 LocalZip64Fld.Original_Size := 0; 1603 end; 1604 FileName_Length := 0; 1605 if (LocalZip64Fld.Original_Size>0) or 1606 (LocalZip64Fld.Compressed_Size>0) or 1607 (LocalZip64Fld.Disk_Start_Number>0) or 1608 (LocalZip64Fld.Relative_Hdr_Offset>0) then 1609 Extra_Field_Length := SizeOf(LocalZip64ExtHdr) + SizeOf(LocalZip64Fld) 1610 else 1611 Extra_Field_Length := 0; 1612 end; 1613End; 1614 1615 1616function TZipper.UpdateZipHeader(Item: TZipFileEntry; FZip: TStream; 1617 ACRC: LongWord; AMethod: Word; AZipVersionReqd: Word; AZipBitFlag: Word 1618 ): Boolean; 1619 // Update header for a single zip file (local header) 1620var 1621 IsZip64 : boolean; //Must the local header be in zip64 format? 1622 // Separate from zip64 status of entire zip file. 1623 ZFileName : RawByteString; 1624Begin 1625 ZFileName := Item.ArchiveFileName; 1626 IsZip64 := false; 1627 With LocalHdr do 1628 begin 1629 if FUseLanguageEncoding then begin 1630 SetCodePage(ZFileName, CP_UTF8, True); 1631 Bit_Flag := Bit_Flag or EFS_LANGUAGE_ENCODING_FLAG; 1632 end; 1633 FileName_Length := Length(ZFileName); 1634 Crc32 := ACRC; 1635 if LocalZip64Fld.Original_Size > 0 then 1636 Result := Not (FZip.Size >= LocalZip64Fld.Original_Size) 1637 else 1638 Result := Not (Compressed_Size >= Uncompressed_Size); 1639 if Item.CompressionLevel=clNone 1640 then Result:=false; //user wishes override or invalid compression 1641 If Not Result then 1642 begin 1643 Compress_Method := 0; // No use for compression: change storage type & compression size... 1644 if LocalZip64Fld.Original_Size>0 then 1645 begin 1646 IsZip64 := true; 1647 Compressed_Size := $FFFFFFFF; 1648 LocalZip64Fld.Compressed_Size := LocalZip64Fld.Original_Size; 1649 end 1650 else 1651 begin 1652 Compressed_Size := Uncompressed_Size; 1653 LocalZip64Fld.Compressed_Size := 0; 1654 end; 1655 end 1656 else { Using compression } 1657 begin 1658 Compress_method := AMethod; 1659 Bit_Flag := Bit_Flag or AZipBitFlag; 1660 if FZip.Size >= $FFFFFFFF then 1661 begin 1662 IsZip64 := true; 1663 Compressed_Size := $FFFFFFFF; 1664 LocalZip64Fld.Compressed_Size := FZip.Size; 1665 end 1666 else 1667 begin 1668 Compressed_Size := FZip.Size; 1669 LocalZip64Fld.Compressed_Size := 0; 1670 if LocalZip64Fld.Original_Size > 0 then 1671 IsZip64 := true; 1672 end; 1673 if AZipVersionReqd > Extract_Version_Reqd then 1674 Extract_Version_Reqd := AZipVersionReqd; 1675 end; 1676 if (IsZip64) and (Extract_Version_Reqd<45) then 1677 Extract_Version_Reqd := 45; 1678 end; 1679 if IsZip64 then 1680 LocalHdr.Extra_Field_Length:=SizeOf(LocalZip64ExtHdr)+SizeOf(LocalZip64Fld); 1681 FOutStream.WriteBuffer({$IFDEF ENDIAN_BIG}SwapLFH{$ENDIF}(LocalHdr),SizeOf(LocalHdr)); 1682 // Append extensible field header+zip64 extensible field if needed: 1683 FOutStream.WriteBuffer(ZFileName[1],Length(ZFileName)); 1684 if IsZip64 then 1685 begin 1686 FOutStream.WriteBuffer({$IFDEF ENDIAN_BIG}SwapEDFH{$ENDIF}(LocalZip64ExtHdr),SizeOf(LocalZip64ExtHdr)); 1687 FOutStream.WriteBuffer({$IFDEF ENDIAN_BIG}SwapZ64EIF{$ENDIF}(LocalZip64Fld),SizeOf(LocalZip64Fld)); 1688 end; 1689End; 1690 1691 1692Procedure TZipper.BuildZipDirectory; 1693// Write out all central file headers using info from local headers 1694Var 1695 SavePos : Int64; 1696 HdrPos : Int64; //offset from disk where file begins to local header 1697 CenDirPos : Int64; 1698 ACount : QWord; //entry counter 1699 ZFileName : string; //archive filename 1700 IsZip64 : boolean; //local header=zip64 format? 1701 MinReqdVersion: word; //minimum needed to extract 1702 ExtInfoHeader : Extensible_Data_Field_Header_Type; 1703 Zip64ECD : Zip64_End_of_Central_Dir_type; 1704 Zip64ECDL : Zip64_End_of_Central_Dir_Locator_type; 1705Begin 1706 ACount := 0; 1707 MinReqdVersion:=0; 1708 CenDirPos := FOutStream.Position; 1709 FOutStream.Seek(0,soBeginning); { Rewind output file } 1710 HdrPos := FOutStream.Position; 1711 FOutStream.ReadBuffer(LocalHdr, SizeOf(LocalHdr)); 1712{$IFDEF FPC_BIG_ENDIAN} 1713 LocalHdr := SwapLFH(LocalHdr); 1714{$ENDIF} 1715 Repeat 1716 SetLength(ZFileName,LocalHdr.FileName_Length); 1717 FOutStream.ReadBuffer(ZFileName[1], LocalHdr.FileName_Length); 1718 IsZip64:=(LocalHdr.Compressed_Size=$FFFFFFFF) or (LocalHdr.Uncompressed_Size=$FFFFFFFF) or (HdrPos>=$FFFFFFFF); 1719 FillChar(LocalZip64Fld,SizeOf(LocalZip64Fld),0); // easier to check compressed length 1720 if LocalHdr.Extra_Field_Length>0 then 1721 begin 1722 SavePos := FOutStream.Position; 1723 if (IsZip64 and (LocalHdr.Extra_Field_Length>=SizeOf(LocalZip64ExtHdr)+SizeOf(LocalZip64Fld))) then 1724 while FOutStream.Position<SavePos+LocalHdr.Extra_Field_Length do 1725 begin 1726 FOutStream.ReadBuffer(ExtInfoHeader, SizeOf(ExtInfoHeader)); 1727 {$IFDEF FPC_BIG_ENDIAN} 1728 ExtInfoHeader := SwapEDFH(ExtInfoHeader); 1729 {$ENDIF} 1730 if ExtInfoHeader.Header_ID=ZIP64_HEADER_ID then 1731 begin 1732 FOutStream.ReadBuffer(LocalZip64Fld, SizeOf(LocalZip64Fld)); 1733 {$IFDEF FPC_BIG_ENDIAN} 1734 LocalZip64Fld := SwapZ64EIF(LocalZip64Fld); 1735 {$ENDIF} 1736 end 1737 else 1738 begin 1739 // Read past non-zip64 extra field 1740 FOutStream.Seek(ExtInfoHeader.Data_Size,soFromCurrent); 1741 end; 1742 end; 1743 // Move past extra fields 1744 //FOutStream.Seek(SavePos+LocalHdr.Extra_Field_Length,soFromBeginning); 1745 end; 1746 SavePos := FOutStream.Position; 1747 FillChar(CentralHdr,SizeOf(CentralHdr),0); 1748 With CentralHdr do 1749 begin 1750 Signature := CENTRAL_FILE_HEADER_SIGNATURE; 1751 MadeBy_Version := LocalHdr.Extract_Version_Reqd; 1752 if (IsZip64) and (MadeBy_Version<45) then 1753 MadeBy_Version := 45; 1754 {$IFDEF UNIX} 1755 {$IFDEF DARWIN} //OSX 1756 MadeBy_Version := MadeBy_Version or (OS_OSX shl 8); 1757 {$ELSE} 1758 MadeBy_Version := MadeBy_Version or (OS_UNIX shl 8); 1759 {$ENDIF} 1760 {$ENDIF} 1761 {$IFDEF OS2} 1762 MadeBy_Version := MadeBy_Version or (OS_OS2 shl 8); 1763 {$ENDIF} 1764 {$warning TODO: find a way to recognize VFAT and NTFS} 1765 // Copy over extract_version_reqd..extra_field_length 1766 Move(LocalHdr.Extract_Version_Reqd, Extract_Version_Reqd, 26); 1767 if (IsZip64) and (Extract_Version_Reqd<45) then 1768 Extract_Version_Reqd := 45; 1769 // Keep track of the minimum version required to extract 1770 // zip file as a whole 1771 if Extract_Version_Reqd>MinReqdVersion then 1772 MinReqdVersion:=Extract_Version_Reqd; 1773 Last_Mod_Time:=localHdr.Last_Mod_Time; 1774 Last_Mod_Date:=localHdr.Last_Mod_Date; 1775 File_Comment_Length := 0; 1776 Starting_Disk_Num := 0; 1777 Internal_Attributes := 0; 1778 {$IFDEF UNIX} 1779 External_Attributes := Entries[ACount].Attributes shl 16; 1780 {$ELSE} 1781 External_Attributes := Entries[ACount].Attributes; 1782 {$ENDIF} 1783 if HdrPos>=$FFFFFFFF then 1784 begin 1785 FZipFileNeedsZip64:=true; 1786 IsZip64:=true; 1787 Local_Header_offset := $FFFFFFFF; 1788 // LocalZip64Fld will be written out as central dir extra field later 1789 LocalZip64Fld.Relative_Hdr_Offset := HdrPos; 1790 end 1791 else 1792 Local_Header_Offset := HdrPos; 1793 end; 1794 1795 if IsZip64 then 1796 begin 1797 CentralHdr.Extra_Field_Length:=SizeOf(LocalZip64ExtHdr)+SizeOf(LocalZip64Fld); 1798 end else CentralHdr.Extra_Field_Length :=0; 1799 1800 FOutStream.Seek(0,soEnd); 1801 FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapCFH{$ENDIF}(CentralHdr),SizeOf(CentralHdr)); 1802 FOutStream.WriteBuffer(ZFileName[1],Length(ZFileName)); 1803 1804 if IsZip64 then 1805 begin 1806 FOutStream.Seek(0,soEnd); 1807 FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapEDFH{$ENDIF}(LocalZip64ExtHdr),SizeOf(LocalZip64ExtHdr)); 1808 FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapZ64EIF{$ENDIF}(LocalZip64Fld),SizeOf(LocalZip64Fld)); 1809 end; 1810 1811 Inc(ACount); 1812 // Move past compressed file data to next header: 1813 if LocalZip64Fld.Compressed_Size > 0 then 1814 FOutStream.Seek(SavePos + LocalZip64Fld.Compressed_Size,soBeginning) 1815 else 1816 FOutStream.Seek(SavePos + LocalHdr.Compressed_Size,soBeginning); 1817 HdrPos:=FOutStream.Position; 1818 FOutStream.ReadBuffer(LocalHdr, SizeOf(LocalHdr)); 1819 {$IFDEF FPC_BIG_ENDIAN} 1820 LocalHdr := SwapLFH(LocalHdr); 1821 {$ENDIF} 1822 Until LocalHdr.Signature = CENTRAL_FILE_HEADER_SIGNATURE ; 1823 1824 FOutStream.Seek(0,soEnd); 1825 FillChar(EndHdr,SizeOf(EndHdr),0); 1826 1827 // Write end of central directory record 1828 // We'll use the zip64 variants to store counts etc 1829 // and copy to the old record variables if possible 1830 // This seems to match expected behaviour of unzippers like 1831 // unrar that only look at the zip64 record 1832 FillChar(Zip64ECD, SizeOf(Zip64ECD), 0); 1833 Zip64ECD.Signature:=ZIP64_END_OF_CENTRAL_DIR_SIGNATURE; 1834 FillChar(Zip64ECDL, SizeOf(Zip64ECDL), 0); 1835 Zip64ECDL.Signature:=ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIGNATURE; 1836 Zip64ECDL.Total_Disks:=1; //default and no support for multi disks yet anyway 1837 With EndHdr do 1838 begin 1839 Signature := END_OF_CENTRAL_DIR_SIGNATURE; 1840 Disk_Number := 0; 1841 Central_Dir_Start_Disk := 0; 1842 1843 Zip64ECD.Entries_This_Disk:=ACount; 1844 Zip64ECD.Total_Entries:=Acount; 1845 if ACount>$FFFF then 1846 begin 1847 FZipFileNeedsZip64 := true; 1848 Entries_This_Disk := $FFFF; 1849 Total_Entries := $FFFF; 1850 end 1851 else 1852 begin 1853 Entries_This_Disk := Zip64ECD.Entries_This_Disk; 1854 Total_Entries := Zip64ECD.Total_Entries; 1855 end; 1856 1857 Zip64ECD.Central_Dir_Size := FOutStream.Size-CenDirPos; 1858 if (Zip64ECD.Central_Dir_Size)>$FFFFFFFF then 1859 begin 1860 FZipFileNeedsZip64 := true; 1861 Central_Dir_Size := $FFFFFFFF; 1862 end 1863 else 1864 begin 1865 Central_Dir_Size := Zip64ECD.Central_Dir_Size; 1866 end; 1867 1868 Zip64ECD.Start_Disk_Offset := CenDirPos; 1869 if Zip64ECD.Start_Disk_Offset>$FFFFFFFF then 1870 begin 1871 FZipFileNeedsZip64 := true; 1872 Start_Disk_Offset := $FFFFFFFF; 1873 end 1874 else 1875 begin 1876 Start_Disk_Offset := Zip64ECD.Start_Disk_Offset; 1877 end; 1878 1879 ZipFile_Comment_Length := Length(FFileComment); 1880 1881 if FZipFileNeedsZip64 then 1882 begin 1883 //Write zip64 end of central directory record if needed 1884 if MinReqdVersion<45 then 1885 MinReqdVersion := 45; 1886 Zip64ECD.Extract_Version_Reqd := MinReqdVersion; 1887 Zip64ECD.Version_Made_By := MinReqdVersion; 1888 Zip64ECD.Record_Size := SizeOf(Zip64ECD)-12; //Assumes no variable length field following 1889 Zip64ECDL.Central_Dir_Zip64_EOCD_Offset := FOutStream.Position; 1890 Zip64ECDL.Zip64_EOCD_Start_Disk := 0; 1891 FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapZ64ECD{$ENDIF}(Zip64ECD), SizeOf(Zip64ECD)); 1892 1893 //Write zip64 end of central directory locator if needed 1894 FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapZ64ECDL{$ENDIF}(Zip64ECDL), SizeOf(Zip64ECDL)); 1895 end; 1896 1897 FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapECD{$ENDIF}(EndHdr), SizeOf(EndHdr)); 1898 if Length(FFileComment) > 0 then 1899 FOutStream.WriteBuffer(FFileComment[1],Length(FFileComment)); 1900 end; 1901end; 1902 1903Function TZipper.CreateCompressor(Item : TZipFileEntry; AInFile,AZipStream : TStream) : TCompressor; 1904 1905begin 1906 Result:=TDeflater.Create(AinFile,AZipStream,FBufSize); 1907 (Result as TDeflater).CompressionLevel:=Item.CompressionLevel; 1908 FCurrentCompressor:=Result; 1909end; 1910 1911Procedure TZipper.ZipOneFile(Item : TZipFileEntry); 1912 1913Var 1914 CRC : LongWord; 1915 ZMethod : Word; 1916 ZVersionReqd : Word; 1917 ZBitFlag : Word; 1918 ZipStream : TStream; 1919 TmpFileName, Start : String; 1920 I : Integer; 1921 1922Begin 1923 OpenInput(Item); 1924 Try 1925 StartZipFile(Item); 1926 If (FInfile.Size<=FInMemSize) then 1927 ZipStream:=TMemoryStream.Create 1928 else 1929 begin 1930 Start := ChangeFileExt(FFileName, ''); 1931 I := 0; 1932 repeat 1933 TmpFileName := Format('%s%.5d.tmp', [Start, I]); 1934 Inc(I); 1935 until not FileExists(TmpFileName); 1936 ZipStream:=TFileStream.Create(TmpFileName,fmCreate); 1937 end; 1938 Try 1939 With CreateCompressor(Item, FinFile,ZipStream) do 1940 Try 1941 OnProgress:=Self.OnProgress; 1942 OnPercent:=Self.OnPercent; 1943 Compress; 1944 CRC:=Crc32Val; 1945 ZMethod:=ZipID; 1946 ZVersionReqd:=ZipVersionReqd; 1947 ZBitFlag:=ZipBitFlag; 1948 Finally 1949 FCurrentCompressor:=Nil; 1950 Free; 1951 end; 1952 If UpdateZipHeader(Item,ZipStream,CRC,ZMethod,ZVersionReqd,ZBitFlag) then 1953 // Compressed file smaller than original file. 1954 FOutStream.CopyFrom(ZipStream,0) 1955 else 1956 begin 1957 // Original file smaller than compressed file. 1958 FInfile.Seek(0,soBeginning); 1959 FOutStream.CopyFrom(FInFile,0); 1960 end; 1961 finally 1962 ZipStream.Free; 1963 If (TmpFileName<>'') then 1964 DeleteFile(TmpFileName); 1965 end; 1966 Finally 1967 CloseInput(Item); 1968 end; 1969end; 1970 1971// Just like SaveToFile, but uses the FileName property 1972Procedure TZipper.ZipAllFiles; 1973begin 1974 SaveToFile(FileName); 1975end; 1976 1977procedure TZipper.SaveToFile(const AFileName: RawByteString); 1978var 1979 lStream: TFileStream; 1980begin 1981 FFileName:=AFileName; 1982 lStream:=TFileStream.Create(FFileName,fmCreate); 1983 try 1984 SaveToStream(lStream); 1985 finally 1986 FreeAndNil(lStream); 1987 end; 1988end; 1989 1990procedure TZipper.SaveToStream(AStream: TStream); 1991Var 1992 I : integer; //could be qword but limited by FEntries.Count 1993begin 1994 FTerminated:=False; 1995 FOutStream := AStream; 1996 If CheckEntries=0 then 1997 Exit; 1998 FZipping:=True; 1999 Try 2000 GetFileInfo; //get info on file entries in zip 2001 I:=0; 2002 While (I<FEntries.Count) and not Terminated do 2003 begin 2004 ZipOneFile(FEntries[i]); 2005 Inc(I); 2006 end; 2007 if (FEntries.Count>0) and not Terminated then 2008 BuildZipDirectory; 2009 finally 2010 FZipping:=False; 2011 // Remove entries that have been added by CheckEntries from Files. 2012 for I:=0 to FFiles.Count-1 do 2013 FEntries.Delete(FEntries.Count-1); 2014 end; 2015end; 2016 2017procedure TZipper.ZipFile(const aFileToBeZipped: RawByteString); 2018begin 2019 ZipFiles([aFileToBeZipped]); 2020end; 2021 2022procedure TZipper.ZipFile(const AZipFileName, aFileToBeZipped: RawByteString); 2023begin 2024 FileName:=aZipFileName; 2025 ZipFile(aFileToBeZipped); 2026end; 2027 2028 2029Procedure TZipper.SetBufSize(Value : LongWord); 2030 2031begin 2032 If FZipping then 2033 Raise EZipError.Create(SErrBufsizeChange); 2034 If Value>=DefaultBufSize then 2035 FBufSize:=Value; 2036end; 2037 2038Procedure TZipper.SetFileName(Value : RawByteString); 2039 2040begin 2041 If FZipping then 2042 Raise EZipError.Create(SErrFileChange); 2043 FFileName:=Value; 2044end; 2045 2046Procedure TZipper.ZipFiles(Const AZipFileName : RawByteString; FileList : TStrings); 2047 2048begin 2049 FFileName:=AZipFileName; 2050 ZipFiles(FileList); 2051end; 2052 2053procedure TZipper.ZipFiles(const AZipFileName: RawByteString; const FileList: array of RawbyteString); 2054 2055begin 2056 FileName:=aZipFileName; 2057 ZipFiles(FileList); 2058end; 2059 2060procedure TZipper.ZipFiles(const aFileList: array of RawbyteString); 2061Var 2062 L : TStringList; 2063 S : RawByteString; 2064begin 2065 L:=TStringList.Create; 2066 try 2067 L.Capacity:=Length(aFileList); 2068 for S in aFileList do 2069 L.Add(S); 2070 ZipFiles(L); 2071 finally 2072 L.Free; 2073 end; 2074end; 2075 2076procedure TZipper.ZipFiles(FileList: TStrings); 2077begin 2078 FFiles.Assign(FileList); 2079 ZipAllFiles; 2080end; 2081 2082procedure TZipper.ZipFiles(const AZipFileName: RawByteString; Entries: TZipFileEntries); 2083begin 2084 FFileName:=AZipFileName; 2085 ZipFiles(Entries); 2086end; 2087 2088procedure TZipper.ZipFiles(Entries: TZipFileEntries); 2089begin 2090 FEntries.Assign(Entries); 2091 ZipAllFiles; 2092end; 2093 2094class procedure TZipper.Zip(const AZipFileName: RawByteString; const aFileToBeZipped: RawByteString); 2095begin 2096 With Self.Create do 2097 try 2098 ZipFile(aZipFileName,aFileToBeZipped); 2099 finally 2100 Free; 2101 end; 2102end; 2103 2104class procedure TZipper.Zip(const AZipFileName: RawByteString; aFileList: array of RawByteString); 2105begin 2106 With Self.Create do 2107 try 2108 ZipFiles(aZipFileName,aFileList); 2109 finally 2110 Free; 2111 end; 2112end; 2113 2114class procedure TZipper.Zip(const AZipFileName: RawByteString; aFileList: TStrings); 2115begin 2116 With Self.Create do 2117 try 2118 ZipFiles(aZipFileName,aFileList); 2119 finally 2120 Free; 2121 end; 2122end; 2123 2124Procedure TZipper.DoEndOfFile; 2125 2126Var 2127 ComprPct : Double; 2128 2129begin 2130 if (FZipFileNeedsZip64) and (LocalZip64Fld.Original_Size>0) then 2131 ComprPct := (100.0 * (LocalZip64Fld.Original_size - LocalZip64Fld.Compressed_Size)) / LocalZip64Fld.Original_Size 2132 else if (LocalHdr.Uncompressed_Size>0) then 2133 ComprPct := (100.0 * (LocalHdr.Uncompressed_Size - LocalHdr.Compressed_Size)) / LocalHdr.Uncompressed_Size 2134 else 2135 ComprPct := 0; 2136 If Assigned(FOnEndOfFile) then 2137 FOnEndOfFile(Self,ComprPct); 2138end; 2139 2140Constructor TZipper.Create; 2141 2142begin 2143 FBufSize:=DefaultBufSize; 2144 FInMemSize:=DefaultInMemSize; 2145 FFiles:=TStringList.Create; 2146 FEntries:=TZipFileEntries.Create(TZipFileEntry); 2147 FOnPercent:=1; 2148 FZipFileNeedsZip64:=false; 2149 LocalZip64ExtHdr.Header_ID:=ZIP64_HEADER_ID; 2150 LocalZip64ExtHdr.Data_Size:=SizeOf(Zip64_Extended_Info_Field_Type); 2151end; 2152 2153Function TZipper.CheckEntries : Integer; 2154 2155Var 2156 I : integer; //Could be QWord but limited by FFiles.Count 2157 2158begin 2159 for I:=0 to FFiles.Count-1 do 2160 FEntries.AddFileEntry(FFiles[i]); 2161 2162 // Use zip64 when number of file entries 2163 // or individual (un)compressed sizes 2164 // require it. 2165 if FEntries.Count >= $FFFF then 2166 FZipFileNeedsZip64:=true; 2167 2168 if not(FZipFileNeedsZip64) then 2169 begin 2170 for I:=0 to FFiles.Count-1 do 2171 begin 2172 if FEntries[i].FNeedsZip64 then 2173 begin 2174 FZipFileNeedsZip64:=true; 2175 break; 2176 end; 2177 end; 2178 end; 2179 2180 Result:=FEntries.Count; 2181end; 2182 2183 2184Procedure TZipper.Clear; 2185 2186begin 2187 FEntries.Clear; 2188 FFiles.Clear; 2189end; 2190 2191procedure TZipper.Terminate; 2192begin 2193 FTerminated:=True; 2194 if Assigned(FCurrentCompressor) then 2195 FCurrentCompressor.Terminate; 2196end; 2197 2198Destructor TZipper.Destroy; 2199 2200begin 2201 Clear; 2202 FreeAndNil(FEntries); 2203 FreeAndNil(FFiles); 2204 Inherited; 2205end; 2206 2207{ --------------------------------------------------------------------- 2208 TUnZipper 2209 ---------------------------------------------------------------------} 2210 2211procedure TUnZipper.OpenInput; 2212 2213Begin 2214 if Assigned(FOnOpenInputStream) then 2215 FOnOpenInputStream(Self, FZipStream); 2216 if FZipStream = nil then 2217 FZipStream:=TFileStream.Create(FFileName,fmOpenRead or fmShareDenyWrite); 2218End; 2219 2220 2221function TUnZipper.OpenOutput(OutFileName: RawByteString; 2222 out OutStream: TStream; Item: TFullZipFileEntry): Boolean; 2223Var 2224 Path: RawByteString; 2225 OldDirectorySeparators: set of char; 2226 2227Begin 2228 { the default RTL behavior is broken on Unix platforms 2229 for Windows compatibility: it allows both '/' and '\' 2230 as directory separator. We don't want that behavior 2231 here, since 'abc\' is a valid file name under Unix. 2232 2233 The zip standard appnote.txt says zip files must have '/' as path 2234 separator, even on Windows: 4.4.17.1: 2235 "The path stored MUST not contain a drive or device letter, or a leading 2236 slash. All slashes MUST be forward slashes '/' as opposed to backwards 2237 slashes '\'" See also mantis issue #15836 2238 However, old versions of FPC on Windows (and possibly other utilities) 2239 created incorrect zip files with \ separator, so accept these as well as 2240 they're not valid in Windows file names anyway. 2241 } 2242 OldDirectorySeparators:=AllowDirectorySeparators; 2243 {$ifdef Windows} 2244 // Explicitly allow / and \ regardless of what Windows supports 2245 AllowDirectorySeparators:=['\','/']; 2246 {$else} 2247 // Follow the standard: only allow / regardless of actual separator on OS 2248 AllowDirectorySeparators:=['/']; 2249 {$endif} 2250 Path:=ExtractFilePath(OutFileName); 2251 OutStream:=Nil; 2252 If Assigned(FOnCreateStream) then 2253 FOnCreateStream(Self, OutStream, Item); 2254 // If FOnCreateStream didn't create one, we create one now. 2255 If (OutStream=Nil) and (not Item.IsDirectory) then 2256 begin 2257 if (Path<>'') then 2258 ForceDirectories(Path); 2259 AllowDirectorySeparators:=OldDirectorySeparators; 2260 OutStream:=TFileStream.Create(OutFileName,fmCreate); 2261 2262 end; 2263 2264 AllowDirectorySeparators:=OldDirectorySeparators; 2265 Result:=True; 2266 If Assigned(FOnStartFile) then 2267 FOnStartFile(Self,OutFileName); 2268End; 2269 2270 2271procedure TUnZipper.CloseOutput(Item: TFullZipFileEntry; var OutStream: TStream 2272 ); 2273 2274Begin 2275 if Assigned(FOnDoneStream) then 2276 begin 2277 FOnDoneStream(Self, OutStream, Item); 2278 OutStream := nil; 2279 end 2280 else 2281 if Assigned(OutStream) then 2282 FreeAndNil(OutStream); 2283 DoEndOfFile; 2284end; 2285 2286 2287procedure TUnZipper.CloseInput; 2288 2289Begin 2290 if Assigned(FOnCloseInputStream) then 2291 FOnCloseInputStream(Self, FZipStream); 2292 FreeAndNil(FZipStream); 2293end; 2294 2295 2296procedure TUnZipper.ReadZipHeader(Item: TFullZipFileEntry; out AMethod: Word); 2297Var 2298 S : RawByteString; 2299 U : UTF8String; 2300 D : TDateTime; 2301 ExtraFieldHdr: Extensible_Data_Field_Header_Type; 2302 SavePos: int64; //could be qword but limited by stream 2303 // Infozip unicode path 2304 Infozip_Unicode_Path_Ver:Byte; 2305 Infozip_Unicode_Path_CRC32:DWord; 2306Begin 2307 FZipStream.Seek(Item.HdrPos,soBeginning); 2308 FZipStream.ReadBuffer(LocalHdr,SizeOf(LocalHdr)); 2309{$IFDEF FPC_BIG_ENDIAN} 2310 LocalHdr := SwapLFH(LocalHdr); 2311{$ENDIF} 2312 FillChar(LocalZip64Fld,SizeOf(LocalZip64Fld),0); //ensure no erroneous info 2313 With LocalHdr do 2314 begin 2315 Item.FBitFlags:=Bit_Flag; 2316 SetLength(S,Filename_Length); 2317 FZipStream.ReadBuffer(S[1],Filename_Length); 2318 if Bit_Flag and EFS_LANGUAGE_ENCODING_FLAG <> 0 then 2319 SetCodePage(S, CP_UTF8, False); 2320 Item.ArchiveFileName:=S; 2321 Item.DiskFileName:=S; 2322 SavePos:=FZipStream.Position; //after filename, before extra fields 2323 if Extra_Field_Length>0 then 2324 begin 2325 SavePos := FZipStream.Position; 2326 if (LocalHdr.Extra_Field_Length>=SizeOf(ExtraFieldHdr)) then 2327 while FZipStream.Position<SavePos+LocalHdr.Extra_Field_Length do 2328 begin 2329 FZipStream.ReadBuffer(ExtraFieldHdr, SizeOf(ExtraFieldHdr)); 2330 {$IFDEF FPC_BIG_ENDIAN} 2331 ExtraFieldHdr := SwapEDFH(ExtraFieldHdr); 2332 {$ENDIF} 2333 if ExtraFieldHdr.Header_ID=ZIP64_HEADER_ID then 2334 begin 2335 FZipStream.ReadBuffer(LocalZip64Fld, SizeOf(LocalZip64Fld)); 2336 {$IFDEF FPC_BIG_ENDIAN} 2337 LocalZip64Fld := SwapZ64EIF(LocalZip64Fld); 2338 {$ENDIF} 2339 end 2340 // Infozip unicode path 2341 else if ExtraFieldHdr.Header_ID=INFOZIP_UNICODE_PATH_ID then 2342 begin 2343 FZipStream.ReadBuffer(Infozip_Unicode_Path_Ver,1); 2344 if Infozip_Unicode_Path_Ver=1 then 2345 begin 2346 FZipStream.ReadBuffer(Infozip_Unicode_Path_CRC32,sizeof(Infozip_Unicode_Path_CRC32)); 2347 {$IFDEF FPC_BIG_ENDIAN} 2348 Infozip_Unicode_Path_CRC32:=SwapEndian(Infozip_Unicode_Path_CRC32); 2349 {$ENDIF} 2350 if CRC32Str(S)=Infozip_Unicode_Path_CRC32 then 2351 begin 2352 SetLength(U,ExtraFieldHdr.Data_Size-5); 2353 FZipStream.ReadBuffer(U[1],Length(U)); 2354 Item.UTF8ArchiveFileName:=U; 2355 Item.UTF8DiskFileName:=U; 2356 end 2357 else 2358 FZipStream.Seek(ExtraFieldHdr.Data_Size-5,soFromCurrent); 2359 end 2360 else 2361 FZipStream.Seek(ExtraFieldHdr.Data_Size-1,soFromCurrent); 2362 end 2363 else 2364 FZipStream.Seek(ExtraFieldHdr.Data_Size,soFromCurrent); 2365 end; 2366 // Move past extra fields 2367 FZipStream.Seek(SavePos+Extra_Field_Length,soFromBeginning); 2368 end; 2369 Item.Size:=Uncompressed_Size; 2370 ZipDateTimeToDateTime(Last_Mod_Date,Last_Mod_Time,D); 2371 Item.DateTime:=D; 2372 if Crc32 <> 0 then 2373 Item.CRC32 := Crc32; 2374 AMethod:=Compress_method; 2375 end; 2376End; 2377 2378procedure TUnZipper.FindEndHeaders( 2379 out AEndHdr: End_of_Central_Dir_Type; 2380 out AEndHdrPos: Int64; 2381 out AEndZip64Hdr: Zip64_End_of_Central_Dir_type; 2382 out AEndZip64HdrPos: Int64); 2383// Reads backwords from the end of the zip file, 2384// following end of central directory, and, if present 2385// zip64 end of central directory locator and 2386// zip64 end of central directory record 2387 2388// If valid regular end of directory found, AEndHdrPos>0 2389// If valid zip64 end of directory found, AEndZip64HdrPos>0 2390var 2391 EndZip64Locator: Zip64_End_of_Central_Dir_Locator_type; 2392 procedure SearchForSignature; 2393 // Search for end of central directory record signature 2394 // If failed, set AEndHdrPos to 0 2395 var 2396 I: Integer; 2397 Buf: PByte; 2398 BufSize: Integer; 2399 result: boolean; 2400 begin 2401 result:=false; 2402 // scan the last (64k + something) bytes for the END_OF_CENTRAL_DIR_SIGNATURE 2403 // (zip file comments are 64k max). 2404 BufSize := 65536 + SizeOf(AEndHdr) + 128; 2405 if FZipStream.Size < BufSize then 2406 BufSize := FZipStream.Size; 2407 2408 Buf := GetMem(BufSize); 2409 try 2410 FZipStream.Seek(FZipStream.Size - BufSize, soBeginning); 2411 FZipStream.ReadBuffer(Buf^, BufSize); 2412 2413 for I := BufSize - SizeOf(AEndHdr) downto 0 do 2414 begin 2415 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 2416 begin 2417 Move(Buf[I], AEndHdr, SizeOf(AEndHdr)); 2418 {$IFDEF FPC_BIG_ENDIAN} 2419 AEndHdr := SwapECD(AEndHdr); 2420 {$ENDIF} 2421 if (AEndHdr.Signature = END_OF_CENTRAL_DIR_SIGNATURE) and 2422 (I + SizeOf(AEndHdr) + AEndHdr.ZipFile_Comment_Length <= BufSize) then 2423 begin 2424 AEndHdrPos := FZipStream.Size - BufSize + I; 2425 FZipStream.Seek(AEndHdrPos + SizeOf(AEndHdr), soBeginning); 2426 SetLength(FFileComment, AEndHdr.ZipFile_Comment_Length); 2427 FZipStream.ReadBuffer(FFileComment[1], Length(FFileComment)); 2428 result:=true; //found it 2429 break; 2430 end; 2431 end; 2432 end; 2433 finally 2434 FreeMem(Buf); 2435 end; 2436 if not(result) then 2437 begin 2438 AEndHdrPos := 0; 2439 FillChar(AEndHdr, SizeOf(AEndHdr), 0); 2440 end; 2441 end; 2442 2443 procedure ZeroData; 2444 begin 2445 AEndHdrPos := 0; 2446 FillChar(AEndHdr, SizeOf(AEndHdr), 0); 2447 AEndZip64HdrPos:=0; 2448 FillChar(AEndZip64Hdr, SizeOf(AEndZip64Hdr), 0); 2449 end; 2450 2451begin 2452 // Zip64 records may not exist, so fill out default values 2453 FillChar(AEndZip64Hdr,SizeOf(AEndZip64Hdr), 0); 2454 AEndZip64HdrPos:=0; 2455 // Look for end of central directory record from 2456 // back of file based on signature (only way due to 2457 // variable length zip comment etc) 2458 FFileComment := ''; 2459 // Zip file requires end of central dir header so 2460 // is corrupt if it is smaller than that 2461 if FZipStream.Size < SizeOf(AEndHdr) then 2462 begin 2463 ZeroData; 2464 exit; 2465 end; 2466 2467 AEndHdrPos := FZipStream.Size - SizeOf(AEndHdr); 2468 FZipStream.Seek(AEndHdrPos, soBeginning); 2469 FZipStream.ReadBuffer(AEndHdr, SizeOf(AEndHdr)); 2470 {$IFDEF FPC_BIG_ENDIAN} 2471 AEndHdr := SwapECD(AEndHdr); 2472 {$ENDIF} 2473 // Search unless record is right at the end of the file: 2474 if (AEndHdr.Signature <> END_OF_CENTRAL_DIR_SIGNATURE) or 2475 (AEndHdr.ZipFile_Comment_Length <> 0) then 2476 SearchForSignature; 2477 if AEndHdrPos=0 then 2478 begin 2479 ZeroData; 2480 exit; 2481 end; 2482 2483 // With a valid end of dir record, see if there's zip64 2484 // fields: 2485 FZipStream.Seek(AEndHdrPos-SizeOf(Zip64_End_of_Central_Dir_Locator_type),soBeginning); 2486 FZipStream.ReadBuffer(EndZip64Locator, SizeOf(EndZip64Locator)); 2487 {$IFDEF FPC_BIG_ENDIAN} 2488 EndZip64Locator := SwapZ64ECDL(EndZip64Locator); 2489 {$ENDIF} 2490 if EndZip64Locator.Signature=ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIGNATURE then 2491 begin 2492 //Read EndZip64Locator.Total_Disks when implementing multiple disks support 2493 if EndZip64Locator.Central_Dir_Zip64_EOCD_Offset>High(Int64) then 2494 raise EZipError.CreateFmt(SErrPosTooLarge,[EndZip64Locator.Central_Dir_Zip64_EOCD_Offset,High(Int64)]); 2495 AEndZip64HdrPos:=EndZip64Locator.Central_Dir_Zip64_EOCD_Offset; 2496 FZipStream.Seek(AEndZip64HdrPos, soBeginning); 2497 FZipStream.ReadBuffer(AEndZip64Hdr, SizeOf(AEndZip64Hdr)); 2498 {$IFDEF FPC_BIG_ENDIAN} 2499 AEndZip64Hdr := SwapZ64ECD(AEndZip64Hdr); 2500 {$ENDIF} 2501 if AEndZip64Hdr.Signature<>ZIP64_END_OF_CENTRAL_DIR_SIGNATURE then 2502 begin 2503 //Corrupt header 2504 ZeroData; 2505 Exit; 2506 end; 2507 end 2508 else 2509 begin 2510 // No zip64 data, so follow the offset in the end of central directory record 2511 AEndZip64HdrPos:=0; 2512 FillChar(AEndZip64Hdr, SizeOf(AEndZip64Hdr), 0); 2513 end; 2514end; 2515 2516procedure TUnZipper.ReadZipDirectory; 2517 2518Var 2519 EndHdr : End_of_Central_Dir_Type; 2520 EndZip64Hdr : Zip64_End_of_Central_Dir_type; 2521 i : integer; //could be Qword but limited to number of items in collection 2522 EndHdrPos, 2523 EndZip64HdrPos, 2524 CenDirPos, 2525 SavePos : Int64; //could be QWord but limited to stream maximums 2526 ExtraFieldHeader : Extensible_Data_Field_Header_Type; 2527 EntriesThisDisk : QWord; 2528 Zip64Field: Zip64_Extended_Info_Field_Type; 2529 NewNode : TFullZipFileEntry; 2530 D : TDateTime; 2531 S : RawByteString; 2532 U : UTF8String; 2533 // infozip unicode path 2534 Infozip_unicode_path_ver : byte; // always 1 2535 Infozip_unicode_path_crc32 : DWord; 2536Begin 2537 FindEndHeaders(EndHdr, EndHdrPos, 2538 EndZip64Hdr, EndZip64HdrPos); 2539 if EndHdrPos=0 then 2540 raise EZipError.CreateFmt(SErrCorruptZIP,[FileName]); 2541 if (EndZip64HdrPos>0) and (EndZip64Hdr.Start_Disk_Offset>0) then 2542 begin 2543 if EndZip64Hdr.Start_Disk_Offset>High(Int64) then 2544 raise EZipError.CreateFmt(SErrPosTooLarge,[EndZip64Hdr.Start_Disk_Offset,High(Int64)]); 2545 CenDirPos := EndZip64Hdr.Start_Disk_Offset; 2546 end 2547 else 2548 CenDirPos := EndHdr.Start_Disk_Offset; 2549 FZipStream.Seek(CenDirPos,soBeginning); 2550 FEntries.Clear; 2551 if (EndZip64HdrPos>0) and (EndZip64Hdr.Entries_This_Disk>0) then 2552 begin 2553 EntriesThisDisk := EndZip64Hdr.Entries_This_Disk; 2554 if EntriesThisDisk<>EndZip64Hdr.Total_Entries then 2555 raise EZipError.Create(SErrUnsupportedMultipleDisksCD); 2556 end 2557 else 2558 begin 2559 EntriesThisDisk :=EndHdr.Entries_This_Disk; 2560 if EntriesThisDisk<>EndHdr.Total_Entries then 2561 raise EZipError.Create(SErrUnsupportedMultipleDisksCD); 2562 end; 2563 2564 // Entries are added to a collection. The max number of items 2565 // in a collection limits the entries we can process. 2566 if EntriesThisDisk>MaxInt then 2567 raise EZipError.CreateFmt(SErrMaxEntries,[EntriesThisDisk,MaxInt]); 2568 2569 // Using while instead of for loop so qword can be used on 32 bit as well. 2570 for i:=0 to EntriesThisDisk-1 do 2571 begin 2572 FZipStream.ReadBuffer(CentralHdr, SizeOf(CentralHdr)); 2573{$IFDEF FPC_BIG_ENDIAN} 2574 CentralHdr := SwapCFH(CentralHdr); 2575{$ENDIF} 2576 With CentralHdr do 2577 begin 2578 if Signature<>CENTRAL_FILE_HEADER_SIGNATURE then 2579 raise EZipError.CreateFmt(SErrCorruptZIP,[FileName]); 2580 NewNode:=FEntries.Add as TFullZipFileEntry; 2581 // Header position will be corrected later with zip64 version, if needed.. 2582 NewNode.HdrPos := Local_Header_Offset; 2583 NewNode.FBitFlags:=Bit_Flag; 2584 SetLength(S,Filename_Length); 2585 FZipStream.ReadBuffer(S[1],Filename_Length); 2586 if Bit_Flag and EFS_LANGUAGE_ENCODING_FLAG <> 0 then 2587 SetCodePage(S, CP_UTF8, False); 2588 SavePos:=FZipStream.Position; //After fixed part of central directory... 2589 // and the filename; before any extra field(s) 2590 NewNode.ArchiveFileName:=S; 2591 // Size/compressed size will be adjusted by zip64 entries if needed... 2592 NewNode.Size:=Uncompressed_Size; 2593 NewNode.FCompressedSize:=Compressed_Size; 2594 NewNode.CRC32:=CRC32; 2595 NewNode.OS := MadeBy_Version shr 8; 2596 if NewNode.OS = OS_UNIX then 2597 NewNode.Attributes := External_Attributes shr 16 2598 else 2599 NewNode.Attributes := External_Attributes; 2600 ZipDateTimeToDateTime(Last_Mod_Date,Last_Mod_Time,D); 2601 NewNode.DateTime:=D; 2602 2603 // Go through any extra fields and extract any zip64 info 2604 if Extra_Field_Length>0 then 2605 begin 2606 while (FZipStream.Position<SavePos+Extra_Field_Length) do 2607 begin 2608 FZipStream.ReadBuffer(ExtraFieldHeader, SizeOf(ExtraFieldHeader)); 2609 {$IFDEF FPC_BIG_ENDIAN} 2610 ExtraFieldHeader := SwapEDFH(ExtraFieldHeader); 2611 {$ENDIF} 2612 if ExtraFieldHeader.Header_ID = ZIP64_HEADER_ID then 2613 begin 2614 FZipStream.ReadBuffer(Zip64Field, SizeOf(Zip64Field)); 2615 {$IFDEF FPC_BIG_ENDIAN} 2616 Zip64Field := SwapZ64EIF(Zip64Field); 2617 {$ENDIF} 2618 if Zip64Field.Compressed_Size > 0 then 2619 NewNode.FCompressedSize := Zip64Field.Compressed_Size; 2620 if Zip64Field.Original_Size>0 then 2621 NewNode.Size := Zip64Field.Original_Size; 2622 if Zip64Field.Relative_Hdr_Offset<>0 then 2623 begin 2624 if Zip64Field.Relative_Hdr_Offset>High(Int64) then 2625 raise EZipError.CreateFmt(SErrPosTooLarge,[Zip64Field.Relative_Hdr_Offset,High(Int64)]); 2626 NewNode.HdrPos := Zip64Field.Relative_Hdr_Offset; 2627 end; 2628 end 2629 // infozip unicode path extra field 2630 else if ExtraFieldHeader.Header_ID = INFOZIP_UNICODE_PATH_ID then 2631 begin 2632 FZipStream.ReadBuffer(Infozip_unicode_path_ver,1); 2633 if Infozip_unicode_path_ver=1 then 2634 begin 2635 FZipStream.ReadBuffer(Infozip_unicode_path_crc32,sizeof(Infozip_unicode_path_crc32)); 2636 {$IFDEF FPC_BIG_ENDIAN} 2637 Infozip_unicode_path_crc32:=SwapEndian(Infozip_unicode_path_crc32); 2638 {$ENDIF} 2639 if CRC32Str(S)=Infozip_unicode_path_crc32 then 2640 begin 2641 SetLength(U,ExtraFieldHeader.Data_Size-5); 2642 FZipStream.ReadBuffer(U[1],Length(U)); 2643 NewNode.UTF8ArchiveFileName:=U; 2644 end 2645 else 2646 FZipStream.Seek(ExtraFieldHeader.Data_Size-5,soFromCurrent); 2647 end 2648 else 2649 FZipStream.Seek(ExtraFieldHeader.Data_Size-1,soFromCurrent); 2650 end 2651 else 2652 begin 2653 // Read past non-Zip64 extra field 2654 FZipStream.Seek(ExtraFieldHeader.Data_Size,soFromCurrent); 2655 end; 2656 end; 2657 end; 2658 // Move past extra fields and file comment to next header 2659 if File_Comment_Length > 0 then 2660 FZipStream.Seek(File_Comment_Length,soFromCurrent); 2661 // this doesn't work properly when zip file size is over 4Gb, so commented off 2662 //FZipStream.Seek(SavePos+Extra_Field_Length+File_Comment_Length,soFromBeginning); 2663 end; 2664 end; 2665end; 2666 2667function TUnZipper.CreateDeCompressor(Item: TZipFileEntry; AMethod: Word; 2668 AZipFile, AOutFile: TStream): TDeCompressor; 2669begin 2670 case AMethod of 2671 8 : 2672 Result:=TInflater.Create(AZipFile,AOutFile,FBufSize); 2673 else 2674 raise EZipError.CreateFmt(SErrUnsupportedCompressionFormat,[AMethod]); 2675 end; 2676 FCurrentDecompressor:=Result; 2677end; 2678 2679procedure TUnZipper.UnZipOneFile(Item: TFullZipFileEntry); 2680 2681Var 2682 ZMethod : Word; 2683{$ifdef unix} 2684 LinkTargetStream: TStringStream; 2685{$endif} 2686 OutputFileName: RawByteString; 2687 FOutStream: TStream; 2688 IsLink: Boolean; 2689 IsCustomStream: Boolean; 2690 U : UnicodeString; 2691 2692 Procedure SetAttributes; 2693 Var 2694 Attrs : Longint; 2695 begin 2696 // set attributes 2697 FileSetDate(OutputFileName, DateTimeToFileDate(Item.DateTime)); 2698 if (Item.Attributes <> 0) then 2699 begin 2700 Attrs := 0; 2701 {$IFDEF UNIX} 2702 if (Item.OS in [OS_UNIX,OS_OSX]) then Attrs := Item.Attributes; 2703 if (Item.OS in [OS_FAT,OS_NTFS,OS_OS2,OS_VFAT]) then 2704 Attrs := ZipFatAttrsToUnixAttrs(Item.Attributes); 2705 {$ELSE} 2706 if (Item.OS in [OS_FAT,OS_NTFS,OS_OS2,OS_VFAT]) then Attrs := Item.Attributes; 2707 if (Item.OS in [OS_UNIX,OS_OSX]) then 2708 Attrs := ZipUnixAttrsToFatAttrs(ExtractFileName(Item.ArchiveFileName), Item.Attributes); 2709 {$ENDIF} 2710 if Attrs <> 0 then 2711 begin 2712 {$IFDEF UNIX} 2713 FpChmod(OutputFileName, Attrs); 2714 {$ELSE} 2715 FileSetAttr(OutputFileName, Attrs); 2716 {$ENDIF} 2717 end; 2718 end; 2719 end; 2720 2721 procedure DoUnzip(const Dest: TStream); 2722 2723 begin 2724 if ZMethod=0 then 2725 begin 2726 if (LocalHdr.Compressed_Size<>0) then 2727 begin 2728 if LocalZip64Fld.Compressed_Size>0 then 2729 Dest.CopyFrom(FZipStream,LocalZip64Fld.Compressed_Size) 2730 else 2731 Dest.CopyFrom(FZipStream,LocalHdr.Compressed_Size); 2732 {$warning TODO: Implement CRC Check} 2733 end; 2734 end 2735 else 2736 With CreateDecompressor(Item, ZMethod, FZipStream, Dest) do 2737 Try 2738 FTotPos := Self.FTotPos; 2739 FTotSize := Self.FTotSize; 2740 OnProgress:=Self.OnProgress; 2741 OnProgressEx := Self.OnProgressEx; 2742 OnPercent:=Self.OnPercent; 2743 OnProgress:=Self.OnProgress; 2744 OnPercent:=Self.OnPercent; 2745 DeCompress; 2746 Self.FTotPos := FTotPos; 2747 if Item.CRC32 <> Crc32Val then 2748 raise EZipError.CreateFmt(SErrInvalidCRC,[Item.ArchiveFileName]); 2749 Finally 2750 FCurrentDecompressor:=Nil; 2751 Free; 2752 end; 2753 end; 2754 2755 Procedure GetOutputFileName; 2756 2757 Var 2758 I : Integer; 2759 2760 begin 2761 if Not UseUTF8 then 2762 OutputFileName:=StringReplace(Item.DiskFileName,'/',DirectorySeparator,[rfReplaceAll]) 2763 else 2764 begin 2765 // Sets codepage. 2766 OutputFileName:=Item.UTF8DiskFileName; 2767 U:=UTF8Decode(OutputFileName); 2768 // Do not use stringreplace, it will mess up the codepage. 2769 if '/'<>DirectorySeparator then 2770 For I:=1 to Length(U) do 2771 if U[i]='/' then 2772 U[i]:=DirectorySeparator; 2773 OutputFileName:=UTF8Encode(U); 2774 end; 2775 if (Not IsCustomStream) then 2776 begin 2777 if Flat then 2778 OutputFileName:=ExtractFileName(OutputFileName); 2779 if (FOutputPath<>'') then 2780 begin 2781 // Do not use IncludeTrailingPathdelimiter 2782 OutputFileName:=FOutputPath+OutputFileName; 2783 end; 2784 end; 2785 end; 2786 2787Begin 2788 ReadZipHeader(Item, ZMethod); 2789 if (Item.BitFlags and 1)<>0 then 2790 Raise EZipError.CreateFmt(SErrEncryptionNotSupported,[Item.ArchiveFileName]); 2791 if (Item.BitFlags and (1 shl 5))<>0 then 2792 Raise EZipError.CreateFmt(SErrPatchSetNotSupported,[Item.ArchiveFileName]); 2793 // Normalize output filename to conventions of target platform. 2794 // Zip file always has / path separators 2795 IsCustomStream := Assigned(FOnCreateStream); 2796 GetOutputFileName; 2797 IsLink := Item.IsLink; 2798{$IFNDEF UNIX} 2799 if IsLink and Not IsCustomStream then 2800 begin 2801 {$warning TODO: Implement symbolic link creation for non-unix, e.g. 2802 Windows NTFS} 2803 IsLink := False; 2804 end; 2805{$ENDIF} 2806 if IsCustomStream then 2807 begin 2808 try 2809 OpenOutput(OutputFileName, FOutStream, Item); 2810 if (IsLink = False) and (Item.IsDirectory = False) then 2811 DoUnzip(FOutStream); 2812 Finally 2813 CloseOutput(Item, FOutStream); 2814 end; 2815 end 2816 else 2817 begin 2818 if IsLink then 2819 begin 2820 {$IFDEF UNIX} 2821 LinkTargetStream := TStringStream.Create(''); 2822 try 2823 DoUnzip(LinkTargetStream); 2824 fpSymlink(PChar(LinkTargetStream.DataString), PChar(OutputFileName)); 2825 finally 2826 LinkTargetStream.Free; 2827 end; 2828 {$ENDIF} 2829 end 2830 else if Item.IsDirectory then 2831 begin 2832 if (NOT Flat) then ForceDirectories(OutputFileName); 2833 end 2834 else 2835 begin 2836 try 2837 OpenOutput(OutputFileName, FOutStream, Item); 2838 DoUnzip(FOutStream); 2839 Finally 2840 CloseOutput(Item, FOutStream); 2841 end; 2842 end; 2843 SetAttributes; 2844 end; 2845end; 2846 2847Function TUnZipper.IsMatch(I : TFullZipFileEntry) : Boolean; 2848 2849begin 2850 if UseUTF8 then 2851 Result:=(FFiles.IndexOf(I.UTF8ArchiveFileName)<>-1) 2852 else 2853 Result:=(FFiles.IndexOf(I.ArchiveFileName)<>-1) 2854end; 2855 2856Function TUnZipper.CalcTotalSize(AllFiles : Boolean) : Int64; 2857 2858Var 2859 I : Integer; 2860 Item : TFullZipFileEntry; 2861 2862begin 2863 Result:=0; 2864 for i:=0 to FEntries.Count-1 do 2865 begin 2866 Item := FEntries[i]; 2867 if AllFiles or IsMatch(Item) then 2868 Result := Result + TZipFileEntry(Item).Size; 2869 end; 2870end; 2871 2872procedure TUnZipper.UnZipAllFiles; 2873 2874 2875Var 2876 Item : TFullZipFileEntry; 2877 I : integer; //Really QWord but limited to FEntries.Count 2878 AllFiles : Boolean; 2879 2880Begin 2881 FTerminated:=False; 2882 FUnZipping:=True; 2883 Try 2884 AllFiles:=(FFiles.Count=0); 2885 OpenInput; 2886 Try 2887 ReadZipDirectory; 2888 FTotPos := 0; 2889 FTotSize := CalcTotalSize(AllFiles); 2890 i:=0; 2891 While (I<FEntries.Count) and not Terminated do 2892 begin 2893 Item:=FEntries[i]; 2894 if AllFiles or IsMatch(Item) then 2895 UnZipOneFile(Item); 2896 inc(I); 2897 end; 2898 if Assigned(FOnProgressEx) and not Terminated then 2899 FOnProgressEx(Self, FTotPos, FTotSize); 2900 Finally 2901 CloseInput; 2902 end; 2903 finally 2904 FUnZipping:=False; 2905 end; 2906end; 2907 2908 2909procedure TUnZipper.SetBufSize(Value: LongWord); 2910 2911begin 2912 If FUnZipping then 2913 Raise EZipError.Create(SErrBufsizeChange); 2914 If Value>=DefaultBufSize then 2915 FBufSize:=Value; 2916end; 2917 2918procedure TUnZipper.SetFileName(Value: RawByteString); 2919 2920begin 2921 If FUnZipping then 2922 Raise EZipError.Create(SErrFileChange); 2923 FFileName:=Value; 2924end; 2925 2926procedure TUnZipper.SetOutputPath(Value: RawByteString); 2927 2928Var 2929 DS : RawByteString; 2930 2931begin 2932 If FUnZipping then 2933 Raise EZipError.Create(SErrFileChange); 2934 FOutputPath:=Value; 2935 If (FOutputPath<>'') and (FoutputPath[Length(FoutputPath)]<>DirectorySeparator) then 2936 begin 2937 // Preserve codepage of outputpath 2938 DS:=DirectorySeparator; 2939 SetCodePage(DS,StringCodePage(FoutputPath),False); 2940 FOutputPath:=FoutputPath+DS; 2941 end; 2942end; 2943 2944procedure TUnZipper.UnZipFile(const aExtractFileName: RawByteString); 2945begin 2946 UnzipFile(FFileName, aExtractFileName); 2947end; 2948 2949procedure TUnZipper.UnZipFile(const AZipFileName, aExtractFileName: RawByteString); 2950var 2951 L: TStrings; 2952begin 2953 FFileName := AZipFileName; 2954 L := TStringList.Create; 2955 try 2956 L.Add(aExtractFileName); 2957 UnzipFiles(L); 2958 finally 2959 L.Free; 2960 end; 2961end; 2962 2963procedure TUnZipper.UnZipFiles(const AZipFileName: RawByteString; FileList: TStrings); 2964 2965begin 2966 FFileName:=AZipFileName; 2967 UnZipFiles(FileList); 2968end; 2969 2970procedure TUnZipper.UnZipFiles(const AZipFileName: RawByteString; aFileList: array of RawBytestring); 2971 2972Var 2973 L : TStringList; 2974 S : RawByteString; 2975 2976begin 2977 L:=TStringList.Create; 2978 try 2979 L.Capacity:=Length(aFileList); 2980 for S in aFileList do 2981 L.Add(S); 2982 UnZipFiles(aZipFileName,L); 2983 finally 2984 L.Free; 2985 end; 2986end; 2987 2988procedure TUnZipper.UnZipFiles(aFileList: TStrings); 2989begin 2990 FFiles.Assign(aFileList); 2991 UnZipAllFiles; 2992end; 2993 2994procedure TUnZipper.UnZipAllFiles(const AZipFileName: RawByteString); 2995 2996begin 2997 FFileName:=AZipFileName; 2998 UnZipAllFiles; 2999end; 3000 3001class procedure TUnZipper.Unzip(const AZipFileName: RawByteString); 3002 3003begin 3004 With Self.Create do 3005 try 3006 FileName:=aZipFileName; 3007 UnZipAllFiles; 3008 finally 3009 Free; 3010 end; 3011end; 3012 3013class procedure TUnZipper.Unzip(const AZipFileName: RawByteString; aExtractFileName: RawByteString); 3014 3015begin 3016 With Self.Create do 3017 try 3018 UnZipFile(aZipFileName,aExtractFileName); 3019 finally 3020 Free; 3021 end; 3022end; 3023 3024class procedure TUnZipper.Unzip(const AZipFileName: RawByteString; aFileList: array of RawByteString); 3025begin 3026 With Self.Create do 3027 try 3028 UnZipFiles(aZipFileName,aFileList); 3029 finally 3030 Free; 3031 end; 3032end; 3033 3034class procedure TUnZipper.Unzip(const AZipFileName: RawByteString; aFileList: TStrings); 3035begin 3036 With Self.Create do 3037 try 3038 UnZipFiles(aZipFileName,aFileList); 3039 finally 3040 Free; 3041 end; 3042end; 3043 3044procedure TUnZipper.DoEndOfFile; 3045 3046Var 3047 ComprPct : Double; 3048 Uncompressed: QWord; 3049 Compressed: QWord; 3050begin 3051 If LocalZip64Fld.Original_Size > 0 then 3052 Uncompressed := LocalZip64Fld.Original_Size 3053 else 3054 Uncompressed := LocalHdr.Uncompressed_Size; 3055 3056 If LocalZip64Fld.Compressed_Size > 0 then 3057 Compressed := LocalZip64Fld.Compressed_Size 3058 else 3059 Compressed := LocalHdr.Compressed_Size; 3060 3061 If (Compressed>0) and (Uncompressed>0) then 3062 if (Compressed>Uncompressed) then 3063 ComprPct := (-100.0 * (Compressed - Uncompressed)) / Uncompressed 3064 else 3065 ComprPct := (100.0 * (Uncompressed - Compressed)) / Uncompressed 3066 else 3067 ComprPct := 0; 3068 If Assigned(FOnEndOfFile) then 3069 FOnEndOfFile(Self,ComprPct); 3070end; 3071 3072constructor TUnZipper.Create; 3073 3074begin 3075 FBufSize:=DefaultBufSize; 3076 FFiles:=TStringList.Create; 3077 TStringlist(FFiles).Sorted:=True; 3078 FEntries:=TFullZipFileEntries.Create(TFullZipFileEntry); 3079 FOnPercent:=1; 3080end; 3081 3082procedure TUnZipper.Clear; 3083 3084begin 3085 FFiles.Clear; 3086 FEntries.Clear; 3087end; 3088 3089procedure TUnZipper.Examine; 3090begin 3091 if (FOnOpenInputStream = nil) and (FFileName='') then 3092 Raise EZipError.Create(SErrNoFileName); 3093 OpenInput; 3094 If (FZipStream=nil) then 3095 Raise EZipError.Create(SErrNoStream); 3096 Try 3097 ReadZipDirectory; 3098 Finally 3099 CloseInput; 3100 end; 3101end; 3102 3103procedure TUnZipper.Terminate; 3104begin 3105 FTerminated:=True; 3106 if Assigned(FCurrentDecompressor) then 3107 FCurrentDecompressor.Terminate; 3108end; 3109 3110destructor TUnZipper.Destroy; 3111 3112begin 3113 Clear; 3114 FreeAndNil(FFiles); 3115 FreeAndNil(FEntries); 3116 Inherited; 3117end; 3118 3119{ TZipFileEntry } 3120 3121function TZipFileEntry.GetArchiveFileName: String; 3122begin 3123 Result:=FArchiveFileName; 3124 If (Result='') then 3125 Result:=FDiskFileName; 3126end; 3127 3128function TZipFileEntry.GetUTF8ArchiveFileName: UTF8String; 3129begin 3130 Result:=FUTF8FileName; 3131 If Result='' then 3132 Result:=ArchiveFileName; 3133end; 3134 3135function TZipFileEntry.GetUTF8DiskFileName: UTF8String; 3136begin 3137 Result:=FUTF8DiskFileName; 3138 If Result='' then 3139 Result:=DiskFileName; 3140end; 3141 3142constructor TZipFileEntry.Create(ACollection: TCollection); 3143 3144begin 3145{$IFDEF UNIX} 3146 FOS := OS_UNIX; 3147{$ELSE} 3148 FOS := OS_FAT; 3149{$ENDIF} 3150 FCompressionLevel:=cldefault; 3151 FDateTime:=now; 3152 FNeedsZip64:=false; 3153 FAttributes:=0; 3154 3155 inherited create(ACollection); 3156end; 3157 3158function TZipFileEntry.IsDirectory: Boolean; 3159begin 3160 Result := (DiskFileName <> '') and (DiskFileName[Length(DiskFileName)] = DirectorySeparator); 3161 if Attributes <> 0 then 3162 begin 3163 case OS of 3164 OS_FAT: Result := (faDirectory and Attributes) > 0; 3165 OS_UNIX: Result := (Attributes and UNIX_MASK) = UNIX_DIR; 3166 end; 3167 end; 3168end; 3169 3170function TZipFileEntry.IsLink: Boolean; 3171begin 3172 Result := False; 3173 if Attributes <> 0 then 3174 begin 3175 case OS of 3176 OS_FAT: Result := (faSymLink and Attributes) > 0; 3177 OS_UNIX: Result := (Attributes and UNIX_MASK) = UNIX_LINK; 3178 end; 3179 end; 3180end; 3181 3182procedure TZipFileEntry.SetArchiveFileName(const AValue: String); 3183 3184begin 3185 if FArchiveFileName=AValue then Exit; 3186 // Zip standard: filenames inside the zip archive have / path separator 3187 if DirectorySeparator='/' then 3188 FArchiveFileName:=AValue 3189 else 3190 FArchiveFileName:=StringReplace(AValue, DirectorySeparator, '/', [rfReplaceAll]); 3191end; 3192 3193procedure TZipFileEntry.SetDiskFileName(const AValue: String); 3194begin 3195 if FDiskFileName=AValue then Exit; 3196 // Zip file uses / as directory separator on all platforms 3197 // so convert to separator used on current OS 3198 if DirectorySeparator='/' then 3199 FDiskFileName:=AValue 3200 else 3201 FDiskFileName:=StringReplace(AValue,'/',DirectorySeparator,[rfReplaceAll]); 3202end; 3203 3204procedure TZipFileEntry.SetUTF8ArchiveFileName(AValue: UTF8String); 3205begin 3206 FUTF8FileName:=AValue; 3207 If ArchiveFileName='' then 3208 if DefaultSystemCodePage<>CP_UTF8 then 3209 ArchiveFileName:=Utf8ToAnsi(AValue) 3210 else 3211 ArchiveFileName:=AValue; 3212end; 3213 3214procedure TZipFileEntry.SetUTF8DiskFileName(AValue: UTF8String); 3215begin 3216 FUTF8DiskFileName:=AValue; 3217 If DiskFileName='' then 3218 if DefaultRTLFileSystemCodePage<>CP_UTF8 then 3219 DiskFileName:=Utf8ToAnsi(AValue) 3220 else 3221 DiskFileName:=AValue; 3222end; 3223 3224 3225procedure TZipFileEntry.Assign(Source: TPersistent); 3226 3227Var 3228 Z : TZipFileEntry; 3229 3230begin 3231 if Source is TZipFileEntry then 3232 begin 3233 Z:=Source as TZipFileEntry; 3234 FArchiveFileName:=Z.FArchiveFileName; 3235 FDiskFileName:=Z.FDiskFileName; 3236 FSize:=Z.FSize; 3237 FDateTime:=Z.FDateTime; 3238 FStream:=Z.FStream; 3239 FOS:=Z.OS; 3240 FAttributes:=Z.Attributes; 3241 end 3242 else 3243 inherited Assign(Source); 3244end; 3245 3246{ TZipFileEntries } 3247 3248function TZipFileEntries.GetZ(AIndex : Integer): TZipFileEntry; 3249begin 3250 Result:=TZipFileEntry(Items[AIndex]); 3251end; 3252 3253procedure TZipFileEntries.SetZ(AIndex : Integer; const AValue: TZipFileEntry); 3254begin 3255 Items[AIndex]:=AValue; 3256end; 3257 3258function TZipFileEntries.AddFileEntry(const ADiskFileName: String): TZipFileEntry; 3259begin 3260 Result:=Add as TZipFileEntry; 3261 Result.DiskFileName:=ADiskFileName; 3262end; 3263 3264function TZipFileEntries.AddFileEntry(const ADiskFileName, 3265 AArchiveFileName: String): TZipFileEntry; 3266begin 3267 Result:=AddFileEntry(ADiskFileName); 3268 Result.ArchiveFileName:=AArchiveFileName; 3269end; 3270 3271function TZipFileEntries.AddFileEntry(const AStream: TSTream; 3272 const AArchiveFileName: String): TZipFileEntry; 3273begin 3274 Result:=Add as TZipFileEntry; 3275 Result.Stream:=AStream; 3276 Result.ArchiveFileName:=AArchiveFileName; 3277end; 3278 3279Procedure TZipFileEntries.AddFileEntries(Const List : TStrings); 3280 3281Var 3282 I : integer; 3283 3284begin 3285 For I:=0 to List.Count-1 do 3286 AddFileEntry(List[i]); 3287end; 3288 3289{ TFullZipFileEntries } 3290 3291function TFullZipFileEntries.GetFZ(AIndex : Integer): TFullZipFileEntry; 3292begin 3293 Result:=TFullZipFileEntry(Items[AIndex]); 3294end; 3295 3296procedure TFullZipFileEntries.SetFZ(AIndex : Integer; 3297 const AValue: TFullZipFileEntry); 3298begin 3299 Items[AIndex]:=AValue; 3300end; 3301 3302End. 3303