zipper.pp 61 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196
  1. {
  2. $Id: header,v 1.1 2000/07/13 06:33:45 michael Exp $
  3. This file is part of the Free Component Library (FCL)
  4. Copyright (c) 1999-2000 by the Free Pascal development team
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. {$mode objfpc}
  12. {$h+}
  13. unit zipper;
  14. Interface
  15. Uses
  16. {$IFDEF UNIX}
  17. BaseUnix,
  18. {$ENDIF}
  19. SysUtils,Classes,zstream;
  20. Const
  21. { Signatures }
  22. END_OF_CENTRAL_DIR_SIGNATURE = $06054B50;
  23. LOCAL_FILE_HEADER_SIGNATURE = $04034B50;
  24. CENTRAL_FILE_HEADER_SIGNATURE = $02014B50;
  25. Type
  26. Local_File_Header_Type = Packed Record
  27. Signature : LongInt;
  28. Extract_Version_Reqd : Word;
  29. Bit_Flag : Word;
  30. Compress_Method : Word;
  31. Last_Mod_Time : Word;
  32. Last_Mod_Date : Word;
  33. Crc32 : LongWord;
  34. Compressed_Size : LongInt;
  35. Uncompressed_Size : LongInt;
  36. Filename_Length : Word;
  37. Extra_Field_Length : Word;
  38. end;
  39. { Define the Central Directory record types }
  40. Central_File_Header_Type = Packed Record
  41. Signature : LongInt;
  42. MadeBy_Version : Word;
  43. Extract_Version_Reqd : Word;
  44. Bit_Flag : Word;
  45. Compress_Method : Word;
  46. Last_Mod_Time : Word;
  47. Last_Mod_Date : Word;
  48. Crc32 : LongWord;
  49. Compressed_Size : LongInt;
  50. Uncompressed_Size : LongInt;
  51. Filename_Length : Word;
  52. Extra_Field_Length : Word;
  53. File_Comment_Length : Word;
  54. Starting_Disk_Num : Word;
  55. Internal_Attributes : Word;
  56. External_Attributes : LongInt;
  57. Local_Header_Offset : LongInt;
  58. End;
  59. End_of_Central_Dir_Type = Packed Record
  60. Signature : LongInt;
  61. Disk_Number : Word;
  62. Central_Dir_Start_Disk : Word;
  63. Entries_This_Disk : Word;
  64. Total_Entries : Word;
  65. Central_Dir_Size : LongInt;
  66. Start_Disk_Offset : LongInt;
  67. ZipFile_Comment_Length : Word;
  68. end;
  69. Const
  70. Crc_32_Tab : Array[0..255] of LongWord = (
  71. $00000000, $77073096, $ee0e612c, $990951ba, $076dc419, $706af48f, $e963a535, $9e6495a3,
  72. $0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd, $e7b82d07, $90bf1d91,
  73. $1db71064, $6ab020f2, $f3b97148, $84be41de, $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7,
  74. $136c9856, $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9, $fa0f3d63, $8d080df5,
  75. $3b6e20c8, $4c69105e, $d56041e4, $a2677172, $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b,
  76. $35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940, $32d86ce3, $45df5c75, $dcd60dcf, $abd13d59,
  77. $26d930ac, $51de003a, $c8d75180, $bfd06116, $21b4f4b5, $56b3c423, $cfba9599, $b8bda50f,
  78. $2802b89e, $5f058808, $c60cd9b2, $b10be924, $2f6f7c87, $58684c11, $c1611dab, $b6662d3d,
  79. $76dc4190, $01db7106, $98d220bc, $efd5102a, $71b18589, $06b6b51f, $9fbfe4a5, $e8b8d433,
  80. $7807c9a2, $0f00f934, $9609a88e, $e10e9818, $7f6a0dbb, $086d3d2d, $91646c97, $e6635c01,
  81. $6b6b51f4, $1c6c6162, $856530d8, $f262004e, $6c0695ed, $1b01a57b, $8208f4c1, $f50fc457,
  82. $65b0d9c6, $12b7e950, $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3, $fbd44c65,
  83. $4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, $4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb,
  84. $4369e96a, $346ed9fc, $ad678846, $da60b8d0, $44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9,
  85. $5005713c, $270241aa, $be0b1010, $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f,
  86. $5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, $2eb40d81, $b7bd5c3b, $c0ba6cad,
  87. $edb88320, $9abfb3b6, $03b6e20c, $74b1d29a, $ead54739, $9dd277af, $04db2615, $73dc1683,
  88. $e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8, $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1,
  89. $f00f9344, $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb, $196c3671, $6e6b06e7,
  90. $fed41b76, $89d32be0, $10da7a5a, $67dd4acc, $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5,
  91. $d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252, $d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b,
  92. $d80d2bda, $af0a1b4c, $36034af6, $41047a60, $df60efc3, $a867df55, $316e8eef, $4669be79,
  93. $cb61b38c, $bc66831a, $256fd2a0, $5268e236, $cc0c7795, $bb0b4703, $220216b9, $5505262f,
  94. $c5ba3bbe, $b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31, $2cd99e8b, $5bdeae1d,
  95. $9b64c2b0, $ec63f226, $756aa39c, $026d930a, $9c0906a9, $eb0e363f, $72076785, $05005713,
  96. $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38, $92d28e9b, $e5d5be0d, $7cdcefb7, $0bdbdf21,
  97. $86d3d2d4, $f1d4e242, $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1, $18b74777,
  98. $88085ae6, $ff0f6a70, $66063bca, $11010b5c, $8f659eff, $f862ae69, $616bffd3, $166ccf45,
  99. $a00ae278, $d70dd2ee, $4e048354, $3903b3c2, $a7672661, $d06016f7, $4969474d, $3e6e77db,
  100. $aed16a4a, $d9d65adc, $40df0b66, $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9,
  101. $bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605, $cdd70693, $54de5729, $23d967bf,
  102. $b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94, $b40bbe37, $c30c8ea1, $5a05df1b, $2d02ef8d
  103. );
  104. Type
  105. TProgressEvent = Procedure(Sender : TObject; Const Pct : Double) of object;
  106. TOnEndOfFileEvent = Procedure(Sender : TObject; Const Ratio : Double) of object;
  107. TOnStartFileEvent = Procedure(Sender : TObject; Const AFileName : String) of object;
  108. Type
  109. { TCompressor }
  110. TCompressor = Class(TObject)
  111. Protected
  112. FInFile : TStream; { I/O file variables }
  113. FOutFile : TStream;
  114. FCrc32Val : LongWord; { CRC calculation variable }
  115. FBufferSize : LongWord;
  116. FOnPercent : Integer;
  117. FOnProgress : TProgressEvent;
  118. Procedure UpdC32(Octet: Byte);
  119. Public
  120. Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord); virtual;
  121. Procedure Compress; Virtual; Abstract;
  122. Class Function ZipID : Word; virtual; Abstract;
  123. Class Function ZipVersionReqd: Word; virtual; Abstract;
  124. Function ZipBitFlag: Word; virtual; Abstract;
  125. Property BufferSize : LongWord read FBufferSize;
  126. Property OnPercent : Integer Read FOnPercent Write FOnPercent;
  127. Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
  128. Property Crc32Val : LongWord Read FCrc32Val Write FCrc32Val;
  129. end;
  130. { TDeCompressor }
  131. TDeCompressor = Class(TObject)
  132. Protected
  133. FInFile : TStream; { I/O file variables }
  134. FOutFile : TStream;
  135. FCrc32Val : LongWord; { CRC calculation variable }
  136. FBufferSize : LongWord;
  137. FOnPercent : Integer;
  138. FOnProgress : TProgressEvent;
  139. Procedure UpdC32(Octet: Byte);
  140. Public
  141. Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord); virtual;
  142. Procedure DeCompress; Virtual; Abstract;
  143. Class Function ZipID : Word; virtual; Abstract;
  144. Property BufferSize : LongWord read FBufferSize;
  145. Property OnPercent : Integer Read FOnPercent Write FOnPercent;
  146. Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
  147. Property Crc32Val : LongWord Read FCrc32Val Write FCrc32Val;
  148. end;
  149. { TShrinker }
  150. Const
  151. TABLESIZE = 8191;
  152. FIRSTENTRY = 257;
  153. Type
  154. CodeRec = Packed Record
  155. Child : Smallint;
  156. Sibling : Smallint;
  157. Suffix : Byte;
  158. end;
  159. CodeArray = Array[0..TABLESIZE] of CodeRec;
  160. TablePtr = ^CodeArray;
  161. FreeListPtr = ^FreeListArray;
  162. FreeListArray = Array[FIRSTENTRY..TABLESIZE] of Word;
  163. BufPtr = PByte;
  164. TShrinker = Class(TCompressor)
  165. Private
  166. FBufSize : LongWord;
  167. MaxInBufIdx : LongWord; { Count of valid chars in input buffer }
  168. InputEof : Boolean; { End of file indicator }
  169. CodeTable : TablePtr; { Points to code table for LZW compression }
  170. FreeList : FreeListPtr; { Table of free code table entries }
  171. NextFree : Word; { Index into free list table }
  172. ClearList : Array[0..1023] of Byte; { Bit mapped structure used in }
  173. { during adaptive resets }
  174. CodeSize : Byte; { Size of codes (in bits) currently being written }
  175. MaxCode : Word; { Largest code that can be written in CodeSize bits }
  176. InBufIdx, { Points to next char in buffer to be read }
  177. OutBufIdx : LongWord; { Points to next free space in output buffer }
  178. InBuf, { I/O buffers }
  179. OutBuf : BufPtr;
  180. FirstCh : Boolean; { Flag indicating the START of a shrink operation }
  181. TableFull : Boolean; { Flag indicating a full symbol table }
  182. SaveByte : Byte; { Output code buffer }
  183. BitsUsed : Byte; { Index into output code buffer }
  184. BytesIn : LongInt; { Count of input file bytes processed }
  185. BytesOut : LongInt; { Count of output bytes }
  186. FOnBytes : Longint;
  187. Procedure FillInputBuffer;
  188. Procedure WriteOutputBuffer;
  189. Procedure FlushOutput;
  190. Procedure PutChar(B : Byte);
  191. procedure PutCode(Code : Smallint);
  192. Procedure InitializeCodeTable;
  193. Procedure Prune(Parent : Word);
  194. Procedure Clear_Table;
  195. Procedure Table_Add(Prefix : Word; Suffix : Byte);
  196. function Table_Lookup(TargetPrefix : Smallint;
  197. TargetSuffix : Byte;
  198. Out FoundAt : Smallint) : Boolean;
  199. Procedure Shrink(Suffix : Smallint);
  200. Procedure ProcessLine(Const Source : String);
  201. Procedure DoOnProgress(Const Pct : Double); Virtual;
  202. Public
  203. Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord); override;
  204. Destructor Destroy; override;
  205. Procedure Compress; override;
  206. Class Function ZipID : Word; override;
  207. Class Function ZipVersionReqd : Word; override;
  208. Function ZipBitFlag : Word; override;
  209. end;
  210. { TDeflater }
  211. TDeflater = Class(TCompressor)
  212. private
  213. FCompressionLevel: TCompressionlevel;
  214. Public
  215. Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord);override;
  216. Procedure Compress; override;
  217. Class Function ZipID : Word; override;
  218. Class Function ZipVersionReqd : Word; override;
  219. Function ZipBitFlag : Word; override;
  220. Property CompressionLevel : TCompressionlevel Read FCompressionLevel Write FCompressionLevel;
  221. end;
  222. { TInflater }
  223. TInflater = Class(TDeCompressor)
  224. Public
  225. Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord);override;
  226. Procedure DeCompress; override;
  227. Class Function ZipID : Word; override;
  228. end;
  229. { TZipFileEntry }
  230. TZipFileEntry = Class(TCollectionItem)
  231. private
  232. FArchiveFileName: String;
  233. FAttributes: LongInt;
  234. FDateTime: TDateTime;
  235. FDiskFileName: String;
  236. FHeaderPos: Longint;
  237. FOS: Byte;
  238. FSize: Integer;
  239. FStream: TStream;
  240. FCompressionLevel: TCompressionlevel;
  241. function GetArchiveFileName: String;
  242. Protected
  243. Property HdrPos : Longint Read FHeaderPos Write FheaderPos;
  244. Public
  245. constructor Create(ACollection: TCollection); override;
  246. function IsDirectory: Boolean;
  247. function IsLink: Boolean;
  248. Procedure Assign(Source : TPersistent); override;
  249. Property Stream : TStream Read FStream Write FStream;
  250. Published
  251. Property ArchiveFileName : String Read GetArchiveFileName Write FArchiveFileName;
  252. Property DiskFileName : String Read FDiskFileName Write FDiskFileName;
  253. Property Size : Integer Read FSize Write FSize;
  254. Property DateTime : TDateTime Read FDateTime Write FDateTime;
  255. property OS: Byte read FOS write FOS;
  256. property Attributes: LongInt read FAttributes write FAttributes;
  257. Property CompressionLevel: TCompressionlevel read FCompressionLevel write FCompressionLevel;
  258. end;
  259. { TZipFileEntries }
  260. TZipFileEntries = Class(TCollection)
  261. private
  262. function GetZ(AIndex : Integer): TZipFileEntry;
  263. procedure SetZ(AIndex : Integer; const AValue: TZipFileEntry);
  264. Public
  265. Function AddFileEntry(Const ADiskFileName : String): TZipFileEntry;
  266. Function AddFileEntry(Const ADiskFileName, AArchiveFileName : String): TZipFileEntry;
  267. Function AddFileEntry(Const AStream : TSTream; Const AArchiveFileName : String): TZipFileEntry;
  268. Procedure AddFileEntries(Const List : TStrings);
  269. Property Entries[AIndex : Integer] : TZipFileEntry Read GetZ Write SetZ; default;
  270. end;
  271. { TZipper }
  272. TZipper = Class(TObject)
  273. Private
  274. FEntries: TZipFileEntries;
  275. FZipping : Boolean;
  276. FBufSize : LongWord;
  277. FFileName : String; { Name of resulting Zip file }
  278. FFileComment: String;
  279. FFiles : TStrings;
  280. FInMemSize : Integer;
  281. FOutStream : TStream;
  282. FInFile : TStream; { I/O file variables }
  283. LocalHdr : Local_File_Header_Type;
  284. CentralHdr : Central_File_Header_Type;
  285. EndHdr : End_of_Central_Dir_Type;
  286. FOnPercent : LongInt;
  287. FOnProgress : TProgressEvent;
  288. FOnEndOfFile : TOnEndOfFileEvent;
  289. FOnStartFile : TOnStartFileEvent;
  290. function CheckEntries: Integer;
  291. procedure SetEntries(const AValue: TZipFileEntries);
  292. Protected
  293. Procedure CloseInput(Item : TZipFileEntry);
  294. Procedure StartZipFile(Item : TZipFileEntry);
  295. Function UpdateZipHeader(Item : TZipFileEntry; FZip : TStream; ACRC : LongWord;AMethod : Word; AZipVersionReqd : Word; AZipBitFlag : Word) : Boolean;
  296. Procedure BuildZipDirectory;
  297. Procedure DoEndOfFile;
  298. Procedure ZipOneFile(Item : TZipFileEntry); virtual;
  299. Function OpenInput(Item : TZipFileEntry) : Boolean;
  300. Procedure GetFileInfo;
  301. Procedure SetBufSize(Value : LongWord);
  302. Procedure SetFileName(Value : String);
  303. Function CreateCompressor(Item : TZipFileEntry; AinFile,AZipStream : TStream) : TCompressor; virtual;
  304. Public
  305. Constructor Create;
  306. Destructor Destroy;override;
  307. Procedure ZipAllFiles; virtual;
  308. Procedure SaveToFile(AFileName: string);
  309. Procedure SaveToStream(AStream: TStream);
  310. Procedure ZipFiles(AFileName : String; FileList : TStrings);
  311. Procedure ZipFiles(FileList : TStrings);
  312. Procedure ZipFiles(AFileName : String; Entries : TZipFileEntries);
  313. Procedure ZipFiles(Entries : TZipFileEntries);
  314. Procedure Clear;
  315. Public
  316. Property BufferSize : LongWord Read FBufSize Write SetBufSize;
  317. Property OnPercent : Integer Read FOnPercent Write FOnPercent;
  318. Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
  319. Property OnStartFile : TOnStartFileEvent Read FOnStartFile Write FOnStartFile;
  320. Property OnEndFile : TOnEndOfFileEvent Read FOnEndOfFile Write FOnEndOfFile;
  321. Property FileName : String Read FFileName Write SetFileName;
  322. Property FileComment: String Read FFileComment Write FFileComment;
  323. // Deprecated. Use Entries.AddFileEntry(FileName) or Entries.AddFileEntries(List) instead.
  324. Property Files : TStrings Read FFiles; deprecated;
  325. Property InMemSize : Integer Read FInMemSize Write FInMemSize;
  326. Property Entries : TZipFileEntries Read FEntries Write SetEntries;
  327. end;
  328. { TFullZipFileEntry }
  329. TFullZipFileEntry = Class(TZipFileEntry)
  330. private
  331. FCompressedSize: LongInt;
  332. FCompressMethod: Word;
  333. FCRC32: LongWord;
  334. Public
  335. Property CompressMethod : Word Read FCompressMethod;
  336. Property CompressedSize : LongInt Read FCompressedSize;
  337. property CRC32: LongWord read FCRC32 write FCRC32;
  338. end;
  339. TOnCustomStreamEvent = Procedure(Sender : TObject; var AStream : TStream; AItem : TFullZipFileEntry) of object;
  340. TCustomInputStreamEvent = Procedure(Sender: TObject; var AStream: TStream) of object;
  341. { TFullZipFileEntries }
  342. TFullZipFileEntries = Class(TZipFileEntries)
  343. private
  344. function GetFZ(AIndex : Integer): TFullZipFileEntry;
  345. procedure SetFZ(AIndex : Integer; const AValue: TFullZipFileEntry);
  346. Public
  347. Property FullEntries[AIndex : Integer] : TFullZipFileEntry Read GetFZ Write SetFZ; default;
  348. end;
  349. { TUnZipper }
  350. TUnZipper = Class(TObject)
  351. Private
  352. FOnCloseInputStream: TCustomInputStreamEvent;
  353. FOnCreateStream: TOnCustomStreamEvent;
  354. FOnDoneStream: TOnCustomStreamEvent;
  355. FOnOpenInputStream: TCustomInputStreamEvent;
  356. FUnZipping : Boolean;
  357. FBufSize : LongWord;
  358. FFileName : String; { Name of resulting Zip file }
  359. FOutputPath : String;
  360. FFileComment: String;
  361. FEntries : TFullZipFileEntries;
  362. FFiles : TStrings;
  363. FZipStream : TStream; { I/O file variables }
  364. LocalHdr : Local_File_Header_Type;
  365. CentralHdr : Central_File_Header_Type;
  366. EndHdr : End_of_Central_Dir_Type;
  367. FOnPercent : LongInt;
  368. FOnProgress : TProgressEvent;
  369. FOnEndOfFile : TOnEndOfFileEvent;
  370. FOnStartFile : TOnStartFileEvent;
  371. Protected
  372. Procedure OpenInput;
  373. Procedure CloseOutput(Item : TFullZipFileEntry; var OutStream: TStream);
  374. Procedure CloseInput;
  375. Procedure ReadZipDirectory;
  376. Procedure ReadZipHeader(Item : TFullZipFileEntry; out AMethod : Word);
  377. Procedure DoEndOfFile;
  378. Procedure UnZipOneFile(Item : TFullZipFileEntry); virtual;
  379. Function OpenOutput(OutFileName : String; var OutStream: TStream; Item : TFullZipFileEntry) : Boolean;
  380. Procedure SetBufSize(Value : LongWord);
  381. Procedure SetFileName(Value : String);
  382. Procedure SetOutputPath(Value:String);
  383. Function CreateDeCompressor(Item : TZipFileEntry; AMethod : Word;AZipFile,AOutFile : TStream) : TDeCompressor; virtual;
  384. Public
  385. Constructor Create;
  386. Destructor Destroy;override;
  387. Procedure UnZipAllFiles; virtual;
  388. Procedure UnZipFiles(AFileName : String; FileList : TStrings);
  389. Procedure UnZipFiles(FileList : TStrings);
  390. Procedure UnZipAllFiles(AFileName : String);
  391. Procedure Clear;
  392. Procedure Examine;
  393. Public
  394. Property BufferSize : LongWord Read FBufSize Write SetBufSize;
  395. Property OnOpenInputStream: TCustomInputStreamEvent read FOnOpenInputStream write FOnOpenInputStream;
  396. Property OnCloseInputStream: TCustomInputStreamEvent read FOnCloseInputStream write FOnCloseInputStream;
  397. Property OnCreateStream : TOnCustomStreamEvent Read FOnCreateStream Write FOnCreateStream;
  398. Property OnDoneStream : TOnCustomStreamEvent Read FOnDoneStream Write FOnDoneStream;
  399. Property OnPercent : Integer Read FOnPercent Write FOnPercent;
  400. Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
  401. Property OnStartFile : TOnStartFileEvent Read FOnStartFile Write FOnStartFile;
  402. Property OnEndFile : TOnEndOfFileEvent Read FOnEndOfFile Write FOnEndOfFile;
  403. Property FileName : String Read FFileName Write SetFileName;
  404. Property OutputPath : String Read FOutputPath Write SetOutputPath;
  405. Property FileComment: String Read FFileComment;
  406. Property Files : TStrings Read FFiles;
  407. Property Entries : TFullZipFileEntries Read FEntries;
  408. end;
  409. EZipError = Class(Exception);
  410. Implementation
  411. ResourceString
  412. SErrBufsizeChange = 'Changing buffer size is not allowed while (un)zipping';
  413. SErrFileChange = 'Changing output file name is not allowed while (un)zipping';
  414. SErrInvalidCRC = 'Invalid CRC checksum while unzipping %s';
  415. SErrCorruptZIP = 'Corrupt ZIP file %s';
  416. SErrUnsupportedCompressionFormat = 'Unsupported compression format %d';
  417. SErrMissingFileName = 'Missing filename in entry %d';
  418. SErrMissingArchiveName = 'Missing archive filename in streamed entry %d';
  419. SErrFileDoesNotExist = 'File "%s" does not exist.';
  420. SErrNoFileName = 'No archive filename for examine operation.';
  421. SErrNoStream = 'No stream is opened.';
  422. { ---------------------------------------------------------------------
  423. Auxiliary
  424. ---------------------------------------------------------------------}
  425. {$IFDEF FPC_BIG_ENDIAN}
  426. function SwapLFH(const Values: Local_File_Header_Type): Local_File_Header_Type;
  427. begin
  428. with Values do
  429. begin
  430. Result.Signature := SwapEndian(Signature);
  431. Result.Extract_Version_Reqd := SwapEndian(Extract_Version_Reqd);
  432. Result.Bit_Flag := SwapEndian(Bit_Flag);
  433. Result.Compress_Method := SwapEndian(Compress_Method);
  434. Result.Last_Mod_Time := SwapEndian(Last_Mod_Time);
  435. Result.Last_Mod_Date := SwapEndian(Last_Mod_Date);
  436. Result.Crc32 := SwapEndian(Crc32);
  437. Result.Compressed_Size := SwapEndian(Compressed_Size);
  438. Result.Uncompressed_Size := SwapEndian(Uncompressed_Size);
  439. Result.Filename_Length := SwapEndian(Filename_Length);
  440. Result.Extra_Field_Length := SwapEndian(Extra_Field_Length);
  441. end;
  442. end;
  443. function SwapCFH(const Values: Central_File_Header_Type): Central_File_Header_Type;
  444. begin
  445. with Values do
  446. begin
  447. Result.Signature := SwapEndian(Signature);
  448. Result.MadeBy_Version := SwapEndian(MadeBy_Version);
  449. Result.Extract_Version_Reqd := SwapEndian(Extract_Version_Reqd);
  450. Result.Bit_Flag := SwapEndian(Bit_Flag);
  451. Result.Compress_Method := SwapEndian(Compress_Method);
  452. Result.Last_Mod_Time := SwapEndian(Last_Mod_Time);
  453. Result.Last_Mod_Date := SwapEndian(Last_Mod_Date);
  454. Result.Crc32 := SwapEndian(Crc32);
  455. Result.Compressed_Size := SwapEndian(Compressed_Size);
  456. Result.Uncompressed_Size := SwapEndian(Uncompressed_Size);
  457. Result.Filename_Length := SwapEndian(Filename_Length);
  458. Result.Extra_Field_Length := SwapEndian(Extra_Field_Length);
  459. Result.File_Comment_Length := SwapEndian(File_Comment_Length);
  460. Result.Starting_Disk_Num := SwapEndian(Starting_Disk_Num);
  461. Result.Internal_Attributes := SwapEndian(Internal_Attributes);
  462. Result.External_Attributes := SwapEndian(External_Attributes);
  463. Result.Local_Header_Offset := SwapEndian(Local_Header_Offset);
  464. end;
  465. end;
  466. function SwapECD(const Values: End_of_Central_Dir_Type): End_of_Central_Dir_Type;
  467. begin
  468. with Values do
  469. begin
  470. Result.Signature := SwapEndian(Signature);
  471. Result.Disk_Number := SwapEndian(Disk_Number);
  472. Result.Central_Dir_Start_Disk := SwapEndian(Central_Dir_Start_Disk);
  473. Result.Entries_This_Disk := SwapEndian(Entries_This_Disk);
  474. Result.Total_Entries := SwapEndian(Total_Entries);
  475. Result.Central_Dir_Size := SwapEndian(Central_Dir_Size);
  476. Result.Start_Disk_Offset := SwapEndian(Start_Disk_Offset);
  477. Result.ZipFile_Comment_Length := SwapEndian(ZipFile_Comment_Length);
  478. end;
  479. end;
  480. {$ENDIF FPC_BIG_ENDIAN}
  481. Procedure DateTimeToZipDateTime(DT : TDateTime; out ZD,ZT : Word);
  482. Var
  483. Y,M,D,H,N,S,MS : Word;
  484. begin
  485. DecodeDate(DT,Y,M,D);
  486. DecodeTime(DT,H,N,S,MS);
  487. Y:=Y-1980;
  488. ZD:=d+(32*M)+(512*Y);
  489. ZT:=(S div 2)+(32*N)+(2048*h);
  490. end;
  491. Procedure ZipDateTimeToDateTime(ZD,ZT : Word;out DT : TDateTime);
  492. Var
  493. Y,M,D,H,N,S,MS : Word;
  494. begin
  495. MS:=0;
  496. S:=(ZT and 31) shl 1;
  497. N:=(ZT shr 5) and 63;
  498. H:=(ZT shr 12) and 31;
  499. D:=ZD and 31;
  500. M:=(ZD shr 5) and 15;
  501. Y:=((ZD shr 9) and 127)+1980;
  502. if M < 1 then M := 1;
  503. if D < 1 then D := 1;
  504. DT:=ComposeDateTime(EncodeDate(Y,M,D),EncodeTime(H,N,S,MS));
  505. end;
  506. const
  507. OS_FAT = 0;
  508. OS_UNIX = 3;
  509. UNIX_MASK = $F000;
  510. UNIX_FIFO = $1000;
  511. UNIX_CHAR = $2000;
  512. UNIX_DIR = $4000;
  513. UNIX_BLK = $6000;
  514. UNIX_FILE = $8000;
  515. UNIX_LINK = $A000;
  516. UNIX_SOCK = $C000;
  517. UNIX_RUSR = $0100;
  518. UNIX_WUSR = $0080;
  519. UNIX_XUSR = $0040;
  520. UNIX_RGRP = $0020;
  521. UNIX_WGRP = $0010;
  522. UNIX_XGRP = $0008;
  523. UNIX_ROTH = $0004;
  524. UNIX_WOTH = $0002;
  525. UNIX_XOTH = $0001;
  526. UNIX_DEFAULT = UNIX_RUSR or UNIX_WUSR or UNIX_XUSR or UNIX_RGRP or UNIX_ROTH;
  527. function ZipUnixAttrsToFatAttrs(const Name: String; Attrs: Longint): Longint;
  528. begin
  529. Result := faArchive;
  530. if (Pos('.', Name) = 1) and (Name <> '.') and (Name <> '..') then
  531. Result := Result + faHidden;
  532. case (Attrs and UNIX_MASK) of
  533. UNIX_DIR: Result := Result + faDirectory;
  534. UNIX_LINK: Result := Result + faSymLink;
  535. UNIX_FIFO, UNIX_CHAR, UNIX_BLK, UNIX_SOCK:
  536. Result := Result + faSysFile;
  537. end;
  538. if (Attrs and UNIX_WUSR) = 0 then
  539. Result := Result + faReadOnly;
  540. end;
  541. function ZipFatAttrsToUnixAttrs(Attrs: Longint): Longint;
  542. begin
  543. Result := UNIX_DEFAULT;
  544. if (faReadOnly and Attrs) > 0 then
  545. Result := Result and not (UNIX_WUSR);
  546. if (faSymLink and Attrs) > 0 then
  547. Result := Result or UNIX_LINK
  548. else
  549. if (faDirectory and Attrs) > 0 then
  550. Result := Result or UNIX_DIR
  551. else
  552. Result := Result or UNIX_FILE;
  553. end;
  554. { ---------------------------------------------------------------------
  555. TDeCompressor
  556. ---------------------------------------------------------------------}
  557. Procedure TDeCompressor.UpdC32(Octet: Byte);
  558. Begin
  559. FCrc32Val := Crc_32_Tab[Byte(FCrc32Val XOR LongInt(Octet))] XOR ((FCrc32Val SHR 8) AND $00FFFFFF);
  560. end;
  561. constructor TDeCompressor.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
  562. begin
  563. FinFile:=AInFile;
  564. FoutFile:=AOutFile;
  565. FBufferSize:=ABufSize;
  566. CRC32Val:=$FFFFFFFF;
  567. end;
  568. { ---------------------------------------------------------------------
  569. TCompressor
  570. ---------------------------------------------------------------------}
  571. Procedure TCompressor.UpdC32(Octet: Byte);
  572. Begin
  573. FCrc32Val := Crc_32_Tab[Byte(FCrc32Val XOR LongInt(Octet))] XOR ((FCrc32Val SHR 8) AND $00FFFFFF);
  574. end;
  575. constructor TCompressor.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
  576. begin
  577. FinFile:=AInFile;
  578. FoutFile:=AOutFile;
  579. FBufferSize:=ABufSize;
  580. CRC32Val:=$FFFFFFFF;
  581. end;
  582. { ---------------------------------------------------------------------
  583. TDeflater
  584. ---------------------------------------------------------------------}
  585. constructor TDeflater.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
  586. begin
  587. Inherited;
  588. FCompressionLevel:=clDefault;
  589. end;
  590. procedure TDeflater.Compress;
  591. Var
  592. Buf : PByte;
  593. I,Count,NewCount : Integer;
  594. C : TCompressionStream;
  595. BytesNow : Integer;
  596. NextMark : Integer;
  597. OnBytes : Integer;
  598. FSize : Integer;
  599. begin
  600. CRC32Val:=$FFFFFFFF;
  601. Buf:=GetMem(FBufferSize);
  602. if FOnPercent = 0 then
  603. FOnPercent := 1;
  604. OnBytes:=Round((FInFile.Size * FOnPercent) / 100);
  605. BytesNow:=0; NextMark := OnBytes;
  606. FSize:=FInfile.Size;
  607. Try
  608. C:=TCompressionStream.Create(FCompressionLevel,FOutFile,True);
  609. Try
  610. if assigned(FOnProgress) then
  611. fOnProgress(self,0);
  612. Repeat
  613. Count:=FInFile.Read(Buf^,FBufferSize);
  614. For I:=0 to Count-1 do
  615. UpdC32(Buf[i]);
  616. NewCount:=Count;
  617. While (NewCount>0) do
  618. NewCount:=NewCount-C.Write(Buf^,NewCount);
  619. inc(BytesNow,Count);
  620. if BytesNow>NextMark Then
  621. begin
  622. if (FSize>0) and assigned(FOnProgress) Then
  623. FOnProgress(self,100 * ( BytesNow / FSize));
  624. inc(NextMark,OnBytes);
  625. end;
  626. Until (Count=0);
  627. Finally
  628. C.Free;
  629. end;
  630. Finally
  631. FreeMem(Buf);
  632. end;
  633. if assigned(FOnProgress) then
  634. fOnProgress(self,100.0);
  635. Crc32Val:=NOT Crc32Val;
  636. end;
  637. class function TDeflater.ZipID: Word;
  638. begin
  639. Result:=8;
  640. end;
  641. class function TDeflater.ZipVersionReqd: Word;
  642. begin
  643. Result:=20;
  644. end;
  645. function TDeflater.ZipBitFlag: Word;
  646. begin
  647. case CompressionLevel of
  648. clnone: Result := %110;
  649. clfastest: Result := %100;
  650. cldefault: Result := %000;
  651. clmax: Result := %010;
  652. else
  653. Result := 0;
  654. end;
  655. end;
  656. { ---------------------------------------------------------------------
  657. TInflater
  658. ---------------------------------------------------------------------}
  659. constructor TInflater.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
  660. begin
  661. Inherited;
  662. end;
  663. procedure TInflater.DeCompress;
  664. Var
  665. Buf : PByte;
  666. I,Count : Integer;
  667. C : TDeCompressionStream;
  668. BytesNow : Integer;
  669. NextMark : Integer;
  670. OnBytes : Integer;
  671. FSize : Integer;
  672. begin
  673. CRC32Val:=$FFFFFFFF;
  674. if FOnPercent = 0 then
  675. FOnPercent := 1;
  676. OnBytes:=Round((FInFile.Size * FOnPercent) / 100);
  677. BytesNow:=0; NextMark := OnBytes;
  678. FSize:=FInfile.Size;
  679. If Assigned(FOnProgress) then
  680. fOnProgress(self,0);
  681. Buf:=GetMem(FBufferSize);
  682. Try
  683. C:=TDeCompressionStream.Create(FInFile,True);
  684. Try
  685. Repeat
  686. Count:=C.Read(Buf^,FBufferSize);
  687. For I:=0 to Count-1 do
  688. UpdC32(Buf[i]);
  689. FOutFile.Write(Buf^,Count);
  690. inc(BytesNow,Count);
  691. if BytesNow>NextMark Then
  692. begin
  693. if (FSize>0) and assigned(FOnProgress) Then
  694. FOnProgress(self,100 * ( BytesNow / FSize));
  695. inc(NextMark,OnBytes);
  696. end;
  697. Until (Count=0);
  698. Finally
  699. C.Free;
  700. end;
  701. Finally
  702. FreeMem(Buf);
  703. end;
  704. if assigned(FOnProgress) then
  705. fOnProgress(self,100.0);
  706. Crc32Val:=NOT Crc32Val;
  707. end;
  708. class function TInflater.ZipID: Word;
  709. begin
  710. Result:=8;
  711. end;
  712. { ---------------------------------------------------------------------
  713. TShrinker
  714. ---------------------------------------------------------------------}
  715. Const
  716. DefaultInMemSize = 256*1024; { Files larger than 256k are processed on disk }
  717. DefaultBufSize = 16384; { Use 16K file buffers }
  718. MINBITS = 9; { Starting code size of 9 bits }
  719. MAXBITS = 13; { Maximum code size of 13 bits }
  720. SPECIAL = 256; { Special function code }
  721. INCSIZE = 1; { Code indicating a jump in code size }
  722. CLEARCODE = 2; { Code indicating code table has been cleared }
  723. STDATTR = faAnyFile; { Standard file attribute for DOS Find First/Next }
  724. constructor TShrinker.Create(AInFile, AOutFile : TStream; ABufSize : LongWord);
  725. begin
  726. Inherited;
  727. FBufSize:=ABufSize;
  728. InBuf:=GetMem(FBUFSIZE);
  729. OutBuf:=GetMem(FBUFSIZE);
  730. CodeTable:=GetMem(SizeOf(CodeTable^));
  731. FreeList:=GetMem(SizeOf(FreeList^));
  732. end;
  733. destructor TShrinker.Destroy;
  734. begin
  735. FreeMem(CodeTable);
  736. FreeMem(FreeList);
  737. FreeMem(InBuf);
  738. FreeMem(OutBuf);
  739. inherited Destroy;
  740. end;
  741. Procedure TShrinker.Compress;
  742. Var
  743. OneString : String;
  744. Remaining : Word;
  745. begin
  746. BytesIn := 1;
  747. BytesOut := 1;
  748. InitializeCodeTable;
  749. FillInputBuffer;
  750. FirstCh:= TRUE;
  751. Crc32Val:=$FFFFFFFF;
  752. FOnBytes:=Round((FInFile.Size * FOnPercent) / 100);
  753. While NOT InputEof do
  754. begin
  755. Remaining:=Succ(MaxInBufIdx - InBufIdx);
  756. If Remaining>255 then
  757. Remaining:=255;
  758. If Remaining=0 then
  759. FillInputBuffer
  760. else
  761. begin
  762. SetLength(OneString,Remaining);
  763. Move(InBuf[InBufIdx], OneString[1], Remaining);
  764. Inc(InBufIdx, Remaining);
  765. ProcessLine(OneString);
  766. end;
  767. end;
  768. Crc32Val := NOT Crc32Val;
  769. ProcessLine('');
  770. end;
  771. class function TShrinker.ZipID: Word;
  772. begin
  773. Result:=1;
  774. end;
  775. class function TShrinker.ZipVersionReqd: Word;
  776. begin
  777. Result:=10;
  778. end;
  779. function TShrinker.ZipBitFlag: Word;
  780. begin
  781. Result:=0;
  782. end;
  783. Procedure TShrinker.DoOnProgress(Const Pct: Double);
  784. begin
  785. If Assigned(FOnProgress) then
  786. FOnProgress(Self,Pct);
  787. end;
  788. Procedure TShrinker.FillInputBuffer;
  789. Begin
  790. MaxInbufIDx:=FInfile.Read(InBuf[0], FBufSize);
  791. If MaxInbufIDx=0 then
  792. InputEof := TRUE
  793. else
  794. InputEOF := FALSE;
  795. InBufIdx := 0;
  796. end;
  797. Procedure TShrinker.WriteOutputBuffer;
  798. Begin
  799. FOutFile.WriteBuffer(OutBuf[0], OutBufIdx);
  800. OutBufIdx := 0;
  801. end;
  802. Procedure TShrinker.PutChar(B : Byte);
  803. Begin
  804. OutBuf[OutBufIdx] := B;
  805. Inc(OutBufIdx);
  806. If OutBufIdx>=FBufSize then
  807. WriteOutputBuffer;
  808. Inc(BytesOut);
  809. end;
  810. Procedure TShrinker.FlushOutput;
  811. Begin
  812. If OutBufIdx>0 then
  813. WriteOutputBuffer;
  814. End;
  815. procedure TShrinker.PutCode(Code : Smallint);
  816. var
  817. ACode : LongInt;
  818. XSize : Smallint;
  819. begin
  820. if (Code=-1) then
  821. begin
  822. if BitsUsed>0 then
  823. PutChar(SaveByte);
  824. end
  825. else
  826. begin
  827. ACode := Longint(Code);
  828. XSize := CodeSize+BitsUsed;
  829. ACode := (ACode shl BitsUsed) or SaveByte;
  830. while (XSize div 8) > 0 do
  831. begin
  832. PutChar(Lo(ACode));
  833. ACode := ACode shr 8;
  834. Dec(XSize,8);
  835. end;
  836. BitsUsed := XSize;
  837. SaveByte := Lo(ACode);
  838. end;
  839. end;
  840. Procedure TShrinker.InitializeCodeTable;
  841. Var
  842. I : Word;
  843. Begin
  844. For I := 0 to TableSize do
  845. begin
  846. With CodeTable^[I] do
  847. begin
  848. Child := -1;
  849. Sibling := -1;
  850. If (I<=255) then
  851. Suffix := I;
  852. end;
  853. If (I>=257) then
  854. FreeList^[I] := I;
  855. end;
  856. NextFree := FIRSTENTRY;
  857. TableFull := FALSE;
  858. end;
  859. Procedure TShrinker.Prune(Parent : Word);
  860. Var
  861. CurrChild : Smallint;
  862. NextSibling : Smallint;
  863. Begin
  864. CurrChild := CodeTable^[Parent].Child;
  865. { Find first Child that has descendants .. clear any that don't }
  866. While (CurrChild <> -1) AND (CodeTable^[CurrChild].Child = -1) do
  867. begin
  868. CodeTable^[Parent].Child := CodeTable^[CurrChild].Sibling;
  869. CodeTable^[CurrChild].Sibling := -1;
  870. { Turn on ClearList bit to indicate a cleared entry }
  871. ClearList[CurrChild DIV 8] := (ClearList[CurrChild DIV 8] OR (1 SHL (CurrChild MOD 8)));
  872. CurrChild := CodeTable^[Parent].Child;
  873. end;
  874. If CurrChild <> -1 then
  875. begin { If there are any children left ...}
  876. Prune(CurrChild);
  877. NextSibling := CodeTable^[CurrChild].Sibling;
  878. While NextSibling <> -1 do
  879. begin
  880. If CodeTable^[NextSibling].Child = -1 then
  881. begin
  882. CodeTable^[CurrChild].Sibling := CodeTable^[NextSibling].Sibling;
  883. CodeTable^[NextSibling].Sibling := -1;
  884. { Turn on ClearList bit to indicate a cleared entry }
  885. ClearList[NextSibling DIV 8] := (ClearList[NextSibling DIV 8] OR (1 SHL (NextSibling MOD 8)));
  886. NextSibling := CodeTable^[CurrChild].Sibling;
  887. end
  888. else
  889. begin
  890. CurrChild := NextSibling;
  891. Prune(CurrChild);
  892. NextSibling := CodeTable^[CurrChild].Sibling;
  893. end;
  894. end;
  895. end;
  896. end;
  897. Procedure TShrinker.Clear_Table;
  898. Var
  899. Node : Word;
  900. Begin
  901. FillChar(ClearList, SizeOf(ClearList), $00);
  902. For Node := 0 to 255 do
  903. Prune(Node);
  904. NextFree := Succ(TABLESIZE);
  905. For Node := TABLESIZE downto FIRSTENTRY do
  906. begin
  907. If (ClearList[Node DIV 8] AND (1 SHL (Node MOD 8))) <> 0 then
  908. begin
  909. Dec(NextFree);
  910. FreeList^[NextFree] := Node;
  911. end;
  912. end;
  913. If NextFree <= TABLESIZE then
  914. TableFull := FALSE;
  915. end;
  916. Procedure TShrinker.Table_Add(Prefix : Word; Suffix : Byte);
  917. Var
  918. FreeNode : Word;
  919. Begin
  920. If NextFree <= TABLESIZE then
  921. begin
  922. FreeNode := FreeList^[NextFree];
  923. Inc(NextFree);
  924. CodeTable^[FreeNode].Child := -1;
  925. CodeTable^[FreeNode].Sibling := -1;
  926. CodeTable^[FreeNode].Suffix := Suffix;
  927. If CodeTable^[Prefix].Child = -1 then
  928. CodeTable^[Prefix].Child := FreeNode
  929. else
  930. begin
  931. Prefix := CodeTable^[Prefix].Child;
  932. While CodeTable^[Prefix].Sibling <> -1 do
  933. Prefix := CodeTable^[Prefix].Sibling;
  934. CodeTable^[Prefix].Sibling := FreeNode;
  935. end;
  936. end;
  937. if NextFree > TABLESIZE then
  938. TableFull := TRUE;
  939. end;
  940. function TShrinker.Table_Lookup( TargetPrefix : Smallint;
  941. TargetSuffix : Byte;
  942. Out FoundAt : Smallint ) : Boolean;
  943. var TempPrefix : Smallint;
  944. begin
  945. TempPrefix := TargetPrefix;
  946. Table_lookup := False;
  947. if CodeTable^[TempPrefix].Child <> -1 then
  948. begin
  949. TempPrefix := CodeTable^[TempPrefix].Child;
  950. repeat
  951. if CodeTable^[TempPrefix].Suffix = TargetSuffix then
  952. begin
  953. Table_lookup := True;
  954. break;
  955. end;
  956. if CodeTable^[TempPrefix].Sibling = -1 then
  957. break;
  958. TempPrefix := CodeTable^[TempPrefix].Sibling;
  959. until False;
  960. end;
  961. if Table_Lookup then
  962. FoundAt := TempPrefix
  963. else
  964. FoundAt := -1;
  965. end;
  966. Procedure TShrinker.Shrink(Suffix : Smallint);
  967. Const
  968. LastCode : Smallint = 0;
  969. Var
  970. WhereFound : Smallint;
  971. Begin
  972. If FirstCh then
  973. begin
  974. SaveByte := $00;
  975. BitsUsed := 0;
  976. CodeSize := MINBITS;
  977. MaxCode := (1 SHL CodeSize) - 1;
  978. LastCode := Suffix;
  979. FirstCh := FALSE;
  980. end
  981. else
  982. begin
  983. If Suffix <> -1 then
  984. begin
  985. If TableFull then
  986. begin
  987. Putcode(LastCode);
  988. PutCode(SPECIAL);
  989. Putcode(CLEARCODE);
  990. Clear_Table;
  991. Table_Add(LastCode, Suffix);
  992. LastCode := Suffix;
  993. end
  994. else
  995. begin
  996. If Table_Lookup(LastCode, Suffix, WhereFound) then
  997. begin
  998. LastCode := WhereFound;
  999. end
  1000. else
  1001. begin
  1002. PutCode(LastCode);
  1003. Table_Add(LastCode, Suffix);
  1004. LastCode := Suffix;
  1005. If (FreeList^[NextFree] > MaxCode) and (CodeSize < MaxBits) then
  1006. begin
  1007. PutCode(SPECIAL);
  1008. PutCode(INCSIZE);
  1009. Inc(CodeSize);
  1010. MaxCode := (1 SHL CodeSize) -1;
  1011. end;
  1012. end;
  1013. end;
  1014. end
  1015. else
  1016. begin
  1017. PutCode(LastCode);
  1018. PutCode(-1);
  1019. FlushOutput;
  1020. end;
  1021. end;
  1022. end;
  1023. Procedure TShrinker.ProcessLine(Const Source : String);
  1024. Var
  1025. I : Word;
  1026. Begin
  1027. If Source = '' then
  1028. Shrink(-1)
  1029. else
  1030. For I := 1 to Length(Source) do
  1031. begin
  1032. Inc(BytesIn);
  1033. If (Pred(BytesIn) MOD FOnBytes) = 0 then
  1034. DoOnProgress(100 * ( BytesIn / FInFile.Size));
  1035. UpdC32(Ord(Source[I]));
  1036. Shrink(Ord(Source[I]));
  1037. end;
  1038. end;
  1039. { ---------------------------------------------------------------------
  1040. TZipper
  1041. ---------------------------------------------------------------------}
  1042. Procedure TZipper.GetFileInfo;
  1043. Var
  1044. F : TZipFileEntry;
  1045. Info : TSearchRec;
  1046. I : Longint;
  1047. {$IFDEF UNIX}
  1048. UnixInfo: Stat;
  1049. {$ENDIF}
  1050. Begin
  1051. For I := 0 to FEntries.Count-1 do
  1052. begin
  1053. F:=FEntries[i];
  1054. If F.Stream=Nil then
  1055. begin
  1056. If (F.DiskFileName='') then
  1057. Raise EZipError.CreateFmt(SErrMissingFileName,[I]);
  1058. If FindFirst(F.DiskFileName, STDATTR, Info)=0 then
  1059. try
  1060. F.Size:=Info.Size;
  1061. F.DateTime:=FileDateToDateTime(Info.Time);
  1062. {$IFDEF UNIX}
  1063. if fplstat(F.DiskFileName, @UnixInfo) = 0 then
  1064. F.Attributes := UnixInfo.st_mode;
  1065. {$ELSE}
  1066. F.Attributes := Info.Attr;
  1067. {$ENDIF}
  1068. finally
  1069. FindClose(Info);
  1070. end
  1071. else
  1072. Raise EZipError.CreateFmt(SErrFileDoesNotExist,[F.DiskFileName]);
  1073. end
  1074. else
  1075. begin
  1076. If (F.ArchiveFileName='') then
  1077. Raise EZipError.CreateFmt(SErrMissingArchiveName,[I]);
  1078. F.Size:=F.Stream.Size;
  1079. {$IFDEF UNIX}
  1080. F.Attributes := UNIX_FILE or UNIX_DEFAULT;
  1081. {$ELSE}
  1082. F.Attributes := faArchive;
  1083. {$ENDIF}
  1084. end;
  1085. end;
  1086. end;
  1087. procedure TZipper.SetEntries(const AValue: TZipFileEntries);
  1088. begin
  1089. if FEntries=AValue then exit;
  1090. FEntries.Assign(AValue);
  1091. end;
  1092. Function TZipper.OpenInput(Item : TZipFileEntry) : Boolean;
  1093. Begin
  1094. If (Item.Stream<>nil) then
  1095. FInFile:=Item.Stream
  1096. else
  1097. if Item.IsDirectory then
  1098. FInFile := TStringStream.Create('')
  1099. else
  1100. FInFile:=TFileStream.Create(Item.DiskFileName,fmOpenRead);
  1101. Result:=True;
  1102. If Assigned(FOnStartFile) then
  1103. FOnStartFile(Self,Item.ArchiveFileName);
  1104. End;
  1105. Procedure TZipper.CloseInput(Item : TZipFileEntry);
  1106. Begin
  1107. If (FInFile<>Item.Stream) then
  1108. FreeAndNil(FInFile)
  1109. else
  1110. FinFile:=Nil;
  1111. DoEndOfFile;
  1112. end;
  1113. Procedure TZipper.StartZipFile(Item : TZipFileEntry);
  1114. Begin
  1115. FillChar(LocalHdr,SizeOf(LocalHdr),0);
  1116. With LocalHdr do
  1117. begin
  1118. Signature := LOCAL_FILE_HEADER_SIGNATURE;
  1119. Extract_Version_Reqd := 10;
  1120. Bit_Flag := 0;
  1121. Compress_Method := 1;
  1122. DateTimeToZipDateTime(Item.DateTime,Last_Mod_Date,Last_Mod_Time);
  1123. Crc32 := 0;
  1124. Compressed_Size := 0;
  1125. Uncompressed_Size := Item.Size;
  1126. FileName_Length := 0;
  1127. Extra_Field_Length := 0;
  1128. end ;
  1129. End;
  1130. function TZipper.UpdateZipHeader(Item: TZipFileEntry; FZip: TStream;
  1131. ACRC: LongWord; AMethod: Word; AZipVersionReqd: Word; AZipBitFlag: Word
  1132. ): Boolean;
  1133. var
  1134. ZFileName : ShortString;
  1135. Begin
  1136. ZFileName:=Item.ArchiveFileName;
  1137. With LocalHdr do
  1138. begin
  1139. FileName_Length := Length(ZFileName);
  1140. Crc32 := ACRC;
  1141. Result:=Not (Compressed_Size >= Uncompressed_Size);
  1142. If Not Result then
  1143. begin { No... }
  1144. Compress_Method := 0; { ...change stowage type }
  1145. Compressed_Size := Uncompressed_Size; { ...update compressed size }
  1146. end
  1147. else
  1148. begin
  1149. Compress_method:=AMethod;
  1150. Compressed_Size := FZip.Size;
  1151. Bit_Flag := Bit_Flag or AZipBitFlag;
  1152. if AZipVersionReqd > Extract_Version_Reqd then
  1153. Extract_Version_Reqd := AZipVersionReqd;
  1154. end;
  1155. end;
  1156. FOutStream.WriteBuffer({$IFDEF ENDIAN_BIG}SwapLFH{$ENDIF}(LocalHdr),SizeOf(LocalHdr));
  1157. FOutStream.WriteBuffer(ZFileName[1],Length(ZFileName));
  1158. End;
  1159. Procedure TZipper.BuildZipDirectory;
  1160. Var
  1161. SavePos : LongInt;
  1162. HdrPos : LongInt;
  1163. CenDirPos : LongInt;
  1164. ACount : Word;
  1165. ZFileName : ShortString;
  1166. Begin
  1167. ACount := 0;
  1168. CenDirPos := FOutStream.Position;
  1169. FOutStream.Seek(0,soFrombeginning); { Rewind output file }
  1170. HdrPos := FOutStream.Position;
  1171. FOutStream.ReadBuffer(LocalHdr, SizeOf(LocalHdr));
  1172. {$IFDEF FPC_BIG_ENDIAN}
  1173. LocalHdr := SwapLFH(LocalHdr);
  1174. {$ENDIF}
  1175. Repeat
  1176. SetLength(ZFileName,LocalHdr.FileName_Length);
  1177. FOutStream.ReadBuffer(ZFileName[1], LocalHdr.FileName_Length);
  1178. SavePos := FOutStream.Position;
  1179. FillChar(CentralHdr,SizeOf(CentralHdr),0);
  1180. With CentralHdr do
  1181. begin
  1182. Signature := CENTRAL_FILE_HEADER_SIGNATURE;
  1183. MadeBy_Version := LocalHdr.Extract_Version_Reqd;
  1184. {$IFDEF UNIX}
  1185. MadeBy_Version := MadeBy_Version or (OS_UNIX shl 8);
  1186. {$ENDIF}
  1187. Move(LocalHdr.Extract_Version_Reqd, Extract_Version_Reqd, 26);
  1188. Last_Mod_Time:=localHdr.Last_Mod_Time;
  1189. Last_Mod_Date:=localHdr.Last_Mod_Date;
  1190. File_Comment_Length := 0;
  1191. Starting_Disk_Num := 0;
  1192. Internal_Attributes := 0;
  1193. {$IFDEF UNIX}
  1194. External_Attributes := Entries[ACount].Attributes shl 16;
  1195. {$ELSE}
  1196. External_Attributes := Entries[ACount].Attributes;
  1197. {$ENDIF}
  1198. Local_Header_Offset := HdrPos;
  1199. end;
  1200. FOutStream.Seek(0,soFromEnd);
  1201. FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapCFH{$ENDIF}(CentralHdr),SizeOf(CentralHdr));
  1202. FOutStream.WriteBuffer(ZFileName[1],Length(ZFileName));
  1203. Inc(ACount);
  1204. FOutStream.Seek(SavePos + LocalHdr.Compressed_Size,soFromBeginning);
  1205. HdrPos:=FOutStream.Position;
  1206. FOutStream.ReadBuffer(LocalHdr, SizeOf(LocalHdr));
  1207. {$IFDEF FPC_BIG_ENDIAN}
  1208. LocalHdr := SwapLFH(LocalHdr);
  1209. {$ENDIF}
  1210. Until LocalHdr.Signature = CENTRAL_FILE_HEADER_SIGNATURE;
  1211. FOutStream.Seek(0,soFromEnd);
  1212. FillChar(EndHdr,SizeOf(EndHdr),0);
  1213. With EndHdr do
  1214. begin
  1215. Signature := END_OF_CENTRAL_DIR_SIGNATURE;
  1216. Disk_Number := 0;
  1217. Central_Dir_Start_Disk := 0;
  1218. Entries_This_Disk := ACount;
  1219. Total_Entries := ACount;
  1220. Central_Dir_Size := FOutStream.Size-CenDirPos;
  1221. Start_Disk_Offset := CenDirPos;
  1222. ZipFile_Comment_Length := Length(FFileComment);
  1223. FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapECD{$ENDIF}(EndHdr), SizeOf(EndHdr));
  1224. if Length(FFileComment) > 0 then
  1225. FOutStream.WriteBuffer(FFileComment[1],Length(FFileComment));
  1226. end;
  1227. end;
  1228. Function TZipper.CreateCompressor(Item : TZipFileEntry; AInFile,AZipStream : TStream) : TCompressor;
  1229. begin
  1230. Result:=TDeflater.Create(AinFile,AZipStream,FBufSize);
  1231. (Result as TDeflater).CompressionLevel:=Item.CompressionLevel;
  1232. end;
  1233. Procedure TZipper.ZipOneFile(Item : TZipFileEntry);
  1234. Var
  1235. CRC : LongWord;
  1236. ZMethod : Word;
  1237. ZVersionReqd : Word;
  1238. ZBitFlag : Word;
  1239. ZipStream : TStream;
  1240. TmpFileName : String;
  1241. Begin
  1242. OpenInput(Item);
  1243. Try
  1244. StartZipFile(Item);
  1245. If (FInfile.Size<=FInMemSize) then
  1246. ZipStream:=TMemoryStream.Create
  1247. else
  1248. begin
  1249. TmpFileName:=ChangeFileExt(FFileName,'.tmp');
  1250. ZipStream:=TFileStream.Create(TmpFileName,fmCreate);
  1251. end;
  1252. Try
  1253. With CreateCompressor(Item, FinFile,ZipStream) do
  1254. Try
  1255. OnProgress:=Self.OnProgress;
  1256. OnPercent:=Self.OnPercent;
  1257. Compress;
  1258. CRC:=Crc32Val;
  1259. ZMethod:=ZipID;
  1260. ZVersionReqd:=ZipVersionReqd;
  1261. ZBitFlag:=ZipBitFlag;
  1262. Finally
  1263. Free;
  1264. end;
  1265. If UpdateZipHeader(Item,ZipStream,CRC,ZMethod,ZVersionReqd,ZBitFlag) then
  1266. // Compressed file smaller than original file.
  1267. FOutStream.CopyFrom(ZipStream,0)
  1268. else
  1269. begin
  1270. // Original file smaller than compressed file.
  1271. FInfile.Seek(0,soFromBeginning);
  1272. FOutStream.CopyFrom(FInFile,0);
  1273. end;
  1274. finally
  1275. ZipStream.Free;
  1276. If (TmpFileName<>'') then
  1277. DeleteFile(TmpFileName);
  1278. end;
  1279. Finally
  1280. CloseInput(Item);
  1281. end;
  1282. end;
  1283. // Just like SaveToFile, but uses the FileName property
  1284. Procedure TZipper.ZipAllFiles;
  1285. Begin
  1286. SaveToFile(FileName);
  1287. end;
  1288. procedure TZipper.SaveToFile(AFileName: string);
  1289. var
  1290. lStream: TFileStream;
  1291. begin
  1292. lStream:=TFileStream.Create(FFileName,fmCreate);
  1293. try
  1294. SaveToStream(lStream);
  1295. finally
  1296. FreeAndNil(lStream);
  1297. end;
  1298. end;
  1299. procedure TZipper.SaveToStream(AStream: TStream);
  1300. Var
  1301. I : Integer;
  1302. filecnt : integer;
  1303. begin
  1304. FOutStream := AStream;
  1305. If CheckEntries=0 then
  1306. Exit;
  1307. FZipping:=True;
  1308. Try
  1309. GetFileInfo;
  1310. filecnt:=0;
  1311. for I:=0 to FEntries.Count-1 do
  1312. begin
  1313. ZipOneFile(FEntries[i]);
  1314. inc(filecnt);
  1315. end;
  1316. if filecnt>0 then
  1317. BuildZipDirectory;
  1318. finally
  1319. FZipping:=False;
  1320. // Remove entries that have been added by CheckEntries from Files.
  1321. For I:=0 to FFiles.Count-1 do
  1322. FEntries.Delete(FEntries.Count-1);
  1323. end;
  1324. end;
  1325. Procedure TZipper.SetBufSize(Value : LongWord);
  1326. begin
  1327. If FZipping then
  1328. Raise EZipError.Create(SErrBufsizeChange);
  1329. If Value>=DefaultBufSize then
  1330. FBufSize:=Value;
  1331. end;
  1332. Procedure TZipper.SetFileName(Value : String);
  1333. begin
  1334. If FZipping then
  1335. Raise EZipError.Create(SErrFileChange);
  1336. FFileName:=Value;
  1337. end;
  1338. Procedure TZipper.ZipFiles(AFileName : String; FileList : TStrings);
  1339. begin
  1340. FFileName:=AFileName;
  1341. ZipFiles(FileList);
  1342. end;
  1343. procedure TZipper.ZipFiles(FileList: TStrings);
  1344. begin
  1345. FFiles.Assign(FileList);
  1346. ZipAllFiles;
  1347. end;
  1348. procedure TZipper.ZipFiles(AFileName: String; Entries: TZipFileEntries);
  1349. begin
  1350. FFileName:=AFileName;
  1351. ZipFiles(Entries);
  1352. end;
  1353. procedure TZipper.ZipFiles(Entries: TZipFileEntries);
  1354. begin
  1355. FEntries.Assign(Entries);
  1356. ZipAllFiles;
  1357. end;
  1358. Procedure TZipper.DoEndOfFile;
  1359. Var
  1360. ComprPct : Double;
  1361. begin
  1362. If (LocalHdr.Uncompressed_Size>0) then
  1363. ComprPct := (100.0 * (LocalHdr.Uncompressed_Size - LocalHdr.Compressed_Size)) / LocalHdr.Uncompressed_Size
  1364. else
  1365. ComprPct := 0;
  1366. If Assigned(FOnEndOfFile) then
  1367. FOnEndOfFile(Self,ComprPct);
  1368. end;
  1369. Constructor TZipper.Create;
  1370. begin
  1371. FBufSize:=DefaultBufSize;
  1372. FInMemSize:=DefaultInMemSize;
  1373. FFiles:=TStringList.Create;
  1374. FEntries:=TZipFileEntries.Create(TZipFileEntry);
  1375. FOnPercent:=1;
  1376. end;
  1377. Function TZipper.CheckEntries : Integer;
  1378. Var
  1379. I : Integer;
  1380. begin
  1381. For I:=0 to FFiles.Count-1 do
  1382. FEntries.AddFileEntry(FFiles[i]);
  1383. Result:=FEntries.Count;
  1384. end;
  1385. Procedure TZipper.Clear;
  1386. begin
  1387. FEntries.Clear;
  1388. FFiles.Clear;
  1389. end;
  1390. Destructor TZipper.Destroy;
  1391. begin
  1392. Clear;
  1393. FreeAndNil(FEntries);
  1394. FreeAndNil(FFiles);
  1395. Inherited;
  1396. end;
  1397. { ---------------------------------------------------------------------
  1398. TUnZipper
  1399. ---------------------------------------------------------------------}
  1400. Procedure TUnZipper.OpenInput;
  1401. Begin
  1402. if Assigned(FOnOpenInputStream) then
  1403. FOnOpenInputStream(Self, FZipStream);
  1404. if FZipStream = nil then
  1405. FZipStream:=TFileStream.Create(FFileName,fmOpenRead);
  1406. End;
  1407. Function TUnZipper.OpenOutput(OutFileName : String; var OutStream: TStream; Item : TFullZipFileEntry) : Boolean;
  1408. Var
  1409. Path: String;
  1410. OldDirectorySeparators: set of char;
  1411. Begin
  1412. { the default RTL behaviour is broken on Unix platforms
  1413. for Windows compatibility: it allows both '/' and '\'
  1414. as directory separator. We don't want that behaviour
  1415. here, since 'abc\' is a valid file name under Unix.
  1416. (mantis 15836) On the other hand, many archives on
  1417. windows have '/' as pathseparator, even Windows
  1418. generated .odt files. So we disable this for windows.
  1419. }
  1420. OldDirectorySeparators:=AllowDirectorySeparators;
  1421. {$ifndef Windows}
  1422. AllowDirectorySeparators:=[DirectorySeparator];
  1423. {$endif}
  1424. Path:=ExtractFilePath(OutFileName);
  1425. OutStream:=Nil;
  1426. If Assigned(FOnCreateStream) then
  1427. FOnCreateStream(Self, OutStream, Item);
  1428. // If FOnCreateStream didn't create one, we create one now.
  1429. If (OutStream=Nil) then
  1430. Begin
  1431. if (Path<>'') then
  1432. ForceDirectories(Path);
  1433. AllowDirectorySeparators:=OldDirectorySeparators;
  1434. OutStream:=TFileStream.Create(OutFileName,fmCreate);
  1435. end;
  1436. AllowDirectorySeparators:=OldDirectorySeparators;
  1437. Result:=True;
  1438. If Assigned(FOnStartFile) then
  1439. FOnStartFile(Self,OutFileName);
  1440. End;
  1441. Procedure TUnZipper.CloseOutput(Item : TFullZipFileEntry; var OutStream: TStream);
  1442. Begin
  1443. if Assigned(FOnDoneStream) then
  1444. begin
  1445. FOnDoneStream(Self, OutStream, Item);
  1446. OutStream := nil;
  1447. end
  1448. else
  1449. FreeAndNil(OutStream);
  1450. DoEndOfFile;
  1451. end;
  1452. Procedure TUnZipper.CloseInput;
  1453. Begin
  1454. if Assigned(FOnCloseInputStream) then
  1455. FOnCloseInputStream(Self, FZipStream);
  1456. FreeAndNil(FZipStream);
  1457. end;
  1458. Procedure TUnZipper.ReadZipHeader(Item : TFullZipFileEntry; out AMethod : Word);
  1459. Var
  1460. S : String;
  1461. D : TDateTime;
  1462. Begin
  1463. FZipStream.Seek(Item.HdrPos,soFromBeginning);
  1464. FZipStream.ReadBuffer(LocalHdr,SizeOf(LocalHdr));
  1465. {$IFDEF FPC_BIG_ENDIAN}
  1466. LocalHdr := SwapLFH(LocalHdr);
  1467. {$ENDIF}
  1468. With LocalHdr do
  1469. begin
  1470. SetLength(S,Filename_Length);
  1471. FZipStream.ReadBuffer(S[1],Filename_Length);
  1472. //SetLength(E,Extra_Field_Length);
  1473. //FZipStream.ReadBuffer(E[1],Extra_Field_Length);
  1474. FZipStream.Seek(Extra_Field_Length,soCurrent);
  1475. Item.ArchiveFileName:=S;
  1476. Item.DiskFileName:=S;
  1477. Item.Size:=Uncompressed_Size;
  1478. ZipDateTimeToDateTime(Last_Mod_Date,Last_Mod_Time,D);
  1479. Item.DateTime:=D;
  1480. if Crc32 <> 0 then
  1481. Item.CRC32 := Crc32;
  1482. AMethod:=Compress_method;
  1483. end;
  1484. End;
  1485. procedure FindEndHeader(AZip: TStream; out AEndHdr: End_of_Central_Dir_Type; out AEndHdrPos: Int64; out AZipFileComment: string);
  1486. var
  1487. Buf: PByte;
  1488. BufSize: Integer;
  1489. I: Integer;
  1490. begin
  1491. AZipFileComment := '';
  1492. AEndHdrPos := AZip.Size - SizeOf(AEndHdr);
  1493. if AEndHdrPos < 0 then
  1494. begin
  1495. AEndHdrPos := -1;
  1496. FillChar(AEndHdr, SizeOf(AEndHdr), 0);
  1497. exit;
  1498. end;
  1499. AZip.Seek(AEndHdrPos, soFromBeginning);
  1500. AZip.ReadBuffer(AEndHdr, SizeOf(AEndHdr));
  1501. {$IFDEF FPC_BIG_ENDIAN}
  1502. AEndHdr := SwapECD(AEndHdr);
  1503. {$ENDIF}
  1504. if (AEndHdr.Signature = END_OF_CENTRAL_DIR_SIGNATURE) and
  1505. (AEndHdr.ZipFile_Comment_Length = 0) then
  1506. exit;
  1507. // scan the last (64k + something) bytes for the END_OF_CENTRAL_DIR_SIGNATURE
  1508. // (zip file comments are 64k max)
  1509. BufSize := 65536 + SizeOf(AEndHdr) + 128;
  1510. if AZip.Size < BufSize then
  1511. BufSize := AZip.Size;
  1512. Buf := GetMem(BufSize);
  1513. try
  1514. AZip.Seek(AZip.Size - BufSize, soFromBeginning);
  1515. AZip.ReadBuffer(Buf^, BufSize);
  1516. for I := BufSize - SizeOf(AEndHdr) downto 0 do
  1517. begin
  1518. 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
  1519. begin
  1520. Move(Buf[I], AEndHdr, SizeOf(AEndHdr));
  1521. {$IFDEF FPC_BIG_ENDIAN}
  1522. AEndHdr := SwapECD(AEndHdr);
  1523. {$ENDIF}
  1524. if (AEndHdr.Signature = END_OF_CENTRAL_DIR_SIGNATURE) and
  1525. (I + SizeOf(AEndHdr) + AEndHdr.ZipFile_Comment_Length = BufSize) then
  1526. begin
  1527. AEndHdrPos := AZip.Size - BufSize + I;
  1528. AZip.Seek(AEndHdrPos + SizeOf(AEndHdr), soFromBeginning);
  1529. SetLength(AZipFileComment, AEndHdr.ZipFile_Comment_Length);
  1530. AZip.ReadBuffer(AZipFileComment[1], Length(AZipFileComment));
  1531. exit;
  1532. end;
  1533. end;
  1534. end;
  1535. AEndHdrPos := -1;
  1536. FillChar(AEndHdr, SizeOf(AEndHdr), 0);
  1537. finally
  1538. FreeMem(Buf);
  1539. end;
  1540. end;
  1541. Procedure TUnZipper.ReadZipDirectory;
  1542. Var
  1543. i : LongInt;
  1544. EndHdrPos,
  1545. CenDirPos : Int64;
  1546. NewNode : TFullZipFileEntry;
  1547. D : TDateTime;
  1548. S : String;
  1549. Begin
  1550. FindEndHeader(FZipStream, EndHdr, EndHdrPos, FFileComment);
  1551. if EndHdrPos < 0 then
  1552. raise EZipError.CreateFmt(SErrCorruptZIP,[FileName]);
  1553. CenDirPos := EndHdr.Start_Disk_Offset;
  1554. FZipStream.Seek(CenDirPos,soFrombeginning);
  1555. FEntries.Clear;
  1556. for i:=0 to EndHdr.Entries_This_Disk-1 do
  1557. begin
  1558. FZipStream.ReadBuffer(CentralHdr, SizeOf(CentralHdr));
  1559. {$IFDEF FPC_BIG_ENDIAN}
  1560. CentralHdr := SwapCFH(CentralHdr);
  1561. {$ENDIF}
  1562. With CentralHdr do
  1563. begin
  1564. if Signature<>CENTRAL_FILE_HEADER_SIGNATURE then
  1565. raise EZipError.CreateFmt(SErrCorruptZIP,[FileName]);
  1566. NewNode:=FEntries.Add as TFullZipFileEntry;
  1567. NewNode.HdrPos := Local_Header_Offset;
  1568. SetLength(S,Filename_Length);
  1569. FZipStream.ReadBuffer(S[1],Filename_Length);
  1570. NewNode.ArchiveFileName:=S;
  1571. NewNode.Size:=Uncompressed_Size;
  1572. NewNode.FCompressedSize:=Compressed_Size;
  1573. NewNode.CRC32:=CRC32;
  1574. NewNode.OS := MadeBy_Version shr 8;
  1575. if NewNode.OS = OS_UNIX then
  1576. NewNode.Attributes := External_Attributes shr 16
  1577. else
  1578. NewNode.Attributes := External_Attributes;
  1579. ZipDateTimeToDateTime(Last_Mod_Date,Last_Mod_Time,D);
  1580. NewNode.DateTime:=D;
  1581. FZipStream.Seek(Extra_Field_Length+File_Comment_Length,soCurrent);
  1582. end;
  1583. end;
  1584. end;
  1585. Function TUnZipper.CreateDeCompressor(Item : TZipFileEntry; AMethod : Word;AZipFile,AOutFile : TStream) : TDeCompressor;
  1586. begin
  1587. case AMethod of
  1588. 8 :
  1589. Result:=TInflater.Create(AZipFile,AOutFile,FBufSize);
  1590. else
  1591. raise EZipError.CreateFmt(SErrUnsupportedCompressionFormat,[AMethod]);
  1592. end;
  1593. end;
  1594. Procedure TUnZipper.UnZipOneFile(Item : TFullZipFileEntry);
  1595. Var
  1596. Count, Attrs: Longint;
  1597. ZMethod : Word;
  1598. LinkTargetStream: TStringStream;
  1599. OutputFileName: string;
  1600. FOutStream: TStream;
  1601. IsLink: Boolean;
  1602. IsCustomStream: Boolean;
  1603. procedure DoUnzip(const Dest: TStream);
  1604. begin
  1605. if ZMethod=0 then
  1606. begin
  1607. if (LocalHdr.Compressed_Size<>0) then
  1608. begin
  1609. Count:=Dest.CopyFrom(FZipStream,LocalHdr.Compressed_Size)
  1610. {$warning TODO: Implement CRC Check}
  1611. end
  1612. else
  1613. Count:=0;
  1614. end
  1615. else
  1616. With CreateDecompressor(Item, ZMethod, FZipStream, Dest) do
  1617. Try
  1618. OnProgress:=Self.OnProgress;
  1619. OnPercent:=Self.OnPercent;
  1620. DeCompress;
  1621. if Item.CRC32 <> Crc32Val then
  1622. raise EZipError.CreateFmt(SErrInvalidCRC,[Item.ArchiveFileName]);
  1623. Finally
  1624. Free;
  1625. end;
  1626. end;
  1627. Begin
  1628. ReadZipHeader(Item, ZMethod);
  1629. OutputFileName:=Item.DiskFileName;
  1630. IsCustomStream := Assigned(FOnCreateStream);
  1631. if (IsCustomStream = False) and (FOutputPath<>'') then
  1632. OutputFileName:=IncludeTrailingPathDelimiter(FOutputPath)+OutputFileName;
  1633. IsLink := Item.IsLink;
  1634. {$IFNDEF UNIX}
  1635. if IsLink and Not IsCustomStream then
  1636. begin
  1637. {$warning TODO: Implement symbolic link creation for non-unix}
  1638. IsLink := False;
  1639. end;
  1640. {$ENDIF}
  1641. if IsCustomStream then
  1642. begin
  1643. try
  1644. OpenOutput(OutputFileName, FOutStream, Item);
  1645. if (IsLink = False) and (Item.IsDirectory = False) then
  1646. DoUnzip(FOutStream);
  1647. Finally
  1648. CloseOutput(Item, FOutStream);
  1649. end;
  1650. end
  1651. else
  1652. begin
  1653. if IsLink then
  1654. begin
  1655. {$IFDEF UNIX}
  1656. LinkTargetStream := TStringStream.Create('');
  1657. try
  1658. DoUnzip(LinkTargetStream);
  1659. fpSymlink(PChar(LinkTargetStream.DataString), PChar(OutputFileName));
  1660. finally
  1661. LinkTargetStream.Free;
  1662. end;
  1663. {$ENDIF}
  1664. end
  1665. else
  1666. begin
  1667. if Item.IsDirectory then
  1668. CreateDir(OutputFileName)
  1669. else
  1670. begin
  1671. try
  1672. OpenOutput(OutputFileName, FOutStream, Item);
  1673. DoUnzip(FOutStream);
  1674. Finally
  1675. CloseOutput(Item, FOutStream);
  1676. end;
  1677. end;
  1678. end;
  1679. end;
  1680. if Not IsCustomStream then
  1681. begin
  1682. // set attributes
  1683. FileSetDate(OutputFileName, DateTimeToFileDate(Item.DateTime));
  1684. if (Item.Attributes <> 0) then
  1685. begin
  1686. Attrs := 0;
  1687. {$IFDEF UNIX}
  1688. if Item.OS = OS_UNIX then Attrs := Item.Attributes;
  1689. if Item.OS = OS_FAT then
  1690. Attrs := ZipFatAttrsToUnixAttrs(Item.Attributes);
  1691. {$ELSE}
  1692. if Item.OS = OS_FAT then Attrs := Item.Attributes;
  1693. if Item.OS = OS_UNIX then
  1694. Attrs := ZipUnixAttrsToFatAttrs(ExtractFileName(Item.ArchiveFileName), Item.Attributes);
  1695. {$ENDIF}
  1696. if Attrs <> 0 then
  1697. begin
  1698. {$IFDEF UNIX}
  1699. FpChmod(OutputFileName, Attrs);
  1700. {$ELSE}
  1701. FileSetAttr(OutputFileName, Attrs);
  1702. {$ENDIF}
  1703. end;
  1704. end;
  1705. end;
  1706. end;
  1707. Procedure TUnZipper.UnZipAllFiles;
  1708. Var
  1709. Item : TFullZipFileEntry;
  1710. I : Integer;
  1711. AllFiles : Boolean;
  1712. Begin
  1713. FUnZipping:=True;
  1714. Try
  1715. AllFiles:=(FFiles.Count=0);
  1716. OpenInput;
  1717. Try
  1718. ReadZipDirectory;
  1719. For I:=0 to FEntries.Count-1 do
  1720. begin
  1721. Item:=FEntries[i];
  1722. if AllFiles or (FFiles.IndexOf(Item.ArchiveFileName)<>-1) then
  1723. UnZipOneFile(Item);
  1724. end;
  1725. Finally
  1726. CloseInput;
  1727. end;
  1728. finally
  1729. FUnZipping:=False;
  1730. end;
  1731. end;
  1732. Procedure TUnZipper.SetBufSize(Value : LongWord);
  1733. begin
  1734. If FUnZipping then
  1735. Raise EZipError.Create(SErrBufsizeChange);
  1736. If Value>=DefaultBufSize then
  1737. FBufSize:=Value;
  1738. end;
  1739. Procedure TUnZipper.SetFileName(Value : String);
  1740. begin
  1741. If FUnZipping then
  1742. Raise EZipError.Create(SErrFileChange);
  1743. FFileName:=Value;
  1744. end;
  1745. Procedure TUnZipper.SetOutputPath(Value:String);
  1746. begin
  1747. If FUnZipping then
  1748. Raise EZipError.Create(SErrFileChange);
  1749. FOutputPath:=Value;
  1750. end;
  1751. Procedure TUnZipper.UnZipFiles(AFileName : String; FileList : TStrings);
  1752. begin
  1753. FFileName:=AFileName;
  1754. UNzipFiles(FileList);
  1755. end;
  1756. procedure TUnZipper.UnZipFiles(FileList: TStrings);
  1757. begin
  1758. FFiles.Assign(FileList);
  1759. UnZipAllFiles;
  1760. end;
  1761. Procedure TUnZipper.UnZipAllFiles(AFileName : String);
  1762. begin
  1763. FFileName:=AFileName;
  1764. UnZipAllFiles;
  1765. end;
  1766. Procedure TUnZipper.DoEndOfFile;
  1767. Var
  1768. ComprPct : Double;
  1769. begin
  1770. If (LocalHdr.Uncompressed_Size>0) then
  1771. ComprPct := (100.0 * (LocalHdr.Uncompressed_Size - LocalHdr.Compressed_Size)) / LocalHdr.Uncompressed_Size
  1772. else
  1773. ComprPct := 0;
  1774. If Assigned(FOnEndOfFile) then
  1775. FOnEndOfFile(Self,ComprPct);
  1776. end;
  1777. Constructor TUnZipper.Create;
  1778. begin
  1779. FBufSize:=DefaultBufSize;
  1780. FFiles:=TStringList.Create;
  1781. TStringlist(FFiles).Sorted:=True;
  1782. FEntries:=TFullZipFileEntries.Create(TFullZipFileEntry);
  1783. FOnPercent:=1;
  1784. end;
  1785. Procedure TUnZipper.Clear;
  1786. begin
  1787. FFiles.Clear;
  1788. FEntries.Clear;
  1789. end;
  1790. procedure TUnZipper.Examine;
  1791. begin
  1792. if (FOnOpenInputStream = nil) and (FFileName='') then
  1793. Raise EZipError.Create(SErrNoFileName);
  1794. OpenInput;
  1795. If (FZipStream=nil) then
  1796. Raise EZipError.Create(SErrNoStream);
  1797. Try
  1798. ReadZipDirectory;
  1799. Finally
  1800. CloseInput;
  1801. end;
  1802. end;
  1803. Destructor TUnZipper.Destroy;
  1804. begin
  1805. Clear;
  1806. FreeAndNil(FFiles);
  1807. FreeAndNil(FEntries);
  1808. Inherited;
  1809. end;
  1810. { TZipFileEntry }
  1811. function TZipFileEntry.GetArchiveFileName: String;
  1812. begin
  1813. Result:=FArchiveFileName;
  1814. If (Result='') then
  1815. Result:=FDiskFileName;
  1816. end;
  1817. constructor TZipFileEntry.Create(ACollection: TCollection);
  1818. begin
  1819. {$IFDEF UNIX}
  1820. FOS := OS_UNIX;
  1821. {$ELSE}
  1822. FOS := OS_FAT;
  1823. {$ENDIF}
  1824. FCompressionLevel:=cldefault;
  1825. inherited create(ACollection);
  1826. end;
  1827. function TZipFileEntry.IsDirectory: Boolean;
  1828. begin
  1829. Result := (DiskFileName <> '') and (DiskFileName[Length(DiskFileName)] in ['/', '\']);
  1830. if Attributes <> 0 then
  1831. begin
  1832. case OS of
  1833. OS_FAT: Result := (faDirectory and Attributes) > 0;
  1834. OS_UNIX: Result := (Attributes and UNIX_MASK) = UNIX_DIR;
  1835. end;
  1836. end;
  1837. end;
  1838. function TZipFileEntry.IsLink: Boolean;
  1839. begin
  1840. Result := False;
  1841. if Attributes <> 0 then
  1842. begin
  1843. case OS of
  1844. OS_FAT: Result := (faSymLink and Attributes) > 0;
  1845. OS_UNIX: Result := (Attributes and UNIX_MASK) = UNIX_LINK;
  1846. end;
  1847. end;
  1848. end;
  1849. procedure TZipFileEntry.Assign(Source: TPersistent);
  1850. Var
  1851. Z : TZipFileEntry;
  1852. begin
  1853. if Source is TZipFileEntry then
  1854. begin
  1855. Z:=Source as TZipFileEntry;
  1856. FArchiveFileName:=Z.FArchiveFileName;
  1857. FDiskFileName:=Z.FDiskFileName;
  1858. FSize:=Z.FSize;
  1859. FDateTime:=Z.FDateTime;
  1860. FStream:=Z.FStream;
  1861. FOS:=Z.OS;
  1862. FAttributes:=Z.Attributes;
  1863. end
  1864. else
  1865. inherited Assign(Source);
  1866. end;
  1867. { TZipFileEntries }
  1868. function TZipFileEntries.GetZ(AIndex : Integer): TZipFileEntry;
  1869. begin
  1870. Result:=TZipFileEntry(Items[AIndex]);
  1871. end;
  1872. procedure TZipFileEntries.SetZ(AIndex : Integer; const AValue: TZipFileEntry);
  1873. begin
  1874. Items[AIndex]:=AValue;
  1875. end;
  1876. function TZipFileEntries.AddFileEntry(const ADiskFileName: String): TZipFileEntry;
  1877. begin
  1878. Result:=Add as TZipFileEntry;
  1879. Result.DiskFileName:=ADiskFileName;
  1880. end;
  1881. function TZipFileEntries.AddFileEntry(const ADiskFileName,
  1882. AArchiveFileName: String): TZipFileEntry;
  1883. begin
  1884. Result:=AddFileEntry(ADiskFileName);
  1885. Result.ArchiveFileName:=AArchiveFileName;
  1886. end;
  1887. function TZipFileEntries.AddFileEntry(const AStream: TSTream;
  1888. const AArchiveFileName: String): TZipFileEntry;
  1889. begin
  1890. Result:=Add as TZipFileEntry;
  1891. Result.Stream:=AStream;
  1892. Result.ArchiveFileName:=AArchiveFileName;
  1893. end;
  1894. Procedure TZipFileEntries.AddFileEntries(Const List : TStrings);
  1895. Var
  1896. I : integer;
  1897. begin
  1898. For I:=0 to List.Count-1 do
  1899. AddFileEntry(List[i]);
  1900. end;
  1901. { TFullZipFileEntries }
  1902. function TFullZipFileEntries.GetFZ(AIndex : Integer): TFullZipFileEntry;
  1903. begin
  1904. Result:=TFullZipFileEntry(Items[AIndex]);
  1905. end;
  1906. procedure TFullZipFileEntries.SetFZ(AIndex : Integer;
  1907. const AValue: TFullZipFileEntry);
  1908. begin
  1909. Items[AIndex]:=AValue;
  1910. end;
  1911. End.