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