ZLIBEX.PAS 32 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049
  1. {*****************************************************************************
  2. * ZLibEx.pas *
  3. * *
  4. * copyright (c) 2000-2003 base2 technologies *
  5. * copyright (c) 1997 Borland International *
  6. * *
  7. * revision history *
  8. * 2004.01.06 updated to zlib version 1.2.1 *
  9. * 2003.04.14 added ZCompress2 and ZDecompress2 *
  10. * added ZCompressStr2 and ZDecompressStr2 *
  11. * added ZCompressStream2 and ZDecompressStream2 *
  12. * added overloaded T*Stream constructors to support *
  13. * InflateInit2 and DeflateInit2 *
  14. * fixed ZDecompressStream to use ZDecompressCheck instead of *
  15. * ZCompressCheck *
  16. * 2002.03.15 updated to zlib version 1.1.4 *
  17. * 2001.11.27 enhanced TZDecompressionStream.Read to adjust source *
  18. * stream position upon end of compression data *
  19. * fixed endless loop in TZDecompressionStream.Read when *
  20. * destination count was greater than uncompressed data *
  21. * 2001.10.26 renamed unit to integrate "nicely" with delphi 6 *
  22. * 2000.11.24 added soFromEnd condition to TZDecompressionStream.Seek *
  23. * added ZCompressStream and ZDecompressStream *
  24. * 2000.06.13 optimized, fixed, rewrote, and enhanced the zlib.pas unit *
  25. * included on the delphi cd (zlib version 1.1.3) *
  26. * *
  27. * acknowledgements *
  28. * erik turner Z*Stream routines *
  29. * david bennion finding the nastly little endless loop quirk with the *
  30. * TZDecompressionStream.Read method *
  31. * burak kalayci informing me about the zlib 1.1.4 update and the 1.2.1 *
  32. * update *
  33. *****************************************************************************}
  34. unit ZLibEx;
  35. interface
  36. uses
  37. Sysutils, Classes;
  38. const
  39. ZLIB_VERSION = '1.2.1';
  40. ZLIB_VERNUM = $1210;
  41. type
  42. TZAlloc = function (opaque: Pointer; items, size: Integer): Pointer;
  43. TZFree = procedure (opaque, block: Pointer);
  44. TZCompressionLevel = (zcNone, zcFastest, zcDefault, zcMax);
  45. TZStrategy = (zsDefault, zsFiltered, zsHuffman, zsRLE);
  46. {** TZStreamRec ***********************************************************}
  47. TZStreamRec = packed record
  48. next_in : PChar; // next input byte
  49. avail_in : Longint; // number of bytes available at next_in
  50. total_in : Longint; // total nb of input bytes read so far
  51. next_out : PChar; // next output byte should be put here
  52. avail_out: Longint; // remaining free space at next_out
  53. total_out: Longint; // total nb of bytes output so far
  54. msg : PChar; // last error message, NULL if no error
  55. state : Pointer; // not visible by applications
  56. zalloc : TZAlloc; // used to allocate the internal state
  57. zfree : TZFree; // used to free the internal state
  58. opaque : Pointer; // private data object passed to zalloc and zfree
  59. data_type: Integer; // best guess about the data type: ascii or binary
  60. adler : Longint; // adler32 value of the uncompressed data
  61. reserved : Longint; // reserved for future use
  62. end;
  63. {** TCustomZStream ********************************************************}
  64. TCustomZStream = class(TStream)
  65. private
  66. FStream : TStream;
  67. FStreamPos : Integer;
  68. FOnProgress: TNotifyEvent;
  69. FZStream : TZStreamRec;
  70. FBuffer : Array [Word] of Char;
  71. protected
  72. constructor Create(stream: TStream);
  73. procedure DoProgress; dynamic;
  74. property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
  75. end;
  76. {** TZCompressionStream ***************************************************}
  77. TZCompressionStream = class(TCustomZStream)
  78. private
  79. function GetCompressionRate: Single;
  80. public
  81. constructor Create(dest: TStream;
  82. compressionLevel: TZCompressionLevel = zcDefault); overload;
  83. constructor Create(dest: TStream; compressionLevel: TZCompressionLevel;
  84. windowBits, memLevel: Integer; strategy: TZStrategy); overload;
  85. destructor Destroy; override;
  86. function Read(var buffer; count: Longint): Longint; override;
  87. function Write(const buffer; count: Longint): Longint; override;
  88. function Seek(offset: Longint; origin: Word): Longint; override;
  89. property CompressionRate: Single read GetCompressionRate;
  90. property OnProgress;
  91. end;
  92. {** TZDecompressionStream *************************************************}
  93. TZDecompressionStream = class(TCustomZStream)
  94. public
  95. constructor Create(source: TStream); overload;
  96. constructor Create(source: TStream; windowBits: Integer); overload;
  97. destructor Destroy; override;
  98. function Read(var buffer; count: Longint): Longint; override;
  99. function Write(const buffer; count: Longint): Longint; override;
  100. function Seek(offset: Longint; origin: Word): Longint; override;
  101. property OnProgress;
  102. end;
  103. {** zlib public routines ****************************************************}
  104. {*****************************************************************************
  105. * ZCompress *
  106. * *
  107. * pre-conditions *
  108. * inBuffer = pointer to uncompressed data *
  109. * inSize = size of inBuffer (bytes) *
  110. * outBuffer = pointer (unallocated) *
  111. * level = compression level *
  112. * *
  113. * post-conditions *
  114. * outBuffer = pointer to compressed data (allocated) *
  115. * outSize = size of outBuffer (bytes) *
  116. *****************************************************************************}
  117. procedure ZCompress(const inBuffer: Pointer; inSize: Integer;
  118. out outBuffer: Pointer; out outSize: Integer;
  119. level: TZCompressionLevel = zcDefault);
  120. {*****************************************************************************
  121. * ZCompress2 *
  122. * *
  123. * pre-conditions *
  124. * inBuffer = pointer to uncompressed data *
  125. * inSize = size of inBuffer (bytes) *
  126. * outBuffer = pointer (unallocated) *
  127. * level = compression level *
  128. * method = compression method *
  129. * windowBits = window bits *
  130. * memLevel = memory level *
  131. * strategy = strategy *
  132. * *
  133. * post-conditions *
  134. * outBuffer = pointer to compressed data (allocated) *
  135. * outSize = size of outBuffer (bytes) *
  136. *****************************************************************************}
  137. procedure ZCompress2(const inBuffer: Pointer; inSize: Integer;
  138. out outBuffer: Pointer; out outSize: Integer; level: TZCompressionLevel;
  139. windowBits, memLevel: Integer; strategy: TZStrategy);
  140. {*****************************************************************************
  141. * ZDecompress *
  142. * *
  143. * pre-conditions *
  144. * inBuffer = pointer to compressed data *
  145. * inSize = size of inBuffer (bytes) *
  146. * outBuffer = pointer (unallocated) *
  147. * outEstimate = estimated size of uncompressed data (bytes) *
  148. * *
  149. * post-conditions *
  150. * outBuffer = pointer to decompressed data (allocated) *
  151. * outSize = size of outBuffer (bytes) *
  152. *****************************************************************************}
  153. procedure ZDecompress(const inBuffer: Pointer; inSize: Integer;
  154. out outBuffer: Pointer; out outSize: Integer; outEstimate: Integer = 0);
  155. {*****************************************************************************
  156. * ZDecompress2 *
  157. * *
  158. * pre-conditions *
  159. * inBuffer = pointer to compressed data *
  160. * inSize = size of inBuffer (bytes) *
  161. * outBuffer = pointer (unallocated) *
  162. * windowBits = window bits *
  163. * outEstimate = estimated size of uncompressed data (bytes) *
  164. * *
  165. * post-conditions *
  166. * outBuffer = pointer to decompressed data (allocated) *
  167. * outSize = size of outBuffer (bytes) *
  168. *****************************************************************************}
  169. procedure ZDecompress2(const inBuffer: Pointer; inSize: Integer;
  170. out outBuffer: Pointer; out outSize: Integer; windowBits: Integer;
  171. outEstimate: Integer = 0);
  172. {** string routines *********************************************************}
  173. function ZCompressStr(const s: String;
  174. level: TZCompressionLevel = zcDefault): String;
  175. function ZCompressStrEx(const s: String;
  176. level: TZCompressionLevel = zcDefault): String;
  177. function ZCompressStr2(const s: String; level: TZCompressionLevel;
  178. windowBits, memLevel: Integer; strategy: TZStrategy): String;
  179. function ZDecompressStr(const s: String): String;
  180. function ZDecompressStrEx(const s: String): String;
  181. function ZDecompressStr2(const s: String; windowBits: Integer): String;
  182. {** stream routines *********************************************************}
  183. procedure ZCompressStream(inStream, outStream: TStream;
  184. level: TZCompressionLevel = zcDefault);
  185. procedure ZCompressStream2(inStream, outStream: TStream;
  186. level: TZCompressionLevel; windowBits, memLevel: Integer;
  187. strategy: TZStrategy);
  188. procedure ZDecompressStream(inStream, outStream: TStream);
  189. procedure ZDecompressStream2(inStream, outStream: TStream;
  190. windowBits: Integer);
  191. {****************************************************************************}
  192. type
  193. EZLibError = class(Exception);
  194. EZCompressionError = class(EZLibError);
  195. EZDecompressionError = class(EZLibError);
  196. implementation
  197. {** link zlib code **********************************************************}
  198. {$L deflate.obj}
  199. {$L inflate.obj}
  200. {$L inftrees.obj}
  201. {$L infback.obj}
  202. {$L inffast.obj}
  203. {$L trees.obj}
  204. {$L compress.obj}
  205. {$L adler32.obj}
  206. {$L crc32.obj}
  207. {*****************************************************************************
  208. * note: do not reorder the above -- doing so will result in external *
  209. * functions being undefined *
  210. *****************************************************************************}
  211. const
  212. {** flush constants *******************************************************}
  213. Z_NO_FLUSH = 0;
  214. Z_PARTIAL_FLUSH = 1;
  215. Z_SYNC_FLUSH = 2;
  216. Z_FULL_FLUSH = 3;
  217. Z_FINISH = 4;
  218. Z_BLOCK = 5;
  219. {** return codes **********************************************************}
  220. Z_OK = 0;
  221. Z_STREAM_END = 1;
  222. Z_NEED_DICT = 2;
  223. Z_ERRNO = (-1);
  224. Z_STREAM_ERROR = (-2);
  225. Z_DATA_ERROR = (-3);
  226. Z_MEM_ERROR = (-4);
  227. Z_BUF_ERROR = (-5);
  228. Z_VERSION_ERROR = (-6);
  229. {** compression levels ****************************************************}
  230. Z_NO_COMPRESSION = 0;
  231. Z_BEST_SPEED = 1;
  232. Z_BEST_COMPRESSION = 9;
  233. Z_DEFAULT_COMPRESSION = (-1);
  234. {** compression strategies ************************************************}
  235. Z_FILTERED = 1;
  236. Z_HUFFMAN_ONLY = 2;
  237. Z_RLE = 3;
  238. Z_DEFAULT_STRATEGY = 0;
  239. {** data types ************************************************************}
  240. Z_BINARY = 0;
  241. Z_ASCII = 1;
  242. Z_UNKNOWN = 2;
  243. {** compression methods ***************************************************}
  244. Z_DEFLATED = 8;
  245. {** return code messages **************************************************}
  246. _z_errmsg: array[0..9] of PChar = (
  247. 'need dictionary', // Z_NEED_DICT (2)
  248. 'stream end', // Z_STREAM_END (1)
  249. '', // Z_OK (0)
  250. 'file error', // Z_ERRNO (-1)
  251. 'stream error', // Z_STREAM_ERROR (-2)
  252. 'data error', // Z_DATA_ERROR (-3)
  253. 'insufficient memory', // Z_MEM_ERROR (-4)
  254. 'buffer error', // Z_BUF_ERROR (-5)
  255. 'incompatible version', // Z_VERSION_ERROR (-6)
  256. ''
  257. );
  258. ZLevels: Array [TZCompressionLevel] of Shortint = (
  259. Z_NO_COMPRESSION,
  260. Z_BEST_SPEED,
  261. Z_DEFAULT_COMPRESSION,
  262. Z_BEST_COMPRESSION
  263. );
  264. ZStrategies: Array [TZStrategy] of Shortint = (
  265. Z_DEFAULT_STRATEGY,
  266. Z_FILTERED,
  267. Z_HUFFMAN_ONLY,
  268. Z_RLE
  269. );
  270. SZInvalid = 'Invalid ZStream operation!';
  271. {** deflate routines ********************************************************}
  272. function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar;
  273. recsize: Integer): Integer;
  274. external;
  275. function deflateInit2_(var strm: TZStreamRec; level, method, windowBits,
  276. memLevel, strategy: Integer; version: PChar; recsize: Integer): Integer;
  277. external;
  278. function deflate(var strm: TZStreamRec; flush: Integer): Integer;
  279. external;
  280. function deflateEnd(var strm: TZStreamRec): Integer;
  281. external;
  282. {** inflate routines ********************************************************}
  283. function inflateInit_(var strm: TZStreamRec; version: PChar;
  284. recsize: Integer): Integer;
  285. external;
  286. function inflateInit2_(var strm: TZStreamRec; windowBits: Integer;
  287. version: PChar; recsize: Integer): Integer;
  288. external;
  289. function inflate(var strm: TZStreamRec; flush: Integer): Integer;
  290. external;
  291. function inflateEnd(var strm: TZStreamRec): Integer;
  292. external;
  293. function inflateReset(var strm: TZStreamRec): Integer;
  294. external;
  295. {** zlib function implementations *******************************************}
  296. function zcalloc(opaque: Pointer; items, size: Integer): Pointer;
  297. begin
  298. GetMem(result,items * size);
  299. end;
  300. procedure zcfree(opaque, block: Pointer);
  301. begin
  302. FreeMem(block);
  303. end;
  304. {** c function implementations **********************************************}
  305. procedure _memset(p: Pointer; b: Byte; count: Integer); cdecl;
  306. begin
  307. FillChar(p^,count,b);
  308. end;
  309. procedure _memcpy(dest, source: Pointer; count: Integer); cdecl;
  310. begin
  311. Move(source^,dest^,count);
  312. end;
  313. {** custom zlib routines ****************************************************}
  314. function DeflateInit(var stream: TZStreamRec; level: Integer): Integer;
  315. begin
  316. result := deflateInit_(stream,level,ZLIB_VERSION,SizeOf(TZStreamRec));
  317. end;
  318. function DeflateInit2(var stream: TZStreamRec; level, method, windowBits,
  319. memLevel, strategy: Integer): Integer;
  320. begin
  321. result := deflateInit2_(stream,level,method,windowBits,memLevel,strategy,
  322. ZLIB_VERSION,SizeOf(TZStreamRec));
  323. end;
  324. function InflateInit(var stream: TZStreamRec): Integer;
  325. begin
  326. result := inflateInit_(stream,ZLIB_VERSION,SizeOf(TZStreamRec));
  327. end;
  328. function InflateInit2(var stream: TZStreamRec; windowBits: Integer): Integer;
  329. begin
  330. result := inflateInit2_(stream,windowBits,ZLIB_VERSION,SizeOf(TZStreamRec));
  331. end;
  332. {****************************************************************************}
  333. function ZCompressCheck(code: Integer): Integer;
  334. begin
  335. result := code;
  336. if code < 0 then
  337. begin
  338. raise EZCompressionError.Create(_z_errmsg[2 - code]);
  339. end;
  340. end;
  341. function ZDecompressCheck(code: Integer): Integer;
  342. begin
  343. Result := code;
  344. if code < 0 then
  345. begin
  346. raise EZDecompressionError.Create(_z_errmsg[2 - code]);
  347. end;
  348. end;
  349. procedure ZInternalCompress(var zstream: TZStreamRec; const inBuffer: Pointer;
  350. inSize: Integer; out outBuffer: Pointer; out outSize: Integer);
  351. const
  352. delta = 256;
  353. begin
  354. outSize := ((inSize + (inSize div 10) + 12) + 255) and not 255;
  355. GetMem(outBuffer,outSize);
  356. try
  357. try
  358. zstream.next_in := inBuffer;
  359. zstream.avail_in := inSize;
  360. zstream.next_out := outBuffer;
  361. zstream.avail_out := outSize;
  362. while ZCompressCheck(deflate(zstream,Z_FINISH)) <> Z_STREAM_END do
  363. begin
  364. Inc(outSize,delta);
  365. ReallocMem(outBuffer,outSize);
  366. zstream.next_out := PChar(Integer(outBuffer) + zstream.total_out);
  367. zstream.avail_out := delta;
  368. end;
  369. finally
  370. ZCompressCheck(deflateEnd(zstream));
  371. end;
  372. ReallocMem(outBuffer,zstream.total_out);
  373. outSize := zstream.total_out;
  374. except
  375. FreeMem(outBuffer);
  376. raise;
  377. end;
  378. end;
  379. procedure ZInternalDecompress(zstream: TZStreamRec; const inBuffer: Pointer;
  380. inSize: Integer; out outBuffer: Pointer; out outSize: Integer;
  381. outEstimate: Integer);
  382. var
  383. delta: Integer;
  384. begin
  385. delta := (inSize + 255) and not 255;
  386. if outEstimate = 0 then outSize := delta
  387. else outSize := outEstimate;
  388. GetMem(outBuffer,outSize);
  389. try
  390. try
  391. zstream.next_in := inBuffer;
  392. zstream.avail_in := inSize;
  393. zstream.next_out := outBuffer;
  394. zstream.avail_out := outSize;
  395. while ZDecompressCheck(inflate(zstream,Z_NO_FLUSH)) <> Z_STREAM_END do
  396. begin
  397. Inc(outSize,delta);
  398. ReallocMem(outBuffer,outSize);
  399. zstream.next_out := PChar(Integer(outBuffer) + zstream.total_out);
  400. zstream.avail_out := delta;
  401. end;
  402. finally
  403. ZDecompressCheck(inflateEnd(zstream));
  404. end;
  405. ReallocMem(outBuffer,zstream.total_out);
  406. outSize := zstream.total_out;
  407. except
  408. FreeMem(outBuffer);
  409. raise;
  410. end;
  411. end;
  412. procedure ZCompress(const inBuffer: Pointer; inSize: Integer;
  413. out outBuffer: Pointer; out outSize: Integer;
  414. level: TZCompressionLevel);
  415. var
  416. zstream: TZStreamRec;
  417. begin
  418. FillChar(zstream,SizeOf(TZStreamRec),0);
  419. ZCompressCheck(DeflateInit(zstream,ZLevels[level]));
  420. ZInternalCompress(zstream,inBuffer,inSize,outBuffer,outSize);
  421. end;
  422. procedure ZCompress2(const inBuffer: Pointer; inSize: Integer;
  423. out outBuffer: Pointer; out outSize: Integer; level: TZCompressionLevel;
  424. windowBits, memLevel: Integer; strategy: TZStrategy);
  425. var
  426. zstream: TZStreamRec;
  427. begin
  428. FillChar(zstream,SizeOf(TZStreamRec),0);
  429. ZCompressCheck(DeflateInit2(zstream,ZLevels[level],Z_DEFLATED,windowBits,
  430. memLevel,ZStrategies[strategy]));
  431. ZInternalCompress(zstream,inBuffer,inSize,outBuffer,outSize);
  432. end;
  433. procedure ZDecompress(const inBuffer: Pointer; inSize: Integer;
  434. out outBuffer: Pointer; out outSize: Integer; outEstimate: Integer);
  435. var
  436. zstream: TZStreamRec;
  437. begin
  438. FillChar(zstream,SizeOf(TZStreamRec),0);
  439. ZDecompressCheck(InflateInit(zstream));
  440. ZInternalDecompress(zstream,inBuffer,inSize,outBuffer,outSize,outEstimate);
  441. end;
  442. procedure ZDecompress2(const inBuffer: Pointer; inSize: Integer;
  443. out outBuffer: Pointer; out outSize: Integer; windowBits: Integer;
  444. outEstimate: Integer);
  445. var
  446. zstream: TZStreamRec;
  447. begin
  448. FillChar(zstream,SizeOf(TZStreamRec),0);
  449. ZDecompressCheck(InflateInit2(zstream,windowBits));
  450. ZInternalDecompress(zstream,inBuffer,inSize,outBuffer,outSize,outEstimate);
  451. end;
  452. {** string routines *********************************************************}
  453. function ZCompressStr(const s: String; level: TZCompressionLevel): String;
  454. var
  455. buffer: Pointer;
  456. size : Integer;
  457. begin
  458. ZCompress(PChar(s),Length(s),buffer,size,level);
  459. SetLength(result,size);
  460. Move(buffer^,result[1],size);
  461. FreeMem(buffer);
  462. end;
  463. function ZCompressStrEx(const s: String; level: TZCompressionLevel): String;
  464. var
  465. buffer: Pointer;
  466. size : Integer;
  467. begin
  468. ZCompress(PChar(s),Length(s),buffer,size,level);
  469. SetLength(result,size + SizeOf(Integer));
  470. Move(buffer^,result[5],size);
  471. size := Length(s);
  472. Move(size,result[1],SizeOf(Integer));
  473. FreeMem(buffer);
  474. end;
  475. function ZCompressStr2(const s: String; level: TZCompressionLevel;
  476. windowBits, memLevel: Integer; strategy: TZStrategy): String;
  477. var
  478. buffer: Pointer;
  479. size : Integer;
  480. begin
  481. ZCompress2(PChar(s),Length(s),buffer,size,level,windowBits,memLevel,
  482. strategy);
  483. SetLength(result,size);
  484. Move(buffer^,result[1],size);
  485. FreeMem(buffer);
  486. end;
  487. function ZDecompressStr(const s: String): String;
  488. var
  489. buffer: Pointer;
  490. size : Integer;
  491. begin
  492. ZDecompress(PChar(s),Length(s),buffer,size);
  493. SetLength(result,size);
  494. Move(buffer^,result[1],size);
  495. FreeMem(buffer);
  496. end;
  497. function ZDecompressStrEx(const s: String): String;
  498. var
  499. buffer : Pointer;
  500. size : Integer;
  501. data : String;
  502. dataSize: Integer;
  503. begin
  504. Move(s[1],size,SizeOf(Integer));
  505. dataSize := Length(s) - SizeOf(Integer);
  506. SetLength(data,dataSize);
  507. Move(s[5],data[1],dataSize);
  508. ZDecompress(PChar(data),dataSize,buffer,size,size);
  509. SetLength(result,size);
  510. Move(buffer^,result[1],size);
  511. FreeMem(buffer);
  512. end;
  513. function ZDecompressStr2(const s: String; windowBits: Integer): String;
  514. var
  515. buffer: Pointer;
  516. size : Integer;
  517. begin
  518. ZDecompress2(PChar(s),Length(s),buffer,size,windowBits);
  519. SetLength(result,size);
  520. Move(buffer^,result[1],size);
  521. FreeMem(buffer);
  522. end;
  523. {** stream routines *********************************************************}
  524. procedure ZInternalCompressStream(zstream: TZStreamRec; inStream,
  525. outStream: TStream);
  526. const
  527. bufferSize = 32768;
  528. var
  529. zresult : Integer;
  530. inBuffer : Array [0..bufferSize-1] of Char;
  531. outBuffer: Array [0..bufferSize-1] of Char;
  532. inSize : Integer;
  533. outSize : Integer;
  534. begin
  535. inSize := inStream.Read(inBuffer,bufferSize);
  536. while inSize > 0 do
  537. begin
  538. zstream.next_in := inBuffer;
  539. zstream.avail_in := inSize;
  540. repeat
  541. zstream.next_out := outBuffer;
  542. zstream.avail_out := bufferSize;
  543. ZCompressCheck(deflate(zstream,Z_NO_FLUSH));
  544. // outSize := zstream.next_out - outBuffer;
  545. outSize := bufferSize - zstream.avail_out;
  546. outStream.Write(outBuffer,outSize);
  547. until (zstream.avail_in = 0) and (zstream.avail_out > 0);
  548. inSize := inStream.Read(inBuffer,bufferSize);
  549. end;
  550. repeat
  551. zstream.next_out := outBuffer;
  552. zstream.avail_out := bufferSize;
  553. zresult := ZCompressCheck(deflate(zstream,Z_FINISH));
  554. // outSize := zstream.next_out - outBuffer;
  555. outSize := bufferSize - zstream.avail_out;
  556. outStream.Write(outBuffer,outSize);
  557. until (zresult = Z_STREAM_END) and (zstream.avail_out > 0);
  558. ZCompressCheck(deflateEnd(zstream));
  559. end;
  560. procedure ZInternalDecompressStream(zstream: TZStreamRec; inStream,
  561. outStream: TStream);
  562. const
  563. bufferSize = 32768;
  564. var
  565. zresult : Integer;
  566. inBuffer : Array [0..bufferSize-1] of Char;
  567. outBuffer: Array [0..bufferSize-1] of Char;
  568. inSize : Integer;
  569. outSize : Integer;
  570. begin
  571. inSize := inStream.Read(inBuffer,bufferSize);
  572. while inSize > 0 do
  573. begin
  574. zstream.next_in := inBuffer;
  575. zstream.avail_in := inSize;
  576. repeat
  577. zstream.next_out := outBuffer;
  578. zstream.avail_out := bufferSize;
  579. ZDecompressCheck(inflate(zstream,Z_NO_FLUSH));
  580. // outSize := zstream.next_out - outBuffer;
  581. outSize := bufferSize - zstream.avail_out;
  582. outStream.Write(outBuffer,outSize);
  583. until (zstream.avail_in = 0) and (zstream.avail_out > 0);
  584. inSize := inStream.Read(inBuffer,bufferSize);
  585. end;
  586. repeat
  587. zstream.next_out := outBuffer;
  588. zstream.avail_out := bufferSize;
  589. zresult := ZDecompressCheck(inflate(zstream,Z_FINISH));
  590. // outSize := zstream.next_out - outBuffer;
  591. outSize := bufferSize - zstream.avail_out;
  592. outStream.Write(outBuffer,outSize);
  593. until (zresult = Z_STREAM_END) and (zstream.avail_out > 0);
  594. ZDecompressCheck(inflateEnd(zstream));
  595. end;
  596. procedure ZCompressStream(inStream, outStream: TStream;
  597. level: TZCompressionLevel);
  598. var
  599. zstream: TZStreamRec;
  600. begin
  601. FillChar(zstream,SizeOf(TZStreamRec),0);
  602. ZCompressCheck(DeflateInit(zstream,ZLevels[level]));
  603. ZInternalCompressStream(zstream,inStream,outStream);
  604. end;
  605. procedure ZCompressStream2(inStream, outStream: TStream;
  606. level: TZCompressionLevel; windowBits, memLevel: Integer;
  607. strategy: TZStrategy);
  608. var
  609. zstream: TZStreamRec;
  610. begin
  611. FillChar(zstream,SizeOf(TZStreamRec),0);
  612. ZCompressCheck(DeflateInit2(zstream,ZLevels[level],Z_DEFLATED,windowBits,
  613. memLevel,ZStrategies[strategy]));
  614. ZInternalCompressStream(zstream,inStream,outStream);
  615. end;
  616. procedure ZDecompressStream(inStream, outStream: TStream);
  617. var
  618. zstream: TZStreamRec;
  619. begin
  620. FillChar(zstream,SizeOf(TZStreamRec),0);
  621. ZDecompressCheck(InflateInit(zstream));
  622. ZInternalDecompressStream(zstream,inStream,outStream);
  623. end;
  624. procedure ZDecompressStream2(inStream, outStream: TStream;
  625. windowBits: Integer);
  626. var
  627. zstream: TZStreamRec;
  628. begin
  629. FillChar(zstream,SizeOf(TZStreamRec),0);
  630. ZDecompressCheck(InflateInit2(zstream,windowBits));
  631. ZInternalDecompressStream(zstream,inStream,outStream);
  632. end;
  633. {** TCustomZStream **********************************************************}
  634. constructor TCustomZStream.Create(stream: TStream);
  635. begin
  636. inherited Create;
  637. FStream := stream;
  638. FStreamPos := stream.Position;
  639. end;
  640. procedure TCustomZStream.DoProgress;
  641. begin
  642. if Assigned(FOnProgress) then FOnProgress(Self);
  643. end;
  644. {** TZCompressionStream *****************************************************}
  645. constructor TZCompressionStream.Create(dest: TStream;
  646. compressionLevel: TZCompressionLevel);
  647. begin
  648. inherited Create(dest);
  649. FZStream.next_out := FBuffer;
  650. FZStream.avail_out := SizeOf(FBuffer);
  651. ZCompressCheck(DeflateInit(FZStream,ZLevels[compressionLevel]));
  652. end;
  653. constructor TZCompressionStream.Create(dest: TStream;
  654. compressionLevel: TZCompressionLevel; windowBits, memLevel: Integer;
  655. strategy: TZStrategy);
  656. begin
  657. inherited Create(dest);
  658. FZStream.next_out := FBuffer;
  659. FZStream.avail_out := SizeOf(FBuffer);
  660. ZCompressCheck(DeflateInit2(FZStream,ZLevels[compressionLevel],Z_DEFLATED,
  661. windowBits,memLevel,ZStrategies[strategy]));
  662. end;
  663. destructor TZCompressionStream.Destroy;
  664. begin
  665. FZStream.next_in := Nil;
  666. FZStream.avail_in := 0;
  667. try
  668. if FStream.Position <> FStreamPos then FStream.Position := FStreamPos;
  669. while ZCompressCheck(deflate(FZStream,Z_FINISH)) <> Z_STREAM_END do
  670. begin
  671. FStream.WriteBuffer(FBuffer,SizeOf(FBuffer) - FZStream.avail_out);
  672. FZStream.next_out := FBuffer;
  673. FZStream.avail_out := SizeOf(FBuffer);
  674. end;
  675. if FZStream.avail_out < SizeOf(FBuffer) then
  676. begin
  677. FStream.WriteBuffer(FBuffer,SizeOf(FBuffer) - FZStream.avail_out);
  678. end;
  679. finally
  680. deflateEnd(FZStream);
  681. end;
  682. inherited Destroy;
  683. end;
  684. function TZCompressionStream.Read(var buffer; count: Longint): Longint;
  685. begin
  686. raise EZCompressionError.Create(SZInvalid);
  687. end;
  688. function TZCompressionStream.Write(const buffer; count: Longint): Longint;
  689. begin
  690. FZStream.next_in := @buffer;
  691. FZStream.avail_in := count;
  692. if FStream.Position <> FStreamPos then FStream.Position := FStreamPos;
  693. while FZStream.avail_in > 0 do
  694. begin
  695. ZCompressCheck(deflate(FZStream,Z_NO_FLUSH));
  696. if FZStream.avail_out = 0 then
  697. begin
  698. FStream.WriteBuffer(FBuffer,SizeOf(FBuffer));
  699. FZStream.next_out := FBuffer;
  700. FZStream.avail_out := SizeOf(FBuffer);
  701. FStreamPos := FStream.Position;
  702. DoProgress;
  703. end;
  704. end;
  705. result := Count;
  706. end;
  707. function TZCompressionStream.Seek(offset: Longint; origin: Word): Longint;
  708. begin
  709. if (offset = 0) and (origin = soFromCurrent) then
  710. begin
  711. result := FZStream.total_in;
  712. end
  713. else raise EZCompressionError.Create(SZInvalid);
  714. end;
  715. function TZCompressionStream.GetCompressionRate: Single;
  716. begin
  717. if FZStream.total_in = 0 then result := 0
  718. else result := (1.0 - (FZStream.total_out / FZStream.total_in)) * 100.0;
  719. end;
  720. {** TZDecompressionStream ***************************************************}
  721. constructor TZDecompressionStream.Create(source: TStream);
  722. begin
  723. inherited Create(source);
  724. FZStream.next_in := FBuffer;
  725. FZStream.avail_in := 0;
  726. ZDecompressCheck(InflateInit(FZStream));
  727. end;
  728. constructor TZDecompressionStream.Create(source: TStream;
  729. windowBits: Integer);
  730. begin
  731. inherited Create(source);
  732. FZStream.next_in := FBuffer;
  733. FZStream.avail_in := 0;
  734. ZDecompressCheck(InflateInit2(FZStream,windowBits));
  735. end;
  736. destructor TZDecompressionStream.Destroy;
  737. begin
  738. inflateEnd(FZStream);
  739. inherited Destroy;
  740. end;
  741. function TZDecompressionStream.Read(var buffer; count: Longint): Longint;
  742. var
  743. zresult: Integer;
  744. begin
  745. FZStream.next_out := @buffer;
  746. FZStream.avail_out := count;
  747. if FStream.Position <> FStreamPos then FStream.Position := FStreamPos;
  748. zresult := Z_OK;
  749. while (FZStream.avail_out > 0) and (zresult <> Z_STREAM_END) do
  750. begin
  751. if FZStream.avail_in = 0 then
  752. begin
  753. FZStream.avail_in := FStream.Read(FBuffer,SizeOf(FBuffer));
  754. if FZStream.avail_in = 0 then
  755. begin
  756. result := count - FZStream.avail_out;
  757. Exit;
  758. end;
  759. FZStream.next_in := FBuffer;
  760. FStreamPos := FStream.Position;
  761. DoProgress;
  762. end;
  763. zresult := ZDecompressCheck(inflate(FZStream,Z_NO_FLUSH));
  764. end;
  765. if (zresult = Z_STREAM_END) and (FZStream.avail_in > 0) then
  766. begin
  767. FStream.Position := FStream.Position - FZStream.avail_in;
  768. FStreamPos := FStream.Position;
  769. FZStream.avail_in := 0;
  770. end;
  771. result := count - FZStream.avail_out;
  772. end;
  773. function TZDecompressionStream.Write(const Buffer; Count: Longint): Longint;
  774. begin
  775. raise EZDecompressionError.Create(SZInvalid);
  776. end;
  777. function TZDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
  778. var
  779. buf: Array [0..8191] of Char;
  780. i : Integer;
  781. begin
  782. if (offset = 0) and (origin = soFromBeginning) then
  783. begin
  784. ZDecompressCheck(inflateReset(FZStream));
  785. FZStream.next_in := FBuffer;
  786. FZStream.avail_in := 0;
  787. FStream.Position := 0;
  788. FStreamPos := 0;
  789. end
  790. else if ((offset >= 0) and (origin = soFromCurrent)) or
  791. (((offset - FZStream.total_out) > 0) and (origin = soFromBeginning)) then
  792. begin
  793. if origin = soFromBeginning then Dec(offset,FZStream.total_out);
  794. if offset > 0 then
  795. begin
  796. for i := 1 to offset div SizeOf(buf) do ReadBuffer(buf,SizeOf(buf));
  797. ReadBuffer(buf,offset mod SizeOf(buf));
  798. end;
  799. end
  800. else if (offset = 0) and (origin = soFromEnd) then
  801. begin
  802. while Read(buf,SizeOf(buf)) > 0 do ;
  803. end
  804. else raise EZDecompressionError.Create(SZInvalid);
  805. result := FZStream.total_out;
  806. end;
  807. end.