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+}
16 unit opkman_zip;
17 {$warnings off}
18 {$hints off}
19 Interface
20
21 Uses
22 {$IFDEF UNIX}
23 BaseUnix,
24 {$ENDIF}
25 SysUtils,Classes,zstream;
26
27
28 Const
29 { Signatures }
30 END_OF_CENTRAL_DIR_SIGNATURE = $06054B50;
31 ZIP64_END_OF_CENTRAL_DIR_SIGNATURE = $06064B50;
32 ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIGNATURE = $07064B50;
33 LOCAL_FILE_HEADER_SIGNATURE = $04034B50;
34 CENTRAL_FILE_HEADER_SIGNATURE = $02014B50;
35 ZIP64_HEADER_ID = $0001;
36 // infozip unicode path
37 INFOZIP_UNICODE_PATH_ID = $7075;
38
39 const
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
71 Type
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
162 Const
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
198 Type
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
205 Type
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;
ZipIDnull222 Class Function ZipID : Word; virtual; Abstract;
ZipVersionReqdnull223 Class Function ZipVersionReqd: Word; virtual; Abstract;
ZipBitFlagnull224 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;
ZipIDnull251 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
262 Const
263 TABLESIZE = 8191;
264 FIRSTENTRY = 257;
265
266 Type
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);
Table_Lookupnull313 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;
ZipIDnull323 Class Function ZipID : Word; override;
ZipVersionReqdnull324 Class Function ZipVersionReqd : Word; override;
ZipBitFlagnull325 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;
ZipIDnull336 Class Function ZipID : Word; override;
ZipVersionReqdnull337 Class Function ZipVersionReqd : Word; override;
ZipBitFlagnull338 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;
ZipIDnull348 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;
GetArchiveFileNamenull368 function GetArchiveFileName: String;
GetUTF8ArchiveFileNamenull369 function GetUTF8ArchiveFileName: UTF8String;
GetUTF8DiskFileNamenull370 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;
IsDirectorynull381 function IsDirectory: Boolean;
IsLinknull382 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
GetZnull401 function GetZ(AIndex : Integer): TZipFileEntry;
402 procedure SetZ(AIndex : Integer; const AValue: TZipFileEntry);
403 Public
AddFileEntrynull404 Function AddFileEntry(Const ADiskFileName : String): TZipFileEntry;
AddFileEntrynull405 Function AddFileEntry(Const ADiskFileName, AArchiveFileName : String): TZipFileEntry;
AddFileEntrynull406 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;
CheckEntriesnull436 function CheckEntries: Integer;
437 procedure SetEntries(const AValue: TZipFileEntries);
438 Protected
439 Procedure CloseInput(Item : TZipFileEntry);
440 Procedure StartZipFile(Item : TZipFileEntry);
UpdateZipHeadernull441 Function UpdateZipHeader(Item : TZipFileEntry; FZip : TStream; ACRC : LongWord;AMethod : Word; AZipVersionReqd : Word; AZipBitFlag : Word) : Boolean;
442 Procedure BuildZipDirectory; //Builds central directory based on local headers
443 Procedure DoEndOfFile;
444 Procedure ZipOneFile(Item : TZipFileEntry); virtual;
OpenInputnull445 Function OpenInput(Item : TZipFileEntry) : Boolean;
446 Procedure GetFileInfo;
447 Procedure SetBufSize(Value : LongWord);
448 Procedure SetFileName(Value : RawByteString);
CreateCompressornull449 Function CreateCompressor(Item : TZipFileEntry; AinFile,AZipStream : TStream) : TCompressor; virtual;
450 Property NeedsZip64 : boolean Read FZipFileNeedsZip64 Write FZipFileNeedsZip64;
451 Public
452 Constructor Create;
453 Destructor Destroy;override;
454 Procedure ZipAllFiles; virtual;
455 // Saves zip to file and changes FileName
456 Procedure SaveToFile(AFileName: RawByteString);
457 // Saves zip to stream
458 Procedure SaveToStream(AStream: TStream);
459 // Zips specified files into a zip with name AFileName
460 Procedure ZipFiles(AFileName : RawByteString; FileList : TStrings);
461 Procedure ZipFiles(FileList : TStrings);
462 // Zips specified entries into a zip with name AFileName
463 Procedure ZipFiles(AFileName : RawByteString; Entries : TZipFileEntries);
464 Procedure ZipFiles(Entries : TZipFileEntries);
465 Procedure Clear;
466 Procedure Terminate;
467 Public
468 Property BufferSize : LongWord Read FBufSize Write SetBufSize;
469 Property OnPercent : Integer Read FOnPercent Write FOnPercent;
470 Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
471 Property OnStartFile : TOnStartFileEvent Read FOnStartFile Write FOnStartFile;
472 Property OnEndFile : TOnEndOfFileEvent Read FOnEndOfFile Write FOnEndOfFile;
473 Property FileName : RawByteString Read FFileName Write SetFileName;
474 Property FileComment: String Read FFileComment Write FFileComment;
475 // Deprecated. Use Entries.AddFileEntry(FileName) or Entries.AddFileEntries(List) instead.
476 Property Files : TStrings Read FFiles; deprecated;
477 Property InMemSize : Int64 Read FInMemSize Write FInMemSize;
478 Property Entries : TZipFileEntries Read FEntries Write SetEntries;
479 Property Terminated : Boolean Read FTerminated;
480 end;
481
482 { TFullZipFileEntry }
483
484 TFullZipFileEntry = Class(TZipFileEntry)
485 private
486 FBitFlags: Word;
487 FCompressedSize: QWord;
488 FCompressMethod: Word;
489 FCRC32: LongWord;
490 Public
491 Property BitFlags : Word Read FBitFlags;
492 Property CompressMethod : Word Read FCompressMethod;
493 Property CompressedSize : QWord Read FCompressedSize;
494 property CRC32: LongWord read FCRC32 write FCRC32;
495 end;
496
497 TOnCustomStreamEvent = Procedure(Sender : TObject; var AStream : TStream; AItem : TFullZipFileEntry) of object;
498 TCustomInputStreamEvent = Procedure(Sender: TObject; var AStream: TStream) of object;
499
500 { TFullZipFileEntries }
501
502 TFullZipFileEntries = Class(TZipFileEntries)
503 private
GetFZnull504 function GetFZ(AIndex : Integer): TFullZipFileEntry;
505 procedure SetFZ(AIndex : Integer; const AValue: TFullZipFileEntry);
506 Public
507 Property FullEntries[AIndex : Integer] : TFullZipFileEntry Read GetFZ Write SetFZ; default;
508 end;
509
510 { TUnZipper }
511
512 TUnZipper = Class(TObject)
513 Private
514 FOnCloseInputStream: TCustomInputStreamEvent;
515 FOnCreateStream: TOnCustomStreamEvent;
516 FOnDoneStream: TOnCustomStreamEvent;
517 FOnOpenInputStream: TCustomInputStreamEvent;
518 FUnZipping : Boolean;
519 FBufSize : LongWord;
520 FFileName : RawByteString; { Name of resulting Zip file }
521 FOutputPath : RawByteString;
522 FFileComment: String;
523 FEntries : TFullZipFileEntries;
524 FFiles : TStrings;
525 FUseUTF8: Boolean;
526 FZipStream : TStream; { I/O file variables }
527 LocalHdr : Local_File_Header_Type; //Local header, before compressed file data
528 LocalZip64Fld : Zip64_Extended_Info_Field_Type; //header is in LocalZip64ExtHdr
529 CentralHdr : Central_File_Header_Type;
530 FTotPos : Int64;
531 FTotSize : Int64;
532 FTerminated: Boolean;
533 FOnPercent : LongInt;
534 FOnProgress : TProgressEvent;
535 FOnProgressEx : TProgressEventEx;
536 FOnEndOfFile : TOnEndOfFileEvent;
537 FOnStartFile : TOnStartFileEvent;
538 FCurrentDecompressor: TDecompressor;
CalcTotalSizenull539 function CalcTotalSize(AllFiles: Boolean): Int64;
IsMatchnull540 function IsMatch(I: TFullZipFileEntry): Boolean;
541 Protected
542 Procedure OpenInput;
543 Procedure CloseOutput(Item : TFullZipFileEntry; var OutStream: TStream);
544 Procedure CloseInput;
545 Procedure FindEndHeaders(
546 out AEndHdr: End_of_Central_Dir_Type;
547 out AEndHdrPos: Int64;
548 out AEndZip64Hdr: Zip64_End_of_Central_Dir_type;
549 out AEndZip64HdrPos: Int64);
550 Procedure ReadZipDirectory;
551 Procedure ReadZipHeader(Item : TFullZipFileEntry; out AMethod : Word);
552 Procedure DoEndOfFile;
553 Procedure UnZipOneFile(Item : TFullZipFileEntry); virtual;
OpenOutputnull554 Function OpenOutput(OutFileName : RawByteString; Out OutStream: TStream; Item : TFullZipFileEntry) : Boolean;
555 Procedure SetBufSize(Value : LongWord);
556 Procedure SetFileName(Value : RawByteString);
557 Procedure SetOutputPath(Value: RawByteString);
CreateDeCompressornull558 Function CreateDeCompressor(Item : TZipFileEntry; AMethod : Word;AZipFile,AOutFile : TStream) : TDeCompressor; virtual;
559 Public
560 Constructor Create;
561 Destructor Destroy;override;
562 Procedure UnZipAllFiles; virtual;
563 Procedure UnZipFiles(AFileName : RawByteString; FileList : TStrings);
564 Procedure UnZipFiles(FileList : TStrings);
565 Procedure UnZipAllFiles(AFileName : RawByteString);
566 Procedure Clear;
567 Procedure Examine;
568 Procedure Terminate;
569 Public
570 Property BufferSize : LongWord Read FBufSize Write SetBufSize;
571 Property OnOpenInputStream: TCustomInputStreamEvent read FOnOpenInputStream write FOnOpenInputStream;
572 Property OnCloseInputStream: TCustomInputStreamEvent read FOnCloseInputStream write FOnCloseInputStream;
573 Property OnCreateStream : TOnCustomStreamEvent Read FOnCreateStream Write FOnCreateStream;
574 Property OnDoneStream : TOnCustomStreamEvent Read FOnDoneStream Write FOnDoneStream;
575 Property OnPercent : Integer Read FOnPercent Write FOnPercent;
576 Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
577 Property OnProgressEx : TProgressEventEx Read FOnProgressEx Write FOnProgressEx;
578 Property OnStartFile : TOnStartFileEvent Read FOnStartFile Write FOnStartFile;
579 Property OnEndFile : TOnEndOfFileEvent Read FOnEndOfFile Write FOnEndOfFile;
580 Property FileName : RawByteString Read FFileName Write SetFileName;
581 Property OutputPath : RawByteString Read FOutputPath Write SetOutputPath;
582 Property FileComment: String Read FFileComment;
583 Property Files : TStrings Read FFiles;
584 Property Entries : TFullZipFileEntries Read FEntries;
585 Property UseUTF8 : Boolean Read FUseUTF8 Write FUseUTF8;
586 Property Terminated : Boolean Read FTerminated;
587 end;
588
589 EZipError = Class(Exception);
590
591 Implementation
592
593 uses rtlconsts;
594
595 ResourceString
596 SErrBufsizeChange = 'Changing buffer size is not allowed while (un)zipping.';
597 SErrFileChange = 'Changing output file name is not allowed while (un)zipping.';
598 SErrInvalidCRC = 'Invalid CRC checksum while unzipping %s.';
599 SErrCorruptZIP = 'Corrupt ZIP file %s.';
600 SErrUnsupportedCompressionFormat = 'Unsupported compression format %d.';
601 SErrUnsupportedMultipleDisksCD = 'A central directory split over multiple disks is unsupported.';
602 SErrMaxEntries = 'Encountered %d file entries; maximum supported is %d.';
603 SErrMissingFileName = 'Missing filename in entry %d.';
604 SErrMissingArchiveName = 'Missing archive filename in streamed entry %d.';
605 SErrFileDoesNotExist = 'File "%s" does not exist.';
606 SErrPosTooLarge = 'Position/offset %d is larger than maximum supported %d.';
607 SErrNoFileName = 'No archive filename for examine operation.';
608 SErrNoStream = 'No stream is opened.';
609 SErrEncryptionNotSupported = 'Cannot unzip item "%s": encryption is not supported.';
610 SErrPatchSetNotSupported = 'Cannot unzip item "%s": patch sets are not supported.';
611
612 { ---------------------------------------------------------------------
613 Auxiliary
614 ---------------------------------------------------------------------}
615 Type
616 // A local version of TFileStream which uses rawbytestring. It
617 TFileStream = class(THandleStream)
618 Private
619 FFileName : RawBytestring;
620 public
621 constructor Create(const AFileName: RawBytestring; Mode: Word);
622 constructor Create(const AFileName: RawBytestring; Mode: Word; Rights: Cardinal);
623 destructor Destroy; override;
624 property FileName : RawBytestring Read FFilename;
625 end;
626 constructor TFileStream.Create(const AFileName: rawbytestring; Mode: Word);
627
628 begin
629 Create(AFileName,Mode,438);
630 end;
631
632
633 constructor TFileStream.Create(const AFileName: rawbytestring; Mode: Word; Rights: Cardinal);
634
635 Var
636 H : Thandle;
637
638 begin
639 FFileName:=AFileName;
640 If (Mode and fmCreate) > 0 then
641 H:=FileCreate(AFileName,Mode,Rights)
642 else
643 H:=FileOpen(AFileName,Mode);
644
645 If (THandle(H)=feInvalidHandle) then
646 If Mode=fmcreate then
647 raise EFCreateError.createfmt(SFCreateError,[AFileName])
648 else
649 raise EFOpenError.Createfmt(SFOpenError,[AFilename]);
650 Inherited Create(H);
651 end;
652
653
654 destructor TFileStream.Destroy;
655
656 begin
657 FileClose(Handle);
658 end;
659
660 {$IFDEF FPC_BIG_ENDIAN}
SwapLFHnull661 function SwapLFH(const Values: Local_File_Header_Type): Local_File_Header_Type;
662 begin
663 with Values do
664 begin
665 Result.Signature := SwapEndian(Signature);
666 Result.Extract_Version_Reqd := SwapEndian(Extract_Version_Reqd);
667 Result.Bit_Flag := SwapEndian(Bit_Flag);
668 Result.Compress_Method := SwapEndian(Compress_Method);
669 Result.Last_Mod_Time := SwapEndian(Last_Mod_Time);
670 Result.Last_Mod_Date := SwapEndian(Last_Mod_Date);
671 Result.Crc32 := SwapEndian(Crc32);
672 Result.Compressed_Size := SwapEndian(Compressed_Size);
673 Result.Uncompressed_Size := SwapEndian(Uncompressed_Size);
674 Result.Filename_Length := SwapEndian(Filename_Length);
675 Result.Extra_Field_Length := SwapEndian(Extra_Field_Length);
676 end;
677 end;
678
SwapEDFHnull679 function SwapEDFH(const Values: Extensible_Data_Field_Header_Type): Extensible_Data_Field_Header_Type;
680 begin
681 with Values do
682 begin
683 Result.Header_ID := SwapEndian(Header_ID);
684 Result.Data_Size := SwapEndian(Data_Size);
685 end;
686 end;
687
SwapZ64EIFnull688 function SwapZ64EIF(const Values: Zip64_Extended_Info_Field_Type): Zip64_Extended_Info_Field_Type;
689 begin
690 with Values do
691 begin
692 Result.Original_Size := SwapEndian(Original_Size);
693 Result.Compressed_Size := SwapEndian(Compressed_Size);
694 Result.Relative_Hdr_Offset := SwapEndian(Relative_Hdr_Offset);
695 Result.Disk_Start_Number := SwapEndian(Disk_Start_Number);
696 end;
697 end;
698
SwapCFHnull699 function SwapCFH(const Values: Central_File_Header_Type): Central_File_Header_Type;
700 begin
701 with Values do
702 begin
703 Result.Signature := SwapEndian(Signature);
704 Result.MadeBy_Version := SwapEndian(MadeBy_Version);
705 Result.Extract_Version_Reqd := SwapEndian(Extract_Version_Reqd);
706 Result.Bit_Flag := SwapEndian(Bit_Flag);
707 Result.Compress_Method := SwapEndian(Compress_Method);
708 Result.Last_Mod_Time := SwapEndian(Last_Mod_Time);
709 Result.Last_Mod_Date := SwapEndian(Last_Mod_Date);
710 Result.Crc32 := SwapEndian(Crc32);
711 Result.Compressed_Size := SwapEndian(Compressed_Size);
712 Result.Uncompressed_Size := SwapEndian(Uncompressed_Size);
713 Result.Filename_Length := SwapEndian(Filename_Length);
714 Result.Extra_Field_Length := SwapEndian(Extra_Field_Length);
715 Result.File_Comment_Length := SwapEndian(File_Comment_Length);
716 Result.Starting_Disk_Num := SwapEndian(Starting_Disk_Num);
717 Result.Internal_Attributes := SwapEndian(Internal_Attributes);
718 Result.External_Attributes := SwapEndian(External_Attributes);
719 Result.Local_Header_Offset := SwapEndian(Local_Header_Offset);
720 end;
721 end;
722
SwapECDnull723 function SwapECD(const Values: End_of_Central_Dir_Type): End_of_Central_Dir_Type;
724 begin
725 with Values do
726 begin
727 Result.Signature := SwapEndian(Signature);
728 Result.Disk_Number := SwapEndian(Disk_Number);
729 Result.Central_Dir_Start_Disk := SwapEndian(Central_Dir_Start_Disk);
730 Result.Entries_This_Disk := SwapEndian(Entries_This_Disk);
731 Result.Total_Entries := SwapEndian(Total_Entries);
732 Result.Central_Dir_Size := SwapEndian(Central_Dir_Size);
733 Result.Start_Disk_Offset := SwapEndian(Start_Disk_Offset);
734 Result.ZipFile_Comment_Length := SwapEndian(ZipFile_Comment_Length);
735 end;
736 end;
737
SwapZ64ECDnull738 function SwapZ64ECD(const Values: Zip64_End_of_Central_Dir_Type): Zip64_End_of_Central_Dir_Type;
739 begin
740 with Values do
741 begin
742 Result.Signature := SwapEndian(Signature);
743 Result.Record_Size := SwapEndian(Record_Size);
744 Result.Version_Made_By := SwapEndian(Version_Made_By);
745 Result.Extract_Version_Reqd := SwapEndian(Extract_Version_Reqd);
746 Result.Disk_Number := SwapEndian(Disk_Number);
747 Result.Central_Dir_Start_Disk := SwapEndian(Central_Dir_Start_Disk);
748 Result.Entries_This_Disk := SwapEndian(Entries_This_Disk);
749 Result.Total_Entries := SwapEndian(Total_Entries);
750 Result.Central_Dir_Size := SwapEndian(Central_Dir_Size);
751 Result.Start_Disk_Offset := SwapEndian(Start_Disk_Offset);
752 end;
753 end;
754
SwapZ64ECDLnull755 function SwapZ64ECDL(const Values: Zip64_End_of_Central_Dir_Locator_type): Zip64_End_of_Central_Dir_Locator_type;
756 begin
757 with Values do
758 begin
759 Result.Signature := SwapEndian(Signature);
760 Result.Zip64_EOCD_Start_Disk := SwapEndian(Zip64_EOCD_Start_Disk);
761 Result.Central_Dir_Zip64_EOCD_Offset := SwapEndian(Central_Dir_Zip64_EOCD_Offset);
762 Result.Total_Disks := SwapEndian(Total_Disks);
763 end;
764 end;
765 {$ENDIF FPC_BIG_ENDIAN}
766
767 Procedure DateTimeToZipDateTime(DT : TDateTime; out ZD,ZT : Word);
768
769 Var
770 Y,M,D,H,N,S,MS : Word;
771
772 begin
773 DecodeDate(DT,Y,M,D);
774 DecodeTime(DT,H,N,S,MS);
775 if Y<1980 then
776 begin
777 // Invalid date/time; set to earliest possible
778 Y:=0;
779 M:=1;
780 D:=1;
781 H:=0;
782 N:=0;
783 S:=0;
784 MS:=0;
785 end
786 else
787 begin
788 Y:=Y-1980;
789 end;
790 ZD:=d+(32*M)+(512*Y);
791 ZT:=(S div 2)+(32*N)+(2048*h);
792 end;
793
794 Procedure ZipDateTimeToDateTime(ZD,ZT : Word;out DT : TDateTime);
795
796 Var
797 Y,M,D,H,N,S,MS : Word;
798
799 begin
800 MS:=0;
801 S:=(ZT and 31) shl 1;
802 N:=(ZT shr 5) and 63;
803 H:=ZT shr 11;
804 D:=ZD and 31;
805 M:=(ZD shr 5) and 15;
806 Y:=((ZD shr 9) and 127)+1980;
807
808 if M < 1 then M := 1;
809 if D < 1 then D := 1;
810 DT:=ComposeDateTime(EncodeDate(Y,M,D),EncodeTime(H,N,S,MS));
811 end;
812
813
814
ZipUnixAttrsToFatAttrsnull815 function ZipUnixAttrsToFatAttrs(const Name: String; Attrs: Longint): Longint;
816 begin
817 Result := faArchive;
818
819 if (Pos('.', Name) = 1) and (Name <> '.') and (Name <> '..') then
820 Result := Result + faHidden;
821 case (Attrs and UNIX_MASK) of
822 UNIX_DIR: Result := Result + faDirectory;
823 UNIX_LINK: Result := Result + faSymLink;
824 UNIX_FIFO, UNIX_CHAR, UNIX_BLK, UNIX_SOCK:
825 Result := Result + faSysFile;
826 end;
827
828 if (Attrs and UNIX_WUSR) = 0 then
829 Result := Result + faReadOnly;
830 end;
831
ZipFatAttrsToUnixAttrsnull832 function ZipFatAttrsToUnixAttrs(Attrs: Longint): Longint;
833 begin
834 Result := UNIX_DEFAULT;
835 if (faReadOnly and Attrs) > 0 then
836 Result := Result and not (UNIX_WUSR);
837
838 if (faSymLink and Attrs) > 0 then
839 Result := Result or UNIX_LINK
840 else
841 if (faDirectory and Attrs) > 0 then
842 Result := Result or UNIX_DIR
843 else
844 Result := Result or UNIX_FILE;
845 end;
846
CRC32Strnull847 function CRC32Str(const s:string):DWord;
848 var
849 i:Integer;
850 begin
851 Result:=$FFFFFFFF;
852 if Length(S)>0 then
853 for i:=1 to Length(s) do
854 Result:=Crc_32_Tab[Byte(Result XOR LongInt(s[i]))] XOR ((Result SHR 8) AND $00FFFFFF);
855 Result:=not Result;
856 end;
857
858 { ---------------------------------------------------------------------
859 TDeCompressor
860 ---------------------------------------------------------------------}
861
862
863 Procedure TDeCompressor.UpdC32(Octet: Byte);
864
865 Begin
866 FCrc32Val := Crc_32_Tab[Byte(FCrc32Val XOR LongInt(Octet))] XOR ((FCrc32Val SHR 8) AND $00FFFFFF);
867 end;
868
869 constructor TDeCompressor.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
870 begin
871 FinFile:=AInFile;
872 FoutFile:=AOutFile;
873 FBufferSize:=ABufSize;
874 CRC32Val:=$FFFFFFFF;
875 end;
876
877 procedure TDeCompressor.Terminate;
878 begin
879 FTerminated:=True;
880 end;
881
882
883 { ---------------------------------------------------------------------
884 TCompressor
885 ---------------------------------------------------------------------}
886
887
888 Procedure TCompressor.UpdC32(Octet: Byte);
889
890 Begin
891 FCrc32Val := Crc_32_Tab[Byte(FCrc32Val XOR LongInt(Octet))] XOR ((FCrc32Val SHR 8) AND $00FFFFFF);
892 end;
893
894 constructor TCompressor.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
895 begin
896 FinFile:=AInFile;
897 FoutFile:=AOutFile;
898 FBufferSize:=ABufSize;
899 CRC32Val:=$FFFFFFFF;
900 end;
901
902 procedure TCompressor.Terminate;
903 begin
904 FTerminated:=True;
905 end;
906
907
908 { ---------------------------------------------------------------------
909 TDeflater
910 ---------------------------------------------------------------------}
911
912 constructor TDeflater.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
913 begin
914 Inherited;
915 FCompressionLevel:=clDefault;
916 end;
917
918
919 procedure TDeflater.Compress;
920 Var
921 Buf : PByte;
922 I,Count,NewCount : integer;
923 C : TCompressionStream;
924 BytesNow : Int64;
925 NextMark : Int64;
926 OnBytes : Int64;
927 FSize : Int64;
928 begin
929 CRC32Val:=$FFFFFFFF;
930 Buf:=GetMem(FBufferSize);
931 if FOnPercent = 0 then
932 FOnPercent := 1;
933 OnBytes:=Round((FInFile.Size * FOnPercent) / 100);
934 BytesNow:=0;
935 NextMark := OnBytes;
936 FSize:=FInfile.Size;
937 Try
938 C:=TCompressionStream.Create(FCompressionLevel,FOutFile,True);
939 Try
940 if assigned(FOnProgress) then
941 fOnProgress(self,0);
942 Repeat
943 Count:=FInFile.Read(Buf^,FBufferSize);
944 For I:=0 to Count-1 do
945 UpdC32(Buf[i]);
946 NewCount:=Count;
947 while (NewCount>0) do
948 NewCount:=NewCount-C.Write(Buf^,NewCount);
949 inc(BytesNow,Count);
950 if BytesNow>NextMark Then
951 begin
952 if (FSize>0) and assigned(FOnProgress) Then
953 FOnProgress(self,100 * ( BytesNow / FSize));
954 inc(NextMark,OnBytes);
955 end;
956 Until (Count=0) or Terminated;
957 Finally
958 C.Free;
959 end;
960 Finally
961 FreeMem(Buf);
962 end;
963 if assigned(FOnProgress) then
964 fOnProgress(self,100.0);
965 Crc32Val:=NOT Crc32Val;
966 end;
967
TDeflater.ZipIDnull968 class function TDeflater.ZipID: Word;
969 begin
970 Result:=8;
971 end;
972
TDeflater.ZipVersionReqdnull973 class function TDeflater.ZipVersionReqd: Word;
974 begin
975 Result:=20;
976 end;
977
TDeflater.ZipBitFlagnull978 function TDeflater.ZipBitFlag: Word;
979 begin
980 case CompressionLevel of
981 clnone: Result := %110;
982 clfastest: Result := %100;
983 cldefault: Result := %000;
984 clmax: Result := %010;
985 else
986 Result := 0;
987 end;
988 end;
989
990 { ---------------------------------------------------------------------
991 TInflater
992 ---------------------------------------------------------------------}
993
994 constructor TInflater.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
995 begin
996 Inherited;
997 end;
998
999
1000 procedure TInflater.DeCompress;
1001
1002 Var
1003 Buf : PByte;
1004 I,Count : Integer;
1005 C : TDeCompressionStream;
1006 BytesNow : Integer;
1007 NextMark : Integer;
1008 OnBytes : Integer;
1009 FSize : Integer;
1010
1011 begin
1012 CRC32Val:=$FFFFFFFF;
1013 if FOnPercent = 0 then
1014 FOnPercent := 1;
1015 OnBytes:=Round((FInFile.Size * FOnPercent) / 100);
1016 BytesNow:=0; NextMark := OnBytes;
1017 FSize:=FInfile.Size;
1018
1019 If Assigned(FOnProgress) then
1020 fOnProgress(self,0);
1021
1022 Buf:=GetMem(FBufferSize);
1023 Try
1024 C:=TDeCompressionStream.Create(FInFile,True);
1025 Try
1026 Repeat
1027 Count:=C.Read(Buf^,FBufferSize);
1028 For I:=0 to Count-1 do
1029 UpdC32(Buf[i]);
1030 FOutFile.Write(Buf^,Count);
1031 inc(BytesNow,Count);
1032 if BytesNow>NextMark Then
1033 begin
1034 if (FSize>0) and assigned(FOnProgress) Then
1035 FOnProgress(self,100 * ( BytesNow / FSize));
1036 if assigned(FOnProgressEx) Then
1037 FOnProgressEx(Self, FTotPos + BytesNow, FTotSize);
1038 inc(NextMark,OnBytes);
1039 end;
1040 Until (Count=0) or Terminated;
1041 FTotPos := FTotPos + FOutFile.Size;
1042 Finally
1043 C.Free;
1044 end;
1045 Finally
1046 FreeMem(Buf);
1047 end;
1048 if assigned(FOnProgress) then
1049 fOnProgress(self,100.0);
1050 if assigned(FOnProgressEx) then
1051 FOnProgressEx(Self, FTotPos, FTotSize);
1052 Crc32Val:=NOT Crc32Val;
1053 end;
1054
TInflater.ZipIDnull1055 class function TInflater.ZipID: Word;
1056 begin
1057 Result:=8;
1058 end;
1059
1060
1061 { ---------------------------------------------------------------------
1062 TShrinker
1063 ---------------------------------------------------------------------}
1064
1065 Const
1066 DefaultInMemSize = 256*1024; { Files larger than 256k are processed on disk }
1067 DefaultBufSize = 16384; { Use 16K file buffers }
1068 MINBITS = 9; { Starting code size of 9 bits }
1069 MAXBITS = 13; { Maximum code size of 13 bits }
1070 SPECIAL = 256; { Special function code }
1071 INCSIZE = 1; { Code indicating a jump in code size }
1072 CLEARCODE = 2; { Code indicating code table has been cleared }
1073 STDATTR = faAnyFile; { Standard file attribute for DOS Find First/Next }
1074
1075 constructor TShrinker.Create(AInFile, AOutFile : TStream; ABufSize : LongWord);
1076 begin
1077 Inherited;
1078 FBufSize:=ABufSize;
1079 InBuf:=GetMem(FBUFSIZE);
1080 OutBuf:=GetMem(FBUFSIZE);
1081 CodeTable:=GetMem(SizeOf(CodeTable^));
1082 FreeList:=GetMem(SizeOf(FreeList^));
1083 end;
1084
1085 destructor TShrinker.Destroy;
1086 begin
1087 FreeMem(CodeTable);
1088 FreeMem(FreeList);
1089 FreeMem(InBuf);
1090 FreeMem(OutBuf);
1091 inherited Destroy;
1092 end;
1093
1094 Procedure TShrinker.Compress;
1095
1096 Var
1097 OneString : String;
1098 Remaining : Word;
1099
1100 begin
1101 BytesIn := 1;
1102 BytesOut := 1;
1103 InitializeCodeTable;
1104 FillInputBuffer;
1105 FirstCh:= TRUE;
1106 Crc32Val:=$FFFFFFFF;
1107 FOnBytes:=Round((FInFile.Size * FOnPercent) / 100);
1108 While Not InputEof do
1109 begin
1110 Remaining:=Succ(MaxInBufIdx - InBufIdx);
1111 If Remaining>255 then
1112 Remaining:=255;
1113 If Remaining=0 then
1114 FillInputBuffer
1115 else
1116 begin
1117 SetLength(OneString,Remaining);
1118 Move(InBuf[InBufIdx], OneString[1], Remaining);
1119 Inc(InBufIdx, Remaining);
1120 ProcessLine(OneString);
1121 end;
1122 end;
1123 Crc32Val := Not Crc32Val;
1124 ProcessLine('');
1125 end;
1126
TShrinker.ZipIDnull1127 class function TShrinker.ZipID: Word;
1128 begin
1129 Result:=1;
1130 end;
1131
TShrinker.ZipVersionReqdnull1132 class function TShrinker.ZipVersionReqd: Word;
1133 begin
1134 Result:=10;
1135 end;
1136
TShrinker.ZipBitFlagnull1137 function TShrinker.ZipBitFlag: Word;
1138 begin
1139 Result:=0;
1140 end;
1141
1142
1143 Procedure TShrinker.DoOnProgress(Const Pct: Double);
1144
1145 begin
1146 If Assigned(FOnProgress) then
1147 FOnProgress(Self,Pct);
1148 end;
1149
1150
1151 Procedure TShrinker.FillInputBuffer;
1152
1153 Begin
1154 MaxInbufIDx:=FInfile.Read(InBuf[0], FBufSize);
1155 If MaxInbufIDx=0 then
1156 InputEof := TRUE
1157 else
1158 InputEOF := FALSE;
1159 InBufIdx := 0;
1160 end;
1161
1162
1163 Procedure TShrinker.WriteOutputBuffer;
1164 Begin
1165 FOutFile.WriteBuffer(OutBuf[0], OutBufIdx);
1166 OutBufIdx := 0;
1167 end;
1168
1169
1170 Procedure TShrinker.PutChar(B : Byte);
1171
1172 Begin
1173 OutBuf[OutBufIdx] := B;
1174 Inc(OutBufIdx);
1175 If OutBufIdx>=FBufSize then
1176 WriteOutputBuffer;
1177 Inc(BytesOut);
1178 end;
1179
1180 Procedure TShrinker.FlushOutput;
1181 Begin
1182 If OutBufIdx>0 then
1183 WriteOutputBuffer;
1184 End;
1185
1186
1187 procedure TShrinker.PutCode(Code : Smallint);
1188
1189 var
1190 ACode : LongInt;
1191 XSize : Smallint;
1192
1193 begin
1194 if (Code=-1) then
1195 begin
1196 if BitsUsed>0 then
1197 PutChar(SaveByte);
1198 end
1199 else
1200 begin
1201 ACode := Longint(Code);
1202 XSize := CodeSize+BitsUsed;
1203 ACode := (ACode shl BitsUsed) or SaveByte;
1204 while (XSize div 8) > 0 do
1205 begin
1206 PutChar(Lo(ACode));
1207 ACode := ACode shr 8;
1208 Dec(XSize,8);
1209 end;
1210 BitsUsed := XSize;
1211 SaveByte := Lo(ACode);
1212 end;
1213 end;
1214
1215
1216 Procedure TShrinker.InitializeCodeTable;
1217
1218 Var
1219 I : Word;
1220 Begin
1221 For I := 0 to TableSize do
1222 begin
1223 With CodeTable^[I] do
1224 begin
1225 Child := -1;
1226 Sibling := -1;
1227 If (I<=255) then
1228 Suffix := I;
1229 end;
1230 If (I>=257) then
1231 FreeList^[I] := I;
1232 end;
1233 NextFree := FIRSTENTRY;
1234 TableFull := FALSE;
1235 end;
1236
1237
1238 Procedure TShrinker.Prune(Parent : Word);
1239
1240 Var
1241 CurrChild : Smallint;
1242 NextSibling : Smallint;
1243 Begin
1244 CurrChild := CodeTable^[Parent].Child;
1245 { Find first Child that has descendants .. clear any that don't }
1246 While (CurrChild <> -1) and (CodeTable^[CurrChild].Child = -1) do
1247 begin
1248 CodeTable^[Parent].Child := CodeTable^[CurrChild].Sibling;
1249 CodeTable^[CurrChild].Sibling := -1;
1250 { Turn on ClearList bit to indicate a cleared entry }
1251 ClearList[CurrChild DIV 8] := (ClearList[CurrChild DIV 8] OR (1 SHL (CurrChild MOD 8)));
1252 CurrChild := CodeTable^[Parent].Child;
1253 end;
1254 If CurrChild <> -1 then
1255 begin { If there are any children left ...}
1256 Prune(CurrChild);
1257 NextSibling := CodeTable^[CurrChild].Sibling;
1258 While NextSibling <> -1 do
1259 begin
1260 If CodeTable^[NextSibling].Child = -1 then
1261 begin
1262 CodeTable^[CurrChild].Sibling := CodeTable^[NextSibling].Sibling;
1263 CodeTable^[NextSibling].Sibling := -1;
1264 { Turn on ClearList bit to indicate a cleared entry }
1265 ClearList[NextSibling DIV 8] := (ClearList[NextSibling DIV 8] OR (1 SHL (NextSibling MOD 8)));
1266 NextSibling := CodeTable^[CurrChild].Sibling;
1267 end
1268 else
1269 begin
1270 CurrChild := NextSibling;
1271 Prune(CurrChild);
1272 NextSibling := CodeTable^[CurrChild].Sibling;
1273 end;
1274 end;
1275 end;
1276 end;
1277
1278
1279 Procedure TShrinker.Clear_Table;
1280 Var
1281 Node : Word;
1282 Begin
1283 FillChar(ClearList, SizeOf(ClearList), $00);
1284 For Node := 0 to 255 do
1285 Prune(Node);
1286 NextFree := Succ(TABLESIZE);
1287 For Node := TABLESIZE downto FIRSTENTRY do
1288 begin
1289 If (ClearList[Node DIV 8] AND (1 SHL (Node MOD 8))) <> 0 then
1290 begin
1291 Dec(NextFree);
1292 FreeList^[NextFree] := Node;
1293 end;
1294 end;
1295 If NextFree <= TABLESIZE then
1296 TableFull := FALSE;
1297 end;
1298
1299
1300 Procedure TShrinker.Table_Add(Prefix : Word; Suffix : Byte);
1301 Var
1302 FreeNode : Word;
1303 Begin
1304 If NextFree <= TABLESIZE then
1305 begin
1306 FreeNode := FreeList^[NextFree];
1307 Inc(NextFree);
1308 CodeTable^[FreeNode].Child := -1;
1309 CodeTable^[FreeNode].Sibling := -1;
1310 CodeTable^[FreeNode].Suffix := Suffix;
1311 If CodeTable^[Prefix].Child = -1 then
1312 CodeTable^[Prefix].Child := FreeNode
1313 else
1314 begin
1315 Prefix := CodeTable^[Prefix].Child;
1316 While CodeTable^[Prefix].Sibling <> -1 do
1317 Prefix := CodeTable^[Prefix].Sibling;
1318 CodeTable^[Prefix].Sibling := FreeNode;
1319 end;
1320 end;
1321 if NextFree > TABLESIZE then
1322 TableFull := TRUE;
1323 end;
1324
TShrinker.Table_Lookupnull1325 function TShrinker.Table_Lookup( TargetPrefix : Smallint;
1326 TargetSuffix : Byte;
1327 Out FoundAt : Smallint ) : Boolean;
1328
1329 var TempPrefix : Smallint;
1330
1331 begin
1332 TempPrefix := TargetPrefix;
1333 Table_lookup := False;
1334 if CodeTable^[TempPrefix].Child <> -1 then
1335 begin
1336 TempPrefix := CodeTable^[TempPrefix].Child;
1337 repeat
1338 if CodeTable^[TempPrefix].Suffix = TargetSuffix then
1339 begin
1340 Table_lookup := True;
1341 break;
1342 end;
1343 if CodeTable^[TempPrefix].Sibling = -1 then
1344 break;
1345 TempPrefix := CodeTable^[TempPrefix].Sibling;
1346 until False;
1347 end;
1348 if Table_Lookup then
1349 FoundAt := TempPrefix
1350 else
1351 FoundAt := -1;
1352 end;
1353
1354 Procedure TShrinker.Shrink(Suffix : Smallint);
1355
1356 Const
1357 LastCode : Smallint = 0;
1358
1359 Var
1360 WhereFound : Smallint;
1361
1362 Begin
1363 If FirstCh then
1364 begin
1365 SaveByte := $00;
1366 BitsUsed := 0;
1367 CodeSize := MINBITS;
1368 MaxCode := (1 SHL CodeSize) - 1;
1369 LastCode := Suffix;
1370 FirstCh := FALSE;
1371 end
1372 else
1373 begin
1374 If Suffix <> -1 then
1375 begin
1376 If TableFull then
1377 begin
1378 Putcode(LastCode);
1379 PutCode(SPECIAL);
1380 Putcode(CLEARCODE);
1381 Clear_Table;
1382 Table_Add(LastCode, Suffix);
1383 LastCode := Suffix;
1384 end
1385 else
1386 begin
1387 If Table_Lookup(LastCode, Suffix, WhereFound) then
1388 begin
1389 LastCode := WhereFound;
1390 end
1391 else
1392 begin
1393 PutCode(LastCode);
1394 Table_Add(LastCode, Suffix);
1395 LastCode := Suffix;
1396 If (FreeList^[NextFree] > MaxCode) and (CodeSize < MaxBits) then
1397 begin
1398 PutCode(SPECIAL);
1399 PutCode(INCSIZE);
1400 Inc(CodeSize);
1401 MaxCode := (1 SHL CodeSize) -1;
1402 end;
1403 end;
1404 end;
1405 end
1406 else
1407 begin
1408 PutCode(LastCode);
1409 PutCode(-1);
1410 FlushOutput;
1411 end;
1412 end;
1413 end;
1414
1415 Procedure TShrinker.ProcessLine(Const Source : String);
1416
1417 Var
1418 I : Word;
1419
1420 Begin
1421 If Source = '' then
1422 Shrink(-1)
1423 else
1424 For I := 1 to Length(Source) do
1425 begin
1426 Inc(BytesIn);
1427 If (Pred(BytesIn) MOD FOnBytes) = 0 then
1428 DoOnProgress(100 * ( BytesIn / FInFile.Size));
1429 UpdC32(Ord(Source[I]));
1430 Shrink(Ord(Source[I]));
1431 end;
1432 end;
1433
1434 { ---------------------------------------------------------------------
1435 TZipper
1436 ---------------------------------------------------------------------}
1437
1438
1439 Procedure TZipper.GetFileInfo;
1440
1441 Var
1442 F : TZipFileEntry;
1443 Info : TSearchRec;
1444 I : integer; //zip spec allows QWord but FEntries.Count does not support it
1445 {$IFDEF UNIX}
1446 UnixInfo: Stat;
1447 {$ENDIF}
1448 Begin
1449 For I := 0 to FEntries.Count-1 do
1450 begin
1451 F:=FEntries[i];
1452 If F.Stream=Nil then
1453 begin
1454 If (F.DiskFileName='') then
1455 Raise EZipError.CreateFmt(SErrMissingFileName,[I]);
1456 If FindFirst(F.DiskFileName, STDATTR, Info)=0 then
1457 try
1458 F.Size:=Info.Size;
1459 F.DateTime:=FileDateToDateTime(Info.Time);
1460 {$IFDEF UNIX}
1461 if fplstat(F.DiskFileName, @UnixInfo) = 0 then
1462 F.Attributes := UnixInfo.st_mode;
1463 {$ELSE}
1464 F.Attributes := Info.Attr;
1465 {$ENDIF}
1466 finally
1467 FindClose(Info);
1468 end
1469 else
1470 Raise EZipError.CreateFmt(SErrFileDoesNotExist,[F.DiskFileName]);
1471 end
1472 else
1473 begin
1474 If (F.ArchiveFileName='') then
1475 Raise EZipError.CreateFmt(SErrMissingArchiveName,[I]);
1476 F.Size:=F.Stream.Size;
1477 if (F.Attributes = 0) then
1478 begin
1479 {$IFDEF UNIX}
1480 F.Attributes := UNIX_FILE or UNIX_DEFAULT;
1481 {$ELSE}
1482 F.Attributes := faArchive;
1483 {$ENDIF}
1484 end;
1485 end;
1486 end;
1487 end;
1488
1489
1490 procedure TZipper.SetEntries(const AValue: TZipFileEntries);
1491 begin
1492 if FEntries=AValue then exit;
1493 FEntries.Assign(AValue);
1494 end;
1495
TZipper.OpenInputnull1496 Function TZipper.OpenInput(Item : TZipFileEntry) : Boolean;
1497
1498 Begin
1499 If (Item.Stream<>nil) then
1500 FInFile:=Item.Stream
1501 else
1502 if Item.IsDirectory then
1503 FInFile := TStringStream.Create('')
1504 else
1505 FInFile:=TFileStream.Create(Item.DiskFileName,fmOpenRead);
1506 Result:=True;
1507 If Assigned(FOnStartFile) then
1508 FOnStartFile(Self,Item.ArchiveFileName);
1509 End;
1510
1511
1512 Procedure TZipper.CloseInput(Item : TZipFileEntry);
1513
1514 Begin
1515 If (FInFile<>Item.Stream) then
1516 FreeAndNil(FInFile)
1517 else
1518 FinFile:=Nil;
1519 DoEndOfFile;
1520 end;
1521
1522
1523 Procedure TZipper.StartZipFile(Item : TZipFileEntry);
1524
1525 Begin
1526 FillChar(LocalHdr,SizeOf(LocalHdr),0);
1527 FillChar(LocalZip64Fld,SizeOf(LocalZip64Fld),0);
1528 With LocalHdr do
1529 begin
1530 Signature := LOCAL_FILE_HEADER_SIGNATURE;
1531 Extract_Version_Reqd := 20; //default value, v2.0
1532 Bit_Flag := 0;
1533 Compress_Method := 1;
1534 DateTimeToZipDateTime(Item.DateTime,Last_Mod_Date,Last_Mod_Time);
1535 Crc32 := 0;
1536 Compressed_Size := 0;
1537 LocalZip64Fld.Compressed_Size := 0;
1538 if Item.Size >= $FFFFFFFF then
1539 begin
1540 Uncompressed_Size := $FFFFFFFF;
1541 LocalZip64Fld.Original_Size := Item.Size;
1542 end
1543 else
1544 begin
1545 Uncompressed_Size := Item.Size;
1546 LocalZip64Fld.Original_Size := 0;
1547 end;
1548 FileName_Length := 0;
1549 if (LocalZip64Fld.Original_Size>0) or
1550 (LocalZip64Fld.Compressed_Size>0) or
1551 (LocalZip64Fld.Disk_Start_Number>0) or
1552 (LocalZip64Fld.Relative_Hdr_Offset>0) then
1553 Extra_Field_Length := SizeOf(LocalZip64ExtHdr) + SizeOf(LocalZip64Fld)
1554 else
1555 Extra_Field_Length := 0;
1556 end;
1557 End;
1558
1559
TZipper.UpdateZipHeadernull1560 function TZipper.UpdateZipHeader(Item: TZipFileEntry; FZip: TStream;
1561 ACRC: LongWord; AMethod: Word; AZipVersionReqd: Word; AZipBitFlag: Word
1562 ): Boolean;
1563 // Update header for a single zip file (local header)
1564 var
1565 IsZip64 : boolean; //Must the local header be in zip64 format?
1566 // Separate from zip64 status of entire zip file.
1567 ZFileName : String;
1568 Begin
1569 ZFileName := Item.ArchiveFileName;
1570 IsZip64 := false;
1571 With LocalHdr do
1572 begin
1573 FileName_Length := Length(ZFileName);
1574 Crc32 := ACRC;
1575 if LocalZip64Fld.Original_Size > 0 then
1576 Result := Not (FZip.Size >= LocalZip64Fld.Original_Size)
1577 else
1578 Result := Not (Compressed_Size >= Uncompressed_Size);
1579 if Item.CompressionLevel=clNone
1580 then Result:=false; //user wishes override or invalid compression
1581 If Not Result then
1582 begin
1583 Compress_Method := 0; // No use for compression: change storage type & compression size...
1584 if LocalZip64Fld.Original_Size>0 then
1585 begin
1586 IsZip64 := true;
1587 Compressed_Size := $FFFFFFFF;
1588 LocalZip64Fld.Compressed_Size := LocalZip64Fld.Original_Size;
1589 end
1590 else
1591 begin
1592 Compressed_Size := Uncompressed_Size;
1593 LocalZip64Fld.Compressed_Size := 0;
1594 end;
1595 end
1596 else { Using compression }
1597 begin
1598 Compress_method := AMethod;
1599 Bit_Flag := Bit_Flag or AZipBitFlag;
1600 if FZip.Size >= $FFFFFFFF then
1601 begin
1602 IsZip64 := true;
1603 Compressed_Size := $FFFFFFFF;
1604 LocalZip64Fld.Compressed_Size := FZip.Size;
1605 end
1606 else
1607 begin
1608 Compressed_Size := FZip.Size;
1609 LocalZip64Fld.Compressed_Size := 0;
1610 end;
1611 if AZipVersionReqd > Extract_Version_Reqd then
1612 Extract_Version_Reqd := AZipVersionReqd;
1613 end;
1614 if (IsZip64) and (Extract_Version_Reqd<45) then
1615 Extract_Version_Reqd := 45;
1616 end;
1617 if IsZip64 then
1618 LocalHdr.Extra_Field_Length:=SizeOf(LocalZip64ExtHdr)+SizeOf(LocalZip64Fld);
1619 FOutStream.WriteBuffer({$IFDEF ENDIAN_BIG}SwapLFH{$ENDIF}(LocalHdr),SizeOf(LocalHdr));
1620 // Append extensible field header+zip64 extensible field if needed:
1621 FOutStream.WriteBuffer(ZFileName[1],Length(ZFileName));
1622 if IsZip64 then
1623 begin
1624 LocalZip64ExtHdr.Header_ID:=ZIP64_HEADER_ID;
1625 FOutStream.WriteBuffer({$IFDEF ENDIAN_BIG}SwapEDFH{$ENDIF}(LocalZip64ExtHdr),SizeOf(LocalZip64ExtHdr));
1626 FOutStream.WriteBuffer({$IFDEF ENDIAN_BIG}SwapZ64EIF{$ENDIF}(LocalZip64Fld),SizeOf(LocalZip64Fld));
1627 end;
1628 End;
1629
1630
1631 Procedure TZipper.BuildZipDirectory;
1632 // Write out all central file headers using info from local headers
1633 Var
1634 SavePos : Int64;
1635 HdrPos : Int64; //offset from disk where file begins to local header
1636 CenDirPos : Int64;
1637 ACount : QWord; //entry counter
1638 ZFileName : string; //archive filename
1639 IsZip64 : boolean; //local header=zip64 format?
1640 MinReqdVersion: word; //minimum needed to extract
1641 ExtInfoHeader : Extensible_Data_Field_Header_Type;
1642 Zip64ECD : Zip64_End_of_Central_Dir_type;
1643 Zip64ECDL : Zip64_End_of_Central_Dir_Locator_type;
1644 Begin
1645 ACount := 0;
1646 MinReqdVersion:=0;
1647 CenDirPos := FOutStream.Position;
1648 FOutStream.Seek(0,soBeginning); { Rewind output file }
1649 HdrPos := FOutStream.Position;
1650 FOutStream.ReadBuffer(LocalHdr, SizeOf(LocalHdr));
1651 {$IFDEF FPC_BIG_ENDIAN}
1652 LocalHdr := SwapLFH(LocalHdr);
1653 {$ENDIF}
1654 Repeat
1655 SetLength(ZFileName,LocalHdr.FileName_Length);
1656 FOutStream.ReadBuffer(ZFileName[1], LocalHdr.FileName_Length);
1657 IsZip64:=(LocalHdr.Compressed_Size=$FFFFFFFF) or (LocalHdr.Uncompressed_Size=$FFFFFFFF) or (HdrPos>=$FFFFFFFF);
1658 FillChar(LocalZip64Fld,SizeOf(LocalZip64Fld),0); // easier to check compressed length
1659 if LocalHdr.Extra_Field_Length>0 then
1660 begin
1661 SavePos := FOutStream.Position;
1662 if (IsZip64 and (LocalHdr.Extra_Field_Length>=SizeOf(LocalZip64ExtHdr)+SizeOf(LocalZip64Fld))) then
1663 while FOutStream.Position<SavePos+LocalHdr.Extra_Field_Length do
1664 begin
1665 FOutStream.ReadBuffer(ExtInfoHeader, SizeOf(ExtInfoHeader));
1666 {$IFDEF FPC_BIG_ENDIAN}
1667 ExtInfoHeader := SwapEDFH(ExtInfoHeader);
1668 {$ENDIF}
1669 if ExtInfoHeader.Header_ID=ZIP64_HEADER_ID then
1670 begin
1671 FOutStream.ReadBuffer(LocalZip64Fld, SizeOf(LocalZip64Fld));
1672 {$IFDEF FPC_BIG_ENDIAN}
1673 LocalZip64Fld := SwapZ64EIF(LocalZip64Fld);
1674 {$ENDIF}
1675 end
1676 else
1677 begin
1678 // Read past non-zip64 extra field
1679 FOutStream.Seek(ExtInfoHeader.Data_Size,soFromCurrent);
1680 end;
1681 end;
1682 // Move past extra fields
1683 FOutStream.Seek(SavePos+LocalHdr.Extra_Field_Length,soFromBeginning);
1684 end;
1685 SavePos := FOutStream.Position;
1686 FillChar(CentralHdr,SizeOf(CentralHdr),0);
1687 With CentralHdr do
1688 begin
1689 Signature := CENTRAL_FILE_HEADER_SIGNATURE;
1690 MadeBy_Version := LocalHdr.Extract_Version_Reqd;
1691 if (IsZip64) and (MadeBy_Version<45) then
1692 MadeBy_Version := 45;
1693 {$IFDEF UNIX}
1694 {$IFDEF DARWIN} //OSX
1695 MadeBy_Version := MadeBy_Version or (OS_OSX shl 8);
1696 {$ELSE}
1697 MadeBy_Version := MadeBy_Version or (OS_UNIX shl 8);
1698 {$ENDIF}
1699 {$ENDIF}
1700 {$IFDEF OS2}
1701 MadeBy_Version := MadeBy_Version or (OS_OS2 shl 8);
1702 {$ENDIF}
1703 {$warning TODO: find a way to recognize VFAT and NTFS}
1704 // Copy over extract_version_reqd..extra_field_length
1705 Move(LocalHdr.Extract_Version_Reqd, Extract_Version_Reqd, 26);
1706 if (IsZip64) and (Extract_Version_Reqd<45) then
1707 Extract_Version_Reqd := 45;
1708 // Keep track of the minimum version required to extract
1709 // zip file as a whole
1710 if Extract_Version_Reqd>MinReqdVersion then
1711 MinReqdVersion:=Extract_Version_Reqd;
1712 Last_Mod_Time:=localHdr.Last_Mod_Time;
1713 Last_Mod_Date:=localHdr.Last_Mod_Date;
1714 File_Comment_Length := 0;
1715 Starting_Disk_Num := 0;
1716 Internal_Attributes := 0;
1717 {$IFDEF UNIX}
1718 External_Attributes := Entries[ACount].Attributes shl 16;
1719 {$ELSE}
1720 External_Attributes := Entries[ACount].Attributes;
1721 {$ENDIF}
1722 if HdrPos>=$FFFFFFFF then
1723 begin
1724 FZipFileNeedsZip64:=true;
1725 IsZip64:=true;
1726 Local_Header_offset := $FFFFFFFF;
1727 // LocalZip64Fld will be written out as central dir extra field later
1728 LocalZip64Fld.Relative_Hdr_Offset := HdrPos;
1729 end
1730 else
1731 Local_Header_Offset := HdrPos;
1732 end;
1733 FOutStream.Seek(0,soEnd);
1734 FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapCFH{$ENDIF}(CentralHdr),SizeOf(CentralHdr));
1735 FOutStream.WriteBuffer(ZFileName[1],Length(ZFileName));
1736 if IsZip64 then
1737 begin
1738 FOutStream.Seek(0,soEnd);
1739 FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapEDFH{$ENDIF}(LocalZip64ExtHdr),SizeOf(LocalZip64ExtHdr));
1740 FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapZ64EIF{$ENDIF}(LocalZip64Fld),SizeOf(LocalZip64Fld));
1741 end;
1742
1743 Inc(ACount);
1744 // Move past compressed file data to next header:
1745 if Iszip64 then
1746 FOutStream.Seek(SavePos + LocalZip64Fld.Compressed_Size,soBeginning)
1747 else
1748 FOutStream.Seek(SavePos + LocalHdr.Compressed_Size,soBeginning);
1749 HdrPos:=FOutStream.Position;
1750 FOutStream.ReadBuffer(LocalHdr, SizeOf(LocalHdr));
1751 {$IFDEF FPC_BIG_ENDIAN}
1752 LocalHdr := SwapLFH(LocalHdr);
1753 {$ENDIF}
1754 Until LocalHdr.Signature = CENTRAL_FILE_HEADER_SIGNATURE ;
1755
1756 FOutStream.Seek(0,soEnd);
1757 FillChar(EndHdr,SizeOf(EndHdr),0);
1758
1759 // Write end of central directory record
1760 // We'll use the zip64 variants to store counts etc
1761 // and copy to the old record variables if possible
1762 // This seems to match expected behaviour of unzippers like
1763 // unrar that only look at the zip64 record
1764 FillChar(Zip64ECD, SizeOf(Zip64ECD), 0);
1765 Zip64ECD.Signature:=ZIP64_END_OF_CENTRAL_DIR_SIGNATURE;
1766 FillChar(Zip64ECDL, SizeOf(Zip64ECDL), 0);
1767 Zip64ECDL.Signature:=ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIGNATURE;
1768 Zip64ECDL.Total_Disks:=1; //default and no support for multi disks yet anyway
1769 With EndHdr do
1770 begin
1771 Signature := END_OF_CENTRAL_DIR_SIGNATURE;
1772 Disk_Number := 0;
1773 Central_Dir_Start_Disk := 0;
1774
1775 Zip64ECD.Entries_This_Disk:=ACount;
1776 Zip64ECD.Total_Entries:=Acount;
1777 if ACount>$FFFF then
1778 begin
1779 FZipFileNeedsZip64 := true;
1780 Entries_This_Disk := $FFFF;
1781 Total_Entries := $FFFF;
1782 end
1783 else
1784 begin
1785 Entries_This_Disk := Zip64ECD.Entries_This_Disk;
1786 Total_Entries := Zip64ECD.Total_Entries;
1787 end;
1788
1789 Zip64ECD.Central_Dir_Size := FOutStream.Size-CenDirPos;
1790 if (Zip64ECD.Central_Dir_Size)>$FFFFFFFF then
1791 begin
1792 FZipFileNeedsZip64 := true;
1793 Central_Dir_Size := $FFFFFFFF;
1794 end
1795 else
1796 begin
1797 Central_Dir_Size := Zip64ECD.Central_Dir_Size;
1798 end;
1799
1800 Zip64ECD.Start_Disk_Offset := CenDirPos;
1801 if Zip64ECD.Start_Disk_Offset>$FFFFFFFF then
1802 begin
1803 FZipFileNeedsZip64 := true;
1804 Start_Disk_Offset := $FFFFFFFF;
1805 end
1806 else
1807 begin
1808 Start_Disk_Offset := Zip64ECD.Start_Disk_Offset;
1809 end;
1810
1811 ZipFile_Comment_Length := Length(FFileComment);
1812
1813 if FZipFileNeedsZip64 then
1814 begin
1815 //Write zip64 end of central directory record if needed
1816 if MinReqdVersion<45 then
1817 MinReqdVersion := 45;
1818 Zip64ECD.Extract_Version_Reqd := MinReqdVersion;
1819 Zip64ECD.Version_Made_By := MinReqdVersion;
1820 Zip64ECD.Record_Size := SizeOf(Zip64ECD)-12; //Assumes no variable length field following
1821 Zip64ECDL.Central_Dir_Zip64_EOCD_Offset := FOutStream.Position;
1822 Zip64ECDL.Zip64_EOCD_Start_Disk := 0;
1823 FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapZ64ECD{$ENDIF}(Zip64ECD), SizeOf(Zip64ECD));
1824
1825 //Write zip64 end of central directory locator if needed
1826 FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapZ64ECDL{$ENDIF}(Zip64ECDL), SizeOf(Zip64ECDL));
1827 end;
1828
1829 FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapECD{$ENDIF}(EndHdr), SizeOf(EndHdr));
1830 if Length(FFileComment) > 0 then
1831 FOutStream.WriteBuffer(FFileComment[1],Length(FFileComment));
1832 end;
1833 end;
1834
1835 Function TZipper.CreateCompressor(Item : TZipFileEntry; AInFile,AZipStream : TStream) : TCompressor;
1836
1837 begin
1838 Result:=TDeflater.Create(AinFile,AZipStream,FBufSize);
1839 (Result as TDeflater).CompressionLevel:=Item.CompressionLevel;
1840 FCurrentCompressor:=Result;
1841 end;
1842
1843 Procedure TZipper.ZipOneFile(Item : TZipFileEntry);
1844
1845 Var
1846 CRC : LongWord;
1847 ZMethod : Word;
1848 ZVersionReqd : Word;
1849 ZBitFlag : Word;
1850 ZipStream : TStream;
1851 TmpFileName : String;
1852
1853 Begin
1854 OpenInput(Item);
1855 Try
1856 StartZipFile(Item);
1857 If (FInfile.Size<=FInMemSize) then
1858 ZipStream:=TMemoryStream.Create
1859 else
1860 begin
1861 TmpFileName:=ChangeFileExt(FFileName,'.tmp');
1862 if TmpFileName=FFileName then
1863 TmpFileName:=TmpFileName+'.tmp';
1864 ZipStream:=TFileStream.Create(TmpFileName,fmCreate);
1865 end;
1866 Try
1867 With CreateCompressor(Item, FinFile,ZipStream) do
1868 Try
1869 OnProgress:=Self.OnProgress;
1870 OnPercent:=Self.OnPercent;
1871 Compress;
1872 CRC:=Crc32Val;
1873 ZMethod:=ZipID;
1874 ZVersionReqd:=ZipVersionReqd;
1875 ZBitFlag:=ZipBitFlag;
1876 Finally
1877 FCurrentCompressor:=Nil;
1878 Free;
1879 end;
1880 If UpdateZipHeader(Item,ZipStream,CRC,ZMethod,ZVersionReqd,ZBitFlag) then
1881 // Compressed file smaller than original file.
1882 FOutStream.CopyFrom(ZipStream,0)
1883 else
1884 begin
1885 // Original file smaller than compressed file.
1886 FInfile.Seek(0,soBeginning);
1887 FOutStream.CopyFrom(FInFile,0);
1888 end;
1889 finally
1890 ZipStream.Free;
1891 If (TmpFileName<>'') then
1892 DeleteFile(TmpFileName);
1893 end;
1894 Finally
1895 CloseInput(Item);
1896 end;
1897 end;
1898
1899 // Just like SaveToFile, but uses the FileName property
1900 Procedure TZipper.ZipAllFiles;
1901 begin
1902 SaveToFile(FileName);
1903 end;
1904
1905 procedure TZipper.SaveToFile(AFileName: RawByteString);
1906 var
1907 lStream: TFileStream;
1908 begin
1909 FFileName:=AFileName;
1910 lStream:=TFileStream.Create(FFileName,fmCreate);
1911 try
1912 SaveToStream(lStream);
1913 finally
1914 FreeAndNil(lStream);
1915 end;
1916 end;
1917
1918 procedure TZipper.SaveToStream(AStream: TStream);
1919 Var
1920 I : integer; //could be qword but limited by FEntries.Count
1921 begin
1922 FTerminated:=False;
1923 FOutStream := AStream;
1924 If CheckEntries=0 then
1925 Exit;
1926 FZipping:=True;
1927 Try
1928 GetFileInfo; //get info on file entries in zip
1929 I:=0;
1930 While (I<FEntries.Count) and not Terminated do
1931 begin
1932 ZipOneFile(FEntries[i]);
1933 Inc(I);
1934 end;
1935 if (FEntries.Count>0) and not Terminated then
1936 BuildZipDirectory;
1937 finally
1938 FZipping:=False;
1939 // Remove entries that have been added by CheckEntries from Files.
1940 for I:=0 to FFiles.Count-1 do
1941 FEntries.Delete(FEntries.Count-1);
1942 end;
1943 end;
1944
1945
1946 Procedure TZipper.SetBufSize(Value : LongWord);
1947
1948 begin
1949 If FZipping then
1950 Raise EZipError.Create(SErrBufsizeChange);
1951 If Value>=DefaultBufSize then
1952 FBufSize:=Value;
1953 end;
1954
1955 Procedure TZipper.SetFileName(Value : RawByteString);
1956
1957 begin
1958 If FZipping then
1959 Raise EZipError.Create(SErrFileChange);
1960 FFileName:=Value;
1961 end;
1962
1963 Procedure TZipper.ZipFiles(AFileName : RawByteString; FileList : TStrings);
1964
1965 begin
1966 FFileName:=AFileName;
1967 ZipFiles(FileList);
1968 end;
1969
1970 procedure TZipper.ZipFiles(FileList: TStrings);
1971 begin
1972 FFiles.Assign(FileList);
1973 ZipAllFiles;
1974 end;
1975
1976 procedure TZipper.ZipFiles(AFileName: RawByteString; Entries: TZipFileEntries);
1977 begin
1978 FFileName:=AFileName;
1979 ZipFiles(Entries);
1980 end;
1981
1982 procedure TZipper.ZipFiles(Entries: TZipFileEntries);
1983 begin
1984 FEntries.Assign(Entries);
1985 ZipAllFiles;
1986 end;
1987
1988 Procedure TZipper.DoEndOfFile;
1989
1990 Var
1991 ComprPct : Double;
1992
1993 begin
1994 if (FZipFileNeedsZip64) and (LocalZip64Fld.Original_Size>0) then
1995 ComprPct := (100.0 * (LocalZip64Fld.Original_size - LocalZip64Fld.Compressed_Size)) / LocalZip64Fld.Original_Size
1996 else if (LocalHdr.Uncompressed_Size>0) then
1997 ComprPct := (100.0 * (LocalHdr.Uncompressed_Size - LocalHdr.Compressed_Size)) / LocalHdr.Uncompressed_Size
1998 else
1999 ComprPct := 0;
2000 If Assigned(FOnEndOfFile) then
2001 FOnEndOfFile(Self,ComprPct);
2002 end;
2003
2004 Constructor TZipper.Create;
2005
2006 begin
2007 FBufSize:=DefaultBufSize;
2008 FInMemSize:=DefaultInMemSize;
2009 FFiles:=TStringList.Create;
2010 FEntries:=TZipFileEntries.Create(TZipFileEntry);
2011 FOnPercent:=1;
2012 FZipFileNeedsZip64:=false;
2013 LocalZip64ExtHdr.Header_ID:=ZIP64_HEADER_ID;
2014 LocalZip64ExtHdr.Data_Size:=SizeOf(Zip64_Extended_Info_Field_Type);
2015 end;
2016
2017 Function TZipper.CheckEntries : Integer;
2018
2019 Var
2020 I : integer; //Could be QWord but limited by FFiles.Count
2021
2022 begin
2023 for I:=0 to FFiles.Count-1 do
2024 FEntries.AddFileEntry(FFiles[i]);
2025
2026 // Use zip64 when number of file entries
2027 // or individual (un)compressed sizes
2028 // require it.
2029 if FEntries.Count >= $FFFF then
2030 FZipFileNeedsZip64:=true;
2031
2032 if not(FZipFileNeedsZip64) then
2033 begin
2034 for I:=0 to FFiles.Count-1 do
2035 begin
2036 if FEntries[i].FNeedsZip64 then
2037 begin
2038 FZipFileNeedsZip64:=true;
2039 break;
2040 end;
2041 end;
2042 end;
2043
2044 Result:=FEntries.Count;
2045 end;
2046
2047
2048 Procedure TZipper.Clear;
2049
2050 begin
2051 FEntries.Clear;
2052 FFiles.Clear;
2053 end;
2054
2055 procedure TZipper.Terminate;
2056 begin
2057 FTerminated:=True;
2058 if Assigned(FCurrentCompressor) then
2059 FCurrentCompressor.Terminate;
2060 end;
2061
2062 Destructor TZipper.Destroy;
2063
2064 begin
2065 Clear;
2066 FreeAndNil(FEntries);
2067 FreeAndNil(FFiles);
2068 Inherited;
2069 end;
2070
2071 { ---------------------------------------------------------------------
2072 TUnZipper
2073 ---------------------------------------------------------------------}
2074
2075 procedure TUnZipper.OpenInput;
2076
2077 Begin
2078 if Assigned(FOnOpenInputStream) then
2079 FOnOpenInputStream(Self, FZipStream);
2080 if FZipStream = nil then
2081 FZipStream:=TFileStream.Create(FFileName,fmOpenRead or fmShareDenyWrite);
2082 End;
2083
2084
OpenOutputnull2085 function TUnZipper.OpenOutput(OutFileName: RawByteString;
2086 out OutStream: TStream; Item: TFullZipFileEntry): Boolean;
2087 Var
2088 Path: RawByteString;
2089 OldDirectorySeparators: set of char;
2090
2091 Begin
2092 { the default RTL behavior is broken on Unix platforms
2093 for Windows compatibility: it allows both '/' and '\'
2094 as directory separator. We don't want that behavior
2095 here, since 'abc\' is a valid file name under Unix.
2096
2097 The zip standard appnote.txt says zip files must have '/' as path
2098 separator, even on Windows: 4.4.17.1:
2099 "The path stored MUST not contain a drive or device letter, or a leading
2100 slash. All slashes MUST be forward slashes '/' as opposed to backwards
2101 slashes '\'" See also mantis issue #15836
2102 However, old versions of FPC on Windows (and possibly other utilities)
2103 created incorrect zip files with \ separator, so accept these as well as
2104 they're not valid in Windows file names anyway.
2105 }
2106 OldDirectorySeparators:=AllowDirectorySeparators;
2107 {$ifdef Windows}
2108 // Explicitly allow / and \ regardless of what Windows supports
2109 AllowDirectorySeparators:=['\','/'];
2110 {$else}
2111 // Follow the standard: only allow / regardless of actual separator on OS
2112 AllowDirectorySeparators:=['/'];
2113 {$endif}
2114 Path:=ExtractFilePath(OutFileName);
2115 OutStream:=Nil;
2116 If Assigned(FOnCreateStream) then
2117 FOnCreateStream(Self, OutStream, Item);
2118 // If FOnCreateStream didn't create one, we create one now.
2119 If (OutStream=Nil) then
2120 begin
2121 if (Path<>'') then
2122 ForceDirectories(Path);
2123 AllowDirectorySeparators:=OldDirectorySeparators;
2124 OutStream:=TFileStream.Create(OutFileName,fmCreate);
2125
2126 end;
2127
2128 AllowDirectorySeparators:=OldDirectorySeparators;
2129 Result:=True;
2130 If Assigned(FOnStartFile) then
2131 FOnStartFile(Self,OutFileName);
2132 End;
2133
2134
2135 procedure TUnZipper.CloseOutput(Item: TFullZipFileEntry; var OutStream: TStream
2136 );
2137
2138 Begin
2139 if Assigned(FOnDoneStream) then
2140 begin
2141 FOnDoneStream(Self, OutStream, Item);
2142 OutStream := nil;
2143 end
2144 else
2145 FreeAndNil(OutStream);
2146 DoEndOfFile;
2147 end;
2148
2149
2150 procedure TUnZipper.CloseInput;
2151
2152 Begin
2153 if Assigned(FOnCloseInputStream) then
2154 FOnCloseInputStream(Self, FZipStream);
2155 FreeAndNil(FZipStream);
2156 end;
2157
2158
2159 procedure TUnZipper.ReadZipHeader(Item: TFullZipFileEntry; out AMethod: Word);
2160 Var
2161 S : String;
2162 U : UTF8String;
2163 D : TDateTime;
2164 ExtraFieldHdr: Extensible_Data_Field_Header_Type;
2165 SavePos: int64; //could be qword but limited by stream
2166 // Infozip unicode path
2167 Infozip_Unicode_Path_Ver:Byte;
2168 Infozip_Unicode_Path_CRC32:DWord;
2169 Begin
2170 FZipStream.Seek(Item.HdrPos,soBeginning);
2171 FZipStream.ReadBuffer(LocalHdr,SizeOf(LocalHdr));
2172 {$IFDEF FPC_BIG_ENDIAN}
2173 LocalHdr := SwapLFH(LocalHdr);
2174 {$ENDIF}
2175 FillChar(LocalZip64Fld,SizeOf(LocalZip64Fld),0); //ensure no erroneous info
2176 With LocalHdr do
2177 begin
2178 Item.FBitFlags:=Bit_Flag;
2179 SetLength(S,Filename_Length);
2180 FZipStream.ReadBuffer(S[1],Filename_Length);
2181 Item.ArchiveFileName:=S;
2182 Item.DiskFileName:=S;
2183 SavePos:=FZipStream.Position; //after filename, before extra fields
2184 if Extra_Field_Length>0 then
2185 begin
2186 SavePos := FZipStream.Position;
2187 if (LocalHdr.Extra_Field_Length>=SizeOf(ExtraFieldHdr)) then
2188 while FZipStream.Position<SavePos+LocalHdr.Extra_Field_Length do
2189 begin
2190 FZipStream.ReadBuffer(ExtraFieldHdr, SizeOf(ExtraFieldHdr));
2191 {$IFDEF FPC_BIG_ENDIAN}
2192 ExtraFieldHdr := SwapEDFH(ExtraFieldHdr);
2193 {$ENDIF}
2194 if ExtraFieldHdr.Header_ID=ZIP64_HEADER_ID then
2195 begin
2196 FZipStream.ReadBuffer(LocalZip64Fld, SizeOf(LocalZip64Fld));
2197 {$IFDEF FPC_BIG_ENDIAN}
2198 LocalZip64Fld := SwapZ64EIF(LocalZip64Fld);
2199 {$ENDIF}
2200 end
2201 // Infozip unicode path
2202 else if ExtraFieldHdr.Header_ID=INFOZIP_UNICODE_PATH_ID then
2203 begin
2204 FZipStream.ReadBuffer(Infozip_Unicode_Path_Ver,1);
2205 if Infozip_Unicode_Path_Ver=1 then
2206 begin
2207 FZipStream.ReadBuffer(Infozip_Unicode_Path_CRC32,sizeof(Infozip_Unicode_Path_CRC32));
2208 {$IFDEF FPC_BIG_ENDIAN}
2209 Infozip_Unicode_Path_CRC32:=SwapEndian(Infozip_Unicode_Path_CRC32);
2210 {$ENDIF}
2211 if CRC32Str(S)=Infozip_Unicode_Path_CRC32 then
2212 begin
2213 SetLength(U,ExtraFieldHdr.Data_Size-5);
2214 FZipStream.ReadBuffer(U[1],Length(U));
2215 Item.UTF8ArchiveFileName:=U;
2216 Item.UTF8DiskFileName:=U;
2217 end
2218 else
2219 FZipStream.Seek(ExtraFieldHdr.Data_Size-5,soFromCurrent);
2220 end
2221 else
2222 FZipStream.Seek(ExtraFieldHdr.Data_Size-1,soFromCurrent);
2223 end
2224 else
2225 FZipStream.Seek(ExtraFieldHdr.Data_Size,soFromCurrent);
2226 end;
2227 // Move past extra fields
2228 FZipStream.Seek(SavePos+Extra_Field_Length,soFromBeginning);
2229 end;
2230 Item.Size:=Uncompressed_Size;
2231 ZipDateTimeToDateTime(Last_Mod_Date,Last_Mod_Time,D);
2232 Item.DateTime:=D;
2233 if Crc32 <> 0 then
2234 Item.CRC32 := Crc32;
2235 AMethod:=Compress_method;
2236 end;
2237 End;
2238
2239 procedure TUnZipper.FindEndHeaders(
2240 out AEndHdr: End_of_Central_Dir_Type;
2241 out AEndHdrPos: Int64;
2242 out AEndZip64Hdr: Zip64_End_of_Central_Dir_type;
2243 out AEndZip64HdrPos: Int64);
2244 // Reads backwords from the end of the zip file,
2245 // following end of central directory, and, if present
2246 // zip64 end of central directory locator and
2247 // zip64 end of central directory record
2248
2249 // If valid regular end of directory found, AEndHdrPos>0
2250 // If valid zip64 end of directory found, AEndZip64HdrPos>0
2251 var
2252 EndZip64Locator: Zip64_End_of_Central_Dir_Locator_type;
2253 procedure SearchForSignature;
2254 // Search for end of central directory record signature
2255 // If failed, set AEndHdrPos to 0
2256 var
2257 I: Integer;
2258 Buf: PByte;
2259 BufSize: Integer;
2260 result: boolean;
2261 begin
2262 result:=false;
2263 // scan the last (64k + something) bytes for the END_OF_CENTRAL_DIR_SIGNATURE
2264 // (zip file comments are 64k max).
2265 BufSize := 65536 + SizeOf(AEndHdr) + 128;
2266 if FZipStream.Size < BufSize then
2267 BufSize := FZipStream.Size;
2268
2269 Buf := GetMem(BufSize);
2270 try
2271 FZipStream.Seek(FZipStream.Size - BufSize, soBeginning);
2272 FZipStream.ReadBuffer(Buf^, BufSize);
2273
2274 for I := BufSize - SizeOf(AEndHdr) downto 0 do
2275 begin
2276 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
2277 begin
2278 Move(Buf[I], AEndHdr, SizeOf(AEndHdr));
2279 {$IFDEF FPC_BIG_ENDIAN}
2280 AEndHdr := SwapECD(AEndHdr);
2281 {$ENDIF}
2282 if (AEndHdr.Signature = END_OF_CENTRAL_DIR_SIGNATURE) and
2283 (I + SizeOf(AEndHdr) + AEndHdr.ZipFile_Comment_Length = BufSize) then
2284 begin
2285 AEndHdrPos := FZipStream.Size - BufSize + I;
2286 FZipStream.Seek(AEndHdrPos + SizeOf(AEndHdr), soBeginning);
2287 SetLength(FFileComment, AEndHdr.ZipFile_Comment_Length);
2288 FZipStream.ReadBuffer(FFileComment[1], Length(FFileComment));
2289 result:=true; //found it
2290 break;
2291 end;
2292 end;
2293 end;
2294 finally
2295 FreeMem(Buf);
2296 end;
2297 if not(result) then
2298 begin
2299 AEndHdrPos := 0;
2300 FillChar(AEndHdr, SizeOf(AEndHdr), 0);
2301 end;
2302 end;
2303
2304 procedure ZeroData;
2305 begin
2306 AEndHdrPos := 0;
2307 FillChar(AEndHdr, SizeOf(AEndHdr), 0);
2308 AEndZip64HdrPos:=0;
2309 FillChar(AEndZip64Hdr, SizeOf(AEndZip64Hdr), 0);
2310 end;
2311
2312 begin
2313 // Zip64 records may not exist, so fill out default values
2314 FillChar(AEndZip64Hdr,SizeOf(AEndZip64Hdr), 0);
2315 AEndZip64HdrPos:=0;
2316 // Look for end of central directory record from
2317 // back of file based on signature (only way due to
2318 // variable length zip comment etc)
2319 FFileComment := '';
2320 // Zip file requires end of central dir header so
2321 // is corrupt if it is smaller than that
2322 if FZipStream.Size < SizeOf(AEndHdr) then
2323 begin
2324 ZeroData;
2325 exit;
2326 end;
2327
2328 AEndHdrPos := FZipStream.Size - SizeOf(AEndHdr);
2329 FZipStream.Seek(AEndHdrPos, soBeginning);
2330 FZipStream.ReadBuffer(AEndHdr, SizeOf(AEndHdr));
2331 {$IFDEF FPC_BIG_ENDIAN}
2332 AEndHdr := SwapECD(AEndHdr);
2333 {$ENDIF}
2334 // Search unless record is right at the end of the file:
2335 if (AEndHdr.Signature <> END_OF_CENTRAL_DIR_SIGNATURE) or
2336 (AEndHdr.ZipFile_Comment_Length <> 0) then
2337 SearchForSignature;
2338 if AEndHdrPos=0 then
2339 begin
2340 ZeroData;
2341 exit;
2342 end;
2343
2344 // With a valid end of dir record, see if there's zip64
2345 // fields:
2346 FZipStream.Seek(AEndHdrPos-SizeOf(Zip64_End_of_Central_Dir_Locator_type),soBeginning);
2347 FZipStream.ReadBuffer(EndZip64Locator, SizeOf(EndZip64Locator));
2348 {$IFDEF FPC_BIG_ENDIAN}
2349 EndZip64Locator := SwapZ64ECDL(EndZip64Locator);
2350 {$ENDIF}
2351 if EndZip64Locator.Signature=ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIGNATURE then
2352 begin
2353 //Read EndZip64Locator.Total_Disks when implementing multiple disks support
2354 if EndZip64Locator.Central_Dir_Zip64_EOCD_Offset>High(Int64) then
2355 raise EZipError.CreateFmt(SErrPosTooLarge,[EndZip64Locator.Central_Dir_Zip64_EOCD_Offset,High(Int64)]);
2356 AEndZip64HdrPos:=EndZip64Locator.Central_Dir_Zip64_EOCD_Offset;
2357 FZipStream.Seek(AEndZip64HdrPos, soBeginning);
2358 FZipStream.ReadBuffer(AEndZip64Hdr, SizeOf(AEndZip64Hdr));
2359 {$IFDEF FPC_BIG_ENDIAN}
2360 AEndZip64Hdr := SwapZ64ECD(AEndZip64Hdr);
2361 {$ENDIF}
2362 if AEndZip64Hdr.Signature<>ZIP64_END_OF_CENTRAL_DIR_SIGNATURE then
2363 begin
2364 //Corrupt header
2365 ZeroData;
2366 Exit;
2367 end;
2368 end
2369 else
2370 begin
2371 // No zip64 data, so follow the offset in the end of central directory record
2372 AEndZip64HdrPos:=0;
2373 FillChar(AEndZip64Hdr, SizeOf(AEndZip64Hdr), 0);
2374 end;
2375 end;
2376
2377 procedure TUnZipper.ReadZipDirectory;
2378
2379 Var
2380 EndHdr : End_of_Central_Dir_Type;
2381 EndZip64Hdr : Zip64_End_of_Central_Dir_type;
2382 i : integer; //could be Qword but limited to number of items in collection
2383 EndHdrPos,
2384 EndZip64HdrPos,
2385 CenDirPos,
2386 SavePos : Int64; //could be QWord but limited to stream maximums
2387 ExtraFieldHeader : Extensible_Data_Field_Header_Type;
2388 EntriesThisDisk : QWord;
2389 Zip64Field: Zip64_Extended_Info_Field_Type;
2390 NewNode : TFullZipFileEntry;
2391 D : TDateTime;
2392 S : String;
2393 U : UTF8String;
2394 // infozip unicode path
2395 Infozip_unicode_path_ver : byte; // always 1
2396 Infozip_unicode_path_crc32 : DWord;
2397 Begin
2398 FindEndHeaders(EndHdr, EndHdrPos,
2399 EndZip64Hdr, EndZip64HdrPos);
2400 if EndHdrPos=0 then
2401 raise EZipError.CreateFmt(SErrCorruptZIP,[FileName]);
2402 if (EndZip64HdrPos>0) and (EndZip64Hdr.Start_Disk_Offset>0) then
2403 begin
2404 if EndZip64Hdr.Start_Disk_Offset>High(Int64) then
2405 raise EZipError.CreateFmt(SErrPosTooLarge,[EndZip64Hdr.Start_Disk_Offset,High(Int64)]);
2406 CenDirPos := EndZip64Hdr.Start_Disk_Offset;
2407 end
2408 else
2409 CenDirPos := EndHdr.Start_Disk_Offset;
2410 FZipStream.Seek(CenDirPos,soBeginning);
2411 FEntries.Clear;
2412 if (EndZip64HdrPos>0) and (EndZip64Hdr.Entries_This_Disk>0) then
2413 begin
2414 EntriesThisDisk := EndZip64Hdr.Entries_This_Disk;
2415 if EntriesThisDisk<>EndZip64Hdr.Total_Entries then
2416 raise EZipError.Create(SErrUnsupportedMultipleDisksCD);
2417 end
2418 else
2419 begin
2420 EntriesThisDisk :=EndHdr.Entries_This_Disk;
2421 if EntriesThisDisk<>EndHdr.Total_Entries then
2422 raise EZipError.Create(SErrUnsupportedMultipleDisksCD);
2423 end;
2424
2425 // Entries are added to a collection. The max number of items
2426 // in a collection limits the entries we can process.
2427 if EntriesThisDisk>MaxInt then
2428 raise EZipError.CreateFmt(SErrMaxEntries,[EntriesThisDisk,MaxInt]);
2429
2430 // Using while instead of for loop so qword can be used on 32 bit as well.
2431 for i:=0 to EntriesThisDisk-1 do
2432 begin
2433 FZipStream.ReadBuffer(CentralHdr, SizeOf(CentralHdr));
2434 {$IFDEF FPC_BIG_ENDIAN}
2435 CentralHdr := SwapCFH(CentralHdr);
2436 {$ENDIF}
2437 With CentralHdr do
2438 begin
2439 if Signature<>CENTRAL_FILE_HEADER_SIGNATURE then
2440 raise EZipError.CreateFmt(SErrCorruptZIP,[FileName]);
2441 NewNode:=FEntries.Add as TFullZipFileEntry;
2442 // Header position will be corrected later with zip64 version, if needed..
2443 NewNode.HdrPos := Local_Header_Offset;
2444 NewNode.FBitFlags:=Bit_Flag;
2445 SetLength(S,Filename_Length);
2446 FZipStream.ReadBuffer(S[1],Filename_Length);
2447 SavePos:=FZipStream.Position; //After fixed part of central directory...
2448 // and the filename; before any extra field(s)
2449 NewNode.ArchiveFileName:=S;
2450 // Size/compressed size will be adjusted by zip64 entries if needed...
2451 NewNode.Size:=Uncompressed_Size;
2452 NewNode.FCompressedSize:=Compressed_Size;
2453 NewNode.CRC32:=CRC32;
2454 NewNode.OS := MadeBy_Version shr 8;
2455 if NewNode.OS = OS_UNIX then
2456 NewNode.Attributes := External_Attributes shr 16
2457 else
2458 NewNode.Attributes := External_Attributes;
2459 ZipDateTimeToDateTime(Last_Mod_Date,Last_Mod_Time,D);
2460 NewNode.DateTime:=D;
2461
2462 // Go through any extra fields and extract any zip64 info
2463 if Extra_Field_Length>0 then
2464 begin
2465 while (FZipStream.Position<SavePos+Extra_Field_Length) do
2466 begin
2467 FZipStream.ReadBuffer(ExtraFieldHeader, SizeOf(ExtraFieldHeader));
2468 {$IFDEF FPC_BIG_ENDIAN}
2469 ExtraFieldHeader := SwapEDFH(ExtraFieldHeader);
2470 {$ENDIF}
2471 if ExtraFieldHeader.Header_ID = ZIP64_HEADER_ID then
2472 begin
2473 FZipStream.ReadBuffer(Zip64Field, SizeOf(Zip64Field));
2474 {$IFDEF FPC_BIG_ENDIAN}
2475 Zip64Field := SwapZ64EIF(Zip64Field);
2476 {$ENDIF}
2477 if Zip64Field.Compressed_Size > 0 then
2478 NewNode.FCompressedSize := Zip64Field.Compressed_Size;
2479 if Zip64Field.Original_Size>0 then
2480 NewNode.Size := Zip64Field.Original_Size;
2481 if Zip64Field.Relative_Hdr_Offset<>0 then
2482 begin
2483 if Zip64Field.Relative_Hdr_Offset>High(Int64) then
2484 raise EZipError.CreateFmt(SErrPosTooLarge,[Zip64Field.Relative_Hdr_Offset,High(Int64)]);
2485 NewNode.HdrPos := Zip64Field.Relative_Hdr_Offset;
2486 end;
2487 end
2488 // infozip unicode path extra field
2489 else if ExtraFieldHeader.Header_ID = INFOZIP_UNICODE_PATH_ID then
2490 begin
2491 FZipStream.ReadBuffer(Infozip_unicode_path_ver,1);
2492 if Infozip_unicode_path_ver=1 then
2493 begin
2494 FZipStream.ReadBuffer(Infozip_unicode_path_crc32,sizeof(Infozip_unicode_path_crc32));
2495 {$IFDEF FPC_BIG_ENDIAN}
2496 Infozip_unicode_path_crc32:=SwapEndian(Infozip_unicode_path_crc32);
2497 {$ENDIF}
2498 if CRC32Str(S)=Infozip_unicode_path_crc32 then
2499 begin
2500 SetLength(U,ExtraFieldHeader.Data_Size-5);
2501 FZipStream.ReadBuffer(U[1],Length(U));
2502 NewNode.UTF8ArchiveFileName:=U;
2503 end
2504 else
2505 FZipStream.Seek(ExtraFieldHeader.Data_Size-5,soFromCurrent);
2506 end
2507 else
2508 FZipStream.Seek(ExtraFieldHeader.Data_Size-1,soFromCurrent);
2509 end
2510 else
2511 begin
2512 // Read past non-Zip64 extra field
2513 FZipStream.Seek(ExtraFieldHeader.Data_Size,soFromCurrent);
2514 end;
2515 end;
2516 end;
2517 // Move past extra fields and file comment to next header
2518 FZipStream.Seek(SavePos+Extra_Field_Length+File_Comment_Length,soFromBeginning);
2519 end;
2520 end;
2521 end;
2522
CreateDeCompressornull2523 function TUnZipper.CreateDeCompressor(Item: TZipFileEntry; AMethod: Word;
2524 AZipFile, AOutFile: TStream): TDeCompressor;
2525 begin
2526 case AMethod of
2527 8 :
2528 Result:=TInflater.Create(AZipFile,AOutFile,FBufSize);
2529 else
2530 raise EZipError.CreateFmt(SErrUnsupportedCompressionFormat,[AMethod]);
2531 end;
2532 FCurrentDecompressor:=Result;
2533 end;
2534
2535 procedure TUnZipper.UnZipOneFile(Item: TFullZipFileEntry);
2536
2537 Var
2538 ZMethod : Word;
2539 {$ifdef unix}
2540 LinkTargetStream: TStringStream;
2541 {$endif}
2542 OutputFileName: RawByteString;
2543 FOutStream: TStream;
2544 IsLink: Boolean;
2545 IsCustomStream: Boolean;
2546 U : UnicodeString;
2547
2548 Procedure SetAttributes;
2549 Var
2550 Attrs : Longint;
2551 begin
2552 // set attributes
2553 FileSetDate(OutputFileName, DateTimeToFileDate(Item.DateTime));
2554 if (Item.Attributes <> 0) then
2555 begin
2556 Attrs := 0;
2557 {$IFDEF UNIX}
2558 if (Item.OS in [OS_UNIX,OS_OSX]) then Attrs := Item.Attributes;
2559 if (Item.OS in [OS_FAT,OS_NTFS,OS_OS2,OS_VFAT]) then
2560 Attrs := ZipFatAttrsToUnixAttrs(Item.Attributes);
2561 {$ELSE}
2562 if (Item.OS in [OS_FAT,OS_NTFS,OS_OS2,OS_VFAT]) then Attrs := Item.Attributes;
2563 if (Item.OS in [OS_UNIX,OS_OSX]) then
2564 Attrs := ZipUnixAttrsToFatAttrs(ExtractFileName(Item.ArchiveFileName), Item.Attributes);
2565 {$ENDIF}
2566 if Attrs <> 0 then
2567 begin
2568 {$IFDEF UNIX}
2569 FpChmod(OutputFileName, Attrs);
2570 {$ELSE}
2571 FileSetAttr(OutputFileName, Attrs);
2572 {$ENDIF}
2573 end;
2574 end;
2575 end;
2576
2577 procedure DoUnzip(const Dest: TStream);
2578
2579 begin
2580 if ZMethod=0 then
2581 begin
2582 if (LocalHdr.Compressed_Size<>0) then
2583 begin
2584 if LocalZip64Fld.Compressed_Size>0 then
2585 Dest.CopyFrom(FZipStream,LocalZip64Fld.Compressed_Size)
2586 else
2587 Dest.CopyFrom(FZipStream,LocalHdr.Compressed_Size);
2588 {$warning TODO: Implement CRC Check}
2589 end;
2590 end
2591 else
2592 With CreateDecompressor(Item, ZMethod, FZipStream, Dest) do
2593 Try
2594 FTotPos := Self.FTotPos;
2595 FTotSize := Self.FTotSize;
2596 OnProgress:=Self.OnProgress;
2597 OnProgressEx := Self.OnProgressEx;
2598 OnPercent:=Self.OnPercent;
2599 OnProgress:=Self.OnProgress;
2600 OnPercent:=Self.OnPercent;
2601 DeCompress;
2602 Self.FTotPos := FTotPos;
2603 if Item.CRC32 <> Crc32Val then
2604 raise EZipError.CreateFmt(SErrInvalidCRC,[Item.ArchiveFileName]);
2605 Finally
2606 FCurrentDecompressor:=Nil;
2607 Free;
2608 end;
2609 end;
2610
2611 Procedure GetOutputFileName;
2612
2613 Var
2614 I : Integer;
2615
2616 begin
2617 if Not UseUTF8 then
2618 OutputFileName:=StringReplace(Item.DiskFileName,'/',DirectorySeparator,[rfReplaceAll])
2619 else
2620 begin
2621 // Sets codepage.
2622 OutputFileName:=Item.UTF8DiskFileName;
2623 U:=UTF8Decode(OutputFileName);
2624 // Do not use stringreplace, it will mess up the codepage.
2625 if '/'<>DirectorySeparator then
2626 For I:=1 to Length(U) do
2627 if U[i]='/' then
2628 U[i]:=DirectorySeparator;
2629 OutputFileName:=UTF8Encode(U);
2630 end;
2631 if (Not IsCustomStream) and (FOutputPath<>'') then
2632 begin
2633 // Do not use IncludeTrailingPathdelimiter
2634 OutputFileName:=FOutputPath+OutputFileName;
2635 end;
2636 end;
2637
2638 Begin
2639 ReadZipHeader(Item, ZMethod);
2640 if (Item.BitFlags and 1)<>0 then
2641 Raise EZipError.CreateFmt(SErrEncryptionNotSupported,[Item.ArchiveFileName]);
2642 if (Item.BitFlags and (1 shl 5))<>0 then
2643 Raise EZipError.CreateFmt(SErrPatchSetNotSupported,[Item.ArchiveFileName]);
2644 // Normalize output filename to conventions of target platform.
2645 // Zip file always has / path separators
2646 IsCustomStream := Assigned(FOnCreateStream);
2647 GetOutputFileName;
2648 IsLink := Item.IsLink;
2649 {$IFNDEF UNIX}
2650 if IsLink and Not IsCustomStream then
2651 begin
2652 {$warning TODO: Implement symbolic link creation for non-unix, e.g.
2653 Windows NTFS}
2654 IsLink := False;
2655 end;
2656 {$ENDIF}
2657 if IsCustomStream then
2658 begin
2659 try
2660 OpenOutput(OutputFileName, FOutStream, Item);
2661 if (IsLink = False) and (Item.IsDirectory = False) then
2662 DoUnzip(FOutStream);
2663 Finally
2664 CloseOutput(Item, FOutStream);
2665 end;
2666 end
2667 else
2668 begin
2669 if IsLink then
2670 begin
2671 {$IFDEF UNIX}
2672 LinkTargetStream := TStringStream.Create('');
2673 try
2674 DoUnzip(LinkTargetStream);
2675 fpSymlink(PChar(LinkTargetStream.DataString), PChar(OutputFileName));
2676 finally
2677 LinkTargetStream.Free;
2678 end;
2679 {$ENDIF}
2680 end
2681 else if Item.IsDirectory then
2682 CreateDir(OutputFileName)
2683 else
2684 begin
2685 try
2686 OpenOutput(OutputFileName, FOutStream, Item);
2687 DoUnzip(FOutStream);
2688 Finally
2689 CloseOutput(Item, FOutStream);
2690 end;
2691 end;
2692 SetAttributes;
2693 end;
2694 end;
2695
2696 Function TUnZipper.IsMatch(I : TFullZipFileEntry) : Boolean;
2697
2698 begin
2699 if UseUTF8 then
2700 Result:=(FFiles.IndexOf(I.UTF8ArchiveFileName)<>-1)
2701 else
2702 Result:=(FFiles.IndexOf(I.ArchiveFileName)<>-1)
2703 end;
2704
2705 Function TUnZipper.CalcTotalSize(AllFiles : Boolean) : Int64;
2706
2707 Var
2708 I : Integer;
2709 Item : TFullZipFileEntry;
2710
2711 begin
2712 Result:=0;
2713 for i:=0 to FEntries.Count-1 do
2714 begin
2715 Item := FEntries[i];
2716 if AllFiles or IsMatch(Item) then
2717 Result := Result + TZipFileEntry(Item).Size;
2718 end;
2719 end;
2720
2721 procedure TUnZipper.UnZipAllFiles;
2722
2723
2724 Var
2725 Item : TFullZipFileEntry;
2726 I : integer; //Really QWord but limited to FEntries.Count
2727 AllFiles : Boolean;
2728
2729 Begin
2730 FTerminated:=False;
2731 FUnZipping:=True;
2732 Try
2733 AllFiles:=(FFiles.Count=0);
2734 OpenInput;
2735 Try
2736 ReadZipDirectory;
2737 FTotPos := 0;
2738 FTotSize := CalcTotalSize(AllFiles);
2739 i:=0;
2740 While (I<FEntries.Count) and not Terminated do
2741 begin
2742 Item:=FEntries[i];
2743 if AllFiles or IsMatch(Item) then
2744 UnZipOneFile(Item);
2745 inc(I);
2746 end;
2747 if Assigned(FOnProgressEx) and not Terminated then
2748 FOnProgressEx(Self, FTotPos, FTotSize);
2749 Finally
2750 CloseInput;
2751 end;
2752 finally
2753 FUnZipping:=False;
2754 end;
2755 end;
2756
2757
2758 procedure TUnZipper.SetBufSize(Value: LongWord);
2759
2760 begin
2761 If FUnZipping then
2762 Raise EZipError.Create(SErrBufsizeChange);
2763 If Value>=DefaultBufSize then
2764 FBufSize:=Value;
2765 end;
2766
2767 procedure TUnZipper.SetFileName(Value: RawByteString);
2768
2769 begin
2770 If FUnZipping then
2771 Raise EZipError.Create(SErrFileChange);
2772 FFileName:=Value;
2773 end;
2774
2775 procedure TUnZipper.SetOutputPath(Value: RawByteString);
2776
2777 Var
2778 DS : RawByteString;
2779
2780 begin
2781 If FUnZipping then
2782 Raise EZipError.Create(SErrFileChange);
2783 FOutputPath:=Value;
2784 If (FOutputPath<>'') and (FoutputPath[Length(FoutputPath)]<>DirectorySeparator) then
2785 begin
2786 // Preserve codepage of outputpath
2787 DS:=DirectorySeparator;
2788 SetCodePage(DS,StringCodePage(FoutputPath),False);
2789 FOutputPath:=FoutputPath+DS;
2790 end;
2791 end;
2792
2793 procedure TUnZipper.UnZipFiles(AFileName: RawByteString; FileList: TStrings);
2794
2795 begin
2796 FFileName:=AFileName;
2797 UNzipFiles(FileList);
2798 end;
2799
2800 procedure TUnZipper.UnZipFiles(FileList: TStrings);
2801 begin
2802 FFiles.Assign(FileList);
2803 UnZipAllFiles;
2804 end;
2805
2806 procedure TUnZipper.UnZipAllFiles(AFileName: RawByteString);
2807
2808 begin
2809 FFileName:=AFileName;
2810 UnZipAllFiles;
2811 end;
2812
2813 procedure TUnZipper.DoEndOfFile;
2814
2815 Var
2816 ComprPct : Double;
2817 Uncompressed: QWord;
2818 Compressed: QWord;
2819 begin
2820 If LocalZip64Fld.Original_Size > 0 then
2821 Uncompressed := LocalZip64Fld.Original_Size
2822 else
2823 Uncompressed := LocalHdr.Uncompressed_Size;
2824
2825 If LocalZip64Fld.Compressed_Size > 0 then
2826 Compressed := LocalZip64Fld.Compressed_Size
2827 else
2828 Compressed := LocalHdr.Compressed_Size;
2829
2830 If (Compressed>0) and (Uncompressed>0) then
2831 if (Compressed>Uncompressed) then
2832 ComprPct := (-100.0 * (Compressed - Uncompressed)) / Uncompressed
2833 else
2834 ComprPct := (100.0 * (Uncompressed - Compressed)) / Uncompressed
2835 else
2836 ComprPct := 0;
2837 If Assigned(FOnEndOfFile) then
2838 FOnEndOfFile(Self,ComprPct);
2839 end;
2840
2841 constructor TUnZipper.Create;
2842
2843 begin
2844 FBufSize:=DefaultBufSize;
2845 FFiles:=TStringList.Create;
2846 TStringlist(FFiles).Sorted:=True;
2847 FEntries:=TFullZipFileEntries.Create(TFullZipFileEntry);
2848 FOnPercent:=1;
2849 end;
2850
2851 procedure TUnZipper.Clear;
2852
2853 begin
2854 FFiles.Clear;
2855 FEntries.Clear;
2856 end;
2857
2858 procedure TUnZipper.Examine;
2859 begin
2860 if (FOnOpenInputStream = nil) and (FFileName='') then
2861 Raise EZipError.Create(SErrNoFileName);
2862 OpenInput;
2863 If (FZipStream=nil) then
2864 Raise EZipError.Create(SErrNoStream);
2865 Try
2866 ReadZipDirectory;
2867 Finally
2868 CloseInput;
2869 end;
2870 end;
2871
2872 procedure TUnZipper.Terminate;
2873 begin
2874 FTerminated:=True;
2875 if Assigned(FCurrentDecompressor) then
2876 FCurrentDecompressor.Terminate;
2877 end;
2878
2879 destructor TUnZipper.Destroy;
2880
2881 begin
2882 Clear;
2883 FreeAndNil(FFiles);
2884 FreeAndNil(FEntries);
2885 Inherited;
2886 end;
2887
2888 { TZipFileEntry }
2889
GetArchiveFileNamenull2890 function TZipFileEntry.GetArchiveFileName: String;
2891 begin
2892 Result:=FArchiveFileName;
2893 If (Result='') then
2894 Result:=FDiskFileName;
2895 end;
2896
GetUTF8ArchiveFileNamenull2897 function TZipFileEntry.GetUTF8ArchiveFileName: UTF8String;
2898 begin
2899 Result:=FUTF8FileName;
2900 If Result='' then
2901 Result:=ArchiveFileName;
2902 end;
2903
GetUTF8DiskFileNamenull2904 function TZipFileEntry.GetUTF8DiskFileName: UTF8String;
2905 begin
2906 Result:=FUTF8DiskFileName;
2907 If Result='' then
2908 Result:=DiskFileName;
2909 end;
2910
2911 constructor TZipFileEntry.Create(ACollection: TCollection);
2912
2913 begin
2914 {$IFDEF UNIX}
2915 FOS := OS_UNIX;
2916 {$ELSE}
2917 FOS := OS_FAT;
2918 {$ENDIF}
2919 FCompressionLevel:=cldefault;
2920 FDateTime:=now;
2921 FNeedsZip64:=false;
2922 FAttributes:=0;
2923
2924 inherited create(ACollection);
2925 end;
2926
IsDirectorynull2927 function TZipFileEntry.IsDirectory: Boolean;
2928 begin
2929 Result := (DiskFileName <> '') and (DiskFileName[Length(DiskFileName)] = DirectorySeparator);
2930 if Attributes <> 0 then
2931 begin
2932 case OS of
2933 OS_FAT: Result := (faDirectory and Attributes) > 0;
2934 OS_UNIX: Result := (Attributes and UNIX_MASK) = UNIX_DIR;
2935 end;
2936 end;
2937 end;
2938
IsLinknull2939 function TZipFileEntry.IsLink: Boolean;
2940 begin
2941 Result := False;
2942 if Attributes <> 0 then
2943 begin
2944 case OS of
2945 OS_FAT: Result := (faSymLink and Attributes) > 0;
2946 OS_UNIX: Result := (Attributes and UNIX_MASK) = UNIX_LINK;
2947 end;
2948 end;
2949 end;
2950
2951 procedure TZipFileEntry.SetArchiveFileName(const AValue: String);
2952
2953 begin
2954 if FArchiveFileName=AValue then Exit;
2955 // Zip standard: filenames inside the zip archive have / path separator
2956 if DirectorySeparator='/' then
2957 FArchiveFileName:=AValue
2958 else
2959 FArchiveFileName:=StringReplace(AValue, DirectorySeparator, '/', [rfReplaceAll]);
2960 end;
2961
2962 procedure TZipFileEntry.SetDiskFileName(const AValue: String);
2963 begin
2964 if FDiskFileName=AValue then Exit;
2965 // Zip file uses / as directory separator on all platforms
2966 // so convert to separator used on current OS
2967 if DirectorySeparator='/' then
2968 FDiskFileName:=AValue
2969 else
2970 FDiskFileName:=StringReplace(AValue,'/',DirectorySeparator,[rfReplaceAll]);
2971 end;
2972
2973 procedure TZipFileEntry.SetUTF8ArchiveFileName(AValue: UTF8String);
2974 begin
2975 FUTF8FileName:=AValue;
2976 If ArchiveFileName='' then
2977 if DefaultSystemCodePage<>CP_UTF8 then
2978 ArchiveFileName:=Utf8ToAnsi(AValue)
2979 else
2980 ArchiveFileName:=AValue;
2981 end;
2982
2983 procedure TZipFileEntry.SetUTF8DiskFileName(AValue: UTF8String);
2984 begin
2985 FUTF8DiskFileName:=AValue;
2986 If DiskFileName='' then
2987 if DefaultRTLFileSystemCodePage<>CP_UTF8 then
2988 DiskFileName:=Utf8ToAnsi(AValue)
2989 else
2990 DiskFileName:=AValue;
2991 end;
2992
2993
2994 procedure TZipFileEntry.Assign(Source: TPersistent);
2995
2996 Var
2997 Z : TZipFileEntry;
2998
2999 begin
3000 if Source is TZipFileEntry then
3001 begin
3002 Z:=Source as TZipFileEntry;
3003 FArchiveFileName:=Z.FArchiveFileName;
3004 FDiskFileName:=Z.FDiskFileName;
3005 FSize:=Z.FSize;
3006 FDateTime:=Z.FDateTime;
3007 FStream:=Z.FStream;
3008 FOS:=Z.OS;
3009 FAttributes:=Z.Attributes;
3010 end
3011 else
3012 inherited Assign(Source);
3013 end;
3014
3015 { TZipFileEntries }
3016
GetZnull3017 function TZipFileEntries.GetZ(AIndex : Integer): TZipFileEntry;
3018 begin
3019 Result:=TZipFileEntry(Items[AIndex]);
3020 end;
3021
3022 procedure TZipFileEntries.SetZ(AIndex : Integer; const AValue: TZipFileEntry);
3023 begin
3024 Items[AIndex]:=AValue;
3025 end;
3026
AddFileEntrynull3027 function TZipFileEntries.AddFileEntry(const ADiskFileName: String): TZipFileEntry;
3028 begin
3029 Result:=Add as TZipFileEntry;
3030 Result.DiskFileName:=ADiskFileName;
3031 end;
3032
AddFileEntrynull3033 function TZipFileEntries.AddFileEntry(const ADiskFileName,
3034 AArchiveFileName: String): TZipFileEntry;
3035 begin
3036 Result:=AddFileEntry(ADiskFileName);
3037 Result.ArchiveFileName:=AArchiveFileName;
3038 end;
3039
AddFileEntrynull3040 function TZipFileEntries.AddFileEntry(const AStream: TSTream;
3041 const AArchiveFileName: String): TZipFileEntry;
3042 begin
3043 Result:=Add as TZipFileEntry;
3044 Result.Stream:=AStream;
3045 Result.ArchiveFileName:=AArchiveFileName;
3046 end;
3047
3048 Procedure TZipFileEntries.AddFileEntries(Const List : TStrings);
3049
3050 Var
3051 I : integer;
3052
3053 begin
3054 For I:=0 to List.Count-1 do
3055 AddFileEntry(List[i]);
3056 end;
3057
3058 { TFullZipFileEntries }
3059
GetFZnull3060 function TFullZipFileEntries.GetFZ(AIndex : Integer): TFullZipFileEntry;
3061 begin
3062 Result:=TFullZipFileEntry(Items[AIndex]);
3063 end;
3064
3065 procedure TFullZipFileEntries.SetFZ(AIndex : Integer;
3066 const AValue: TFullZipFileEntry);
3067 begin
3068 Items[AIndex]:=AValue;
3069 end;
3070
3071 End.
3072