]>
Commit | Line | Data |
---|---|---|
8e5578ea | 1 | {*******************************************************} |
2 | { } | |
3 | { Delphi Supplemental Components } | |
4 | { ZLIB Data Compression Interface Unit } | |
5 | { } | |
6 | { Copyright (c) 1997 Borland International } | |
7 | { } | |
8 | {*******************************************************} | |
9 | ||
10 | { Modified for zlib 1.1.3 by Davide Moretti <dave@rimini.com } | |
11 | ||
12 | unit zlib; | |
13 | ||
14 | interface | |
15 | ||
16 | uses Sysutils, Classes; | |
17 | ||
18 | type | |
19 | TAlloc = function (AppData: Pointer; Items, Size: Integer): Pointer; | |
20 | TFree = procedure (AppData, Block: Pointer); | |
21 | ||
22 | // Internal structure. Ignore. | |
23 | TZStreamRec = packed record | |
24 | next_in: PChar; // next input byte | |
25 | avail_in: Integer; // number of bytes available at next_in | |
26 | total_in: Integer; // total nb of input bytes read so far | |
27 | ||
28 | next_out: PChar; // next output byte should be put here | |
29 | avail_out: Integer; // remaining free space at next_out | |
30 | total_out: Integer; // total nb of bytes output so far | |
31 | ||
32 | msg: PChar; // last error message, NULL if no error | |
33 | internal: Pointer; // not visible by applications | |
34 | ||
35 | zalloc: TAlloc; // used to allocate the internal state | |
36 | zfree: TFree; // used to free the internal state | |
37 | AppData: Pointer; // private data object passed to zalloc and zfree | |
38 | ||
39 | data_type: Integer; // best guess about the data type: ascii or binary | |
40 | adler: Integer; // adler32 value of the uncompressed data | |
41 | reserved: Integer; // reserved for future use | |
42 | end; | |
43 | ||
44 | // Abstract ancestor class | |
45 | TCustomZlibStream = class(TStream) | |
46 | private | |
47 | FStrm: TStream; | |
48 | FStrmPos: Integer; | |
49 | FOnProgress: TNotifyEvent; | |
50 | FZRec: TZStreamRec; | |
51 | FBuffer: array [Word] of Char; | |
52 | protected | |
53 | procedure Progress(Sender: TObject); dynamic; | |
54 | property OnProgress: TNotifyEvent read FOnProgress write FOnProgress; | |
55 | constructor Create(Strm: TStream); | |
56 | end; | |
57 | ||
58 | { TCompressionStream compresses data on the fly as data is written to it, and | |
59 | stores the compressed data to another stream. | |
60 | ||
61 | TCompressionStream is write-only and strictly sequential. Reading from the | |
62 | stream will raise an exception. Using Seek to move the stream pointer | |
63 | will raise an exception. | |
64 | ||
65 | Output data is cached internally, written to the output stream only when | |
66 | the internal output buffer is full. All pending output data is flushed | |
67 | when the stream is destroyed. | |
68 | ||
69 | The Position property returns the number of uncompressed bytes of | |
70 | data that have been written to the stream so far. | |
71 | ||
72 | CompressionRate returns the on-the-fly percentage by which the original | |
73 | data has been compressed: (1 - (CompressedBytes / UncompressedBytes)) * 100 | |
74 | If raw data size = 100 and compressed data size = 25, the CompressionRate | |
75 | is 75% | |
76 | ||
77 | The OnProgress event is called each time the output buffer is filled and | |
78 | written to the output stream. This is useful for updating a progress | |
79 | indicator when you are writing a large chunk of data to the compression | |
80 | stream in a single call.} | |
81 | ||
82 | ||
83 | TCompressionLevel = (clNone, clFastest, clDefault, clMax); | |
84 | ||
85 | TCompressionStream = class(TCustomZlibStream) | |
86 | private | |
87 | function GetCompressionRate: Single; | |
88 | public | |
89 | constructor Create(CompressionLevel: TCompressionLevel; Dest: TStream); | |
90 | destructor Destroy; override; | |
91 | function Read(var Buffer; Count: Longint): Longint; override; | |
92 | function Write(const Buffer; Count: Longint): Longint; override; | |
93 | function Seek(Offset: Longint; Origin: Word): Longint; override; | |
94 | property CompressionRate: Single read GetCompressionRate; | |
95 | property OnProgress; | |
96 | end; | |
97 | ||
98 | { TDecompressionStream decompresses data on the fly as data is read from it. | |
99 | ||
100 | Compressed data comes from a separate source stream. TDecompressionStream | |
101 | is read-only and unidirectional; you can seek forward in the stream, but not | |
102 | backwards. The special case of setting the stream position to zero is | |
103 | allowed. Seeking forward decompresses data until the requested position in | |
104 | the uncompressed data has been reached. Seeking backwards, seeking relative | |
105 | to the end of the stream, requesting the size of the stream, and writing to | |
106 | the stream will raise an exception. | |
107 | ||
108 | The Position property returns the number of bytes of uncompressed data that | |
109 | have been read from the stream so far. | |
110 | ||
111 | The OnProgress event is called each time the internal input buffer of | |
112 | compressed data is exhausted and the next block is read from the input stream. | |
113 | This is useful for updating a progress indicator when you are reading a | |
114 | large chunk of data from the decompression stream in a single call.} | |
115 | ||
116 | TDecompressionStream = class(TCustomZlibStream) | |
117 | public | |
118 | constructor Create(Source: TStream); | |
119 | destructor Destroy; override; | |
120 | function Read(var Buffer; Count: Longint): Longint; override; | |
121 | function Write(const Buffer; Count: Longint): Longint; override; | |
122 | function Seek(Offset: Longint; Origin: Word): Longint; override; | |
123 | property OnProgress; | |
124 | end; | |
125 | ||
126 | ||
127 | ||
128 | { CompressBuf compresses data, buffer to buffer, in one call. | |
129 | In: InBuf = ptr to compressed data | |
130 | InBytes = number of bytes in InBuf | |
131 | Out: OutBuf = ptr to newly allocated buffer containing decompressed data | |
132 | OutBytes = number of bytes in OutBuf } | |
133 | procedure CompressBuf(const InBuf: Pointer; InBytes: Integer; | |
134 | out OutBuf: Pointer; out OutBytes: Integer); | |
135 | ||
136 | ||
137 | { DecompressBuf decompresses data, buffer to buffer, in one call. | |
138 | In: InBuf = ptr to compressed data | |
139 | InBytes = number of bytes in InBuf | |
140 | OutEstimate = zero, or est. size of the decompressed data | |
141 | Out: OutBuf = ptr to newly allocated buffer containing decompressed data | |
142 | OutBytes = number of bytes in OutBuf } | |
143 | procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer; | |
144 | OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer); | |
145 | ||
146 | const | |
147 | zlib_version = '1.1.3'; | |
148 | ||
149 | type | |
150 | EZlibError = class(Exception); | |
151 | ECompressionError = class(EZlibError); | |
152 | EDecompressionError = class(EZlibError); | |
153 | ||
154 | function adler32(adler: Integer; buf: PChar; len: Integer): Integer; | |
155 | ||
156 | implementation | |
157 | ||
158 | const | |
159 | Z_NO_FLUSH = 0; | |
160 | Z_PARTIAL_FLUSH = 1; | |
161 | Z_SYNC_FLUSH = 2; | |
162 | Z_FULL_FLUSH = 3; | |
163 | Z_FINISH = 4; | |
164 | ||
165 | Z_OK = 0; | |
166 | Z_STREAM_END = 1; | |
167 | Z_NEED_DICT = 2; | |
168 | Z_ERRNO = (-1); | |
169 | Z_STREAM_ERROR = (-2); | |
170 | Z_DATA_ERROR = (-3); | |
171 | Z_MEM_ERROR = (-4); | |
172 | Z_BUF_ERROR = (-5); | |
173 | Z_VERSION_ERROR = (-6); | |
174 | ||
175 | Z_NO_COMPRESSION = 0; | |
176 | Z_BEST_SPEED = 1; | |
177 | Z_BEST_COMPRESSION = 9; | |
178 | Z_DEFAULT_COMPRESSION = (-1); | |
179 | ||
180 | Z_FILTERED = 1; | |
181 | Z_HUFFMAN_ONLY = 2; | |
182 | Z_DEFAULT_STRATEGY = 0; | |
183 | ||
184 | Z_BINARY = 0; | |
185 | Z_ASCII = 1; | |
186 | Z_UNKNOWN = 2; | |
187 | ||
188 | Z_DEFLATED = 8; | |
189 | ||
190 | _z_errmsg: array[0..9] of PChar = ( | |
191 | 'need dictionary', // Z_NEED_DICT (2) | |
192 | 'stream end', // Z_STREAM_END (1) | |
193 | '', // Z_OK (0) | |
194 | 'file error', // Z_ERRNO (-1) | |
195 | 'stream error', // Z_STREAM_ERROR (-2) | |
196 | 'data error', // Z_DATA_ERROR (-3) | |
197 | 'insufficient memory', // Z_MEM_ERROR (-4) | |
198 | 'buffer error', // Z_BUF_ERROR (-5) | |
199 | 'incompatible version', // Z_VERSION_ERROR (-6) | |
200 | '' | |
201 | ); | |
202 | ||
203 | {$L deflate.obj} | |
204 | {$L inflate.obj} | |
205 | {$L inftrees.obj} | |
206 | {$L trees.obj} | |
207 | {$L adler32.obj} | |
208 | {$L infblock.obj} | |
209 | {$L infcodes.obj} | |
210 | {$L infutil.obj} | |
211 | {$L inffast.obj} | |
212 | ||
213 | procedure _tr_init; external; | |
214 | procedure _tr_tally; external; | |
215 | procedure _tr_flush_block; external; | |
216 | procedure _tr_align; external; | |
217 | procedure _tr_stored_block; external; | |
218 | function adler32; external; | |
219 | procedure inflate_blocks_new; external; | |
220 | procedure inflate_blocks; external; | |
221 | procedure inflate_blocks_reset; external; | |
222 | procedure inflate_blocks_free; external; | |
223 | procedure inflate_set_dictionary; external; | |
224 | procedure inflate_trees_bits; external; | |
225 | procedure inflate_trees_dynamic; external; | |
226 | procedure inflate_trees_fixed; external; | |
227 | procedure inflate_codes_new; external; | |
228 | procedure inflate_codes; external; | |
229 | procedure inflate_codes_free; external; | |
230 | procedure _inflate_mask; external; | |
231 | procedure inflate_flush; external; | |
232 | procedure inflate_fast; external; | |
233 | ||
234 | procedure _memset(P: Pointer; B: Byte; count: Integer);cdecl; | |
235 | begin | |
236 | FillChar(P^, count, B); | |
237 | end; | |
238 | ||
239 | procedure _memcpy(dest, source: Pointer; count: Integer);cdecl; | |
240 | begin | |
241 | Move(source^, dest^, count); | |
242 | end; | |
243 | ||
244 | ||
245 | ||
246 | // deflate compresses data | |
247 | function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar; | |
248 | recsize: Integer): Integer; external; | |
249 | function deflate(var strm: TZStreamRec; flush: Integer): Integer; external; | |
250 | function deflateEnd(var strm: TZStreamRec): Integer; external; | |
251 | ||
252 | // inflate decompresses data | |
253 | function inflateInit_(var strm: TZStreamRec; version: PChar; | |
254 | recsize: Integer): Integer; external; | |
255 | function inflate(var strm: TZStreamRec; flush: Integer): Integer; external; | |
256 | function inflateEnd(var strm: TZStreamRec): Integer; external; | |
257 | function inflateReset(var strm: TZStreamRec): Integer; external; | |
258 | ||
259 | ||
260 | function zcalloc(AppData: Pointer; Items, Size: Integer): Pointer; | |
261 | begin | |
262 | GetMem(Result, Items*Size); | |
263 | end; | |
264 | ||
265 | procedure zcfree(AppData, Block: Pointer); | |
266 | begin | |
267 | FreeMem(Block); | |
268 | end; | |
269 | ||
270 | function zlibCheck(code: Integer): Integer; | |
271 | begin | |
272 | Result := code; | |
273 | if code < 0 then | |
274 | raise EZlibError.Create('error'); //!! | |
275 | end; | |
276 | ||
277 | function CCheck(code: Integer): Integer; | |
278 | begin | |
279 | Result := code; | |
280 | if code < 0 then | |
281 | raise ECompressionError.Create('error'); //!! | |
282 | end; | |
283 | ||
284 | function DCheck(code: Integer): Integer; | |
285 | begin | |
286 | Result := code; | |
287 | if code < 0 then | |
288 | raise EDecompressionError.Create('error'); //!! | |
289 | end; | |
290 | ||
291 | procedure CompressBuf(const InBuf: Pointer; InBytes: Integer; | |
292 | out OutBuf: Pointer; out OutBytes: Integer); | |
293 | var | |
294 | strm: TZStreamRec; | |
295 | P: Pointer; | |
296 | begin | |
297 | FillChar(strm, sizeof(strm), 0); | |
298 | OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255; | |
299 | GetMem(OutBuf, OutBytes); | |
300 | try | |
301 | strm.next_in := InBuf; | |
302 | strm.avail_in := InBytes; | |
303 | strm.next_out := OutBuf; | |
304 | strm.avail_out := OutBytes; | |
305 | CCheck(deflateInit_(strm, Z_BEST_COMPRESSION, zlib_version, sizeof(strm))); | |
306 | try | |
307 | while CCheck(deflate(strm, Z_FINISH)) <> Z_STREAM_END do | |
308 | begin | |
309 | P := OutBuf; | |
310 | Inc(OutBytes, 256); | |
311 | ReallocMem(OutBuf, OutBytes); | |
312 | strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P))); | |
313 | strm.avail_out := 256; | |
314 | end; | |
315 | finally | |
316 | CCheck(deflateEnd(strm)); | |
317 | end; | |
318 | ReallocMem(OutBuf, strm.total_out); | |
319 | OutBytes := strm.total_out; | |
320 | except | |
321 | FreeMem(OutBuf); | |
322 | raise | |
323 | end; | |
324 | end; | |
325 | ||
326 | ||
327 | procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer; | |
328 | OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer); | |
329 | var | |
330 | strm: TZStreamRec; | |
331 | P: Pointer; | |
332 | BufInc: Integer; | |
333 | begin | |
334 | FillChar(strm, sizeof(strm), 0); | |
335 | BufInc := (InBytes + 255) and not 255; | |
336 | if OutEstimate = 0 then | |
337 | OutBytes := BufInc | |
338 | else | |
339 | OutBytes := OutEstimate; | |
340 | GetMem(OutBuf, OutBytes); | |
341 | try | |
342 | strm.next_in := InBuf; | |
343 | strm.avail_in := InBytes; | |
344 | strm.next_out := OutBuf; | |
345 | strm.avail_out := OutBytes; | |
346 | DCheck(inflateInit_(strm, zlib_version, sizeof(strm))); | |
347 | try | |
348 | while DCheck(inflate(strm, Z_FINISH)) <> Z_STREAM_END do | |
349 | begin | |
350 | P := OutBuf; | |
351 | Inc(OutBytes, BufInc); | |
352 | ReallocMem(OutBuf, OutBytes); | |
353 | strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P))); | |
354 | strm.avail_out := BufInc; | |
355 | end; | |
356 | finally | |
357 | DCheck(inflateEnd(strm)); | |
358 | end; | |
359 | ReallocMem(OutBuf, strm.total_out); | |
360 | OutBytes := strm.total_out; | |
361 | except | |
362 | FreeMem(OutBuf); | |
363 | raise | |
364 | end; | |
365 | end; | |
366 | ||
367 | ||
368 | // TCustomZlibStream | |
369 | ||
370 | constructor TCustomZLibStream.Create(Strm: TStream); | |
371 | begin | |
372 | inherited Create; | |
373 | FStrm := Strm; | |
374 | FStrmPos := Strm.Position; | |
375 | end; | |
376 | ||
377 | procedure TCustomZLibStream.Progress(Sender: TObject); | |
378 | begin | |
379 | if Assigned(FOnProgress) then FOnProgress(Sender); | |
380 | end; | |
381 | ||
382 | ||
383 | // TCompressionStream | |
384 | ||
385 | constructor TCompressionStream.Create(CompressionLevel: TCompressionLevel; | |
386 | Dest: TStream); | |
387 | const | |
388 | Levels: array [TCompressionLevel] of ShortInt = | |
389 | (Z_NO_COMPRESSION, Z_BEST_SPEED, Z_DEFAULT_COMPRESSION, Z_BEST_COMPRESSION); | |
390 | begin | |
391 | inherited Create(Dest); | |
392 | FZRec.next_out := FBuffer; | |
393 | FZRec.avail_out := sizeof(FBuffer); | |
394 | CCheck(deflateInit_(FZRec, Levels[CompressionLevel], zlib_version, sizeof(FZRec))); | |
395 | end; | |
396 | ||
397 | destructor TCompressionStream.Destroy; | |
398 | begin | |
399 | FZRec.next_in := nil; | |
400 | FZRec.avail_in := 0; | |
401 | try | |
402 | if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos; | |
403 | while (CCheck(deflate(FZRec, Z_FINISH)) <> Z_STREAM_END) | |
404 | and (FZRec.avail_out = 0) do | |
405 | begin | |
406 | FStrm.WriteBuffer(FBuffer, sizeof(FBuffer)); | |
407 | FZRec.next_out := FBuffer; | |
408 | FZRec.avail_out := sizeof(FBuffer); | |
409 | end; | |
410 | if FZRec.avail_out < sizeof(FBuffer) then | |
411 | FStrm.WriteBuffer(FBuffer, sizeof(FBuffer) - FZRec.avail_out); | |
412 | finally | |
413 | deflateEnd(FZRec); | |
414 | end; | |
415 | inherited Destroy; | |
416 | end; | |
417 | ||
418 | function TCompressionStream.Read(var Buffer; Count: Longint): Longint; | |
419 | begin | |
420 | raise ECompressionError.Create('Invalid stream operation'); | |
421 | end; | |
422 | ||
423 | function TCompressionStream.Write(const Buffer; Count: Longint): Longint; | |
424 | begin | |
425 | FZRec.next_in := @Buffer; | |
426 | FZRec.avail_in := Count; | |
427 | if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos; | |
428 | while (FZRec.avail_in > 0) do | |
429 | begin | |
430 | CCheck(deflate(FZRec, 0)); | |
431 | if FZRec.avail_out = 0 then | |
432 | begin | |
433 | FStrm.WriteBuffer(FBuffer, sizeof(FBuffer)); | |
434 | FZRec.next_out := FBuffer; | |
435 | FZRec.avail_out := sizeof(FBuffer); | |
436 | FStrmPos := FStrm.Position; | |
437 | Progress(Self); | |
438 | end; | |
439 | end; | |
440 | Result := Count; | |
441 | end; | |
442 | ||
443 | function TCompressionStream.Seek(Offset: Longint; Origin: Word): Longint; | |
444 | begin | |
445 | if (Offset = 0) and (Origin = soFromCurrent) then | |
446 | Result := FZRec.total_in | |
447 | else | |
448 | raise ECompressionError.Create('Invalid stream operation'); | |
449 | end; | |
450 | ||
451 | function TCompressionStream.GetCompressionRate: Single; | |
452 | begin | |
453 | if FZRec.total_in = 0 then | |
454 | Result := 0 | |
455 | else | |
456 | Result := (1.0 - (FZRec.total_out / FZRec.total_in)) * 100.0; | |
457 | end; | |
458 | ||
459 | ||
460 | // TDecompressionStream | |
461 | ||
462 | constructor TDecompressionStream.Create(Source: TStream); | |
463 | begin | |
464 | inherited Create(Source); | |
465 | FZRec.next_in := FBuffer; | |
466 | FZRec.avail_in := 0; | |
467 | DCheck(inflateInit_(FZRec, zlib_version, sizeof(FZRec))); | |
468 | end; | |
469 | ||
470 | destructor TDecompressionStream.Destroy; | |
471 | begin | |
472 | inflateEnd(FZRec); | |
473 | inherited Destroy; | |
474 | end; | |
475 | ||
476 | function TDecompressionStream.Read(var Buffer; Count: Longint): Longint; | |
477 | begin | |
478 | FZRec.next_out := @Buffer; | |
479 | FZRec.avail_out := Count; | |
480 | if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos; | |
481 | while (FZRec.avail_out > 0) do | |
482 | begin | |
483 | if FZRec.avail_in = 0 then | |
484 | begin | |
485 | FZRec.avail_in := FStrm.Read(FBuffer, sizeof(FBuffer)); | |
486 | if FZRec.avail_in = 0 then | |
487 | begin | |
488 | Result := Count - FZRec.avail_out; | |
489 | Exit; | |
490 | end; | |
491 | FZRec.next_in := FBuffer; | |
492 | FStrmPos := FStrm.Position; | |
493 | Progress(Self); | |
494 | end; | |
495 | DCheck(inflate(FZRec, 0)); | |
496 | end; | |
497 | Result := Count; | |
498 | end; | |
499 | ||
500 | function TDecompressionStream.Write(const Buffer; Count: Longint): Longint; | |
501 | begin | |
502 | raise EDecompressionError.Create('Invalid stream operation'); | |
503 | end; | |
504 | ||
505 | function TDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint; | |
506 | var | |
507 | I: Integer; | |
508 | Buf: array [0..4095] of Char; | |
509 | begin | |
510 | if (Offset = 0) and (Origin = soFromBeginning) then | |
511 | begin | |
512 | DCheck(inflateReset(FZRec)); | |
513 | FZRec.next_in := FBuffer; | |
514 | FZRec.avail_in := 0; | |
515 | FStrm.Position := 0; | |
516 | FStrmPos := 0; | |
517 | end | |
518 | else if ( (Offset >= 0) and (Origin = soFromCurrent)) or | |
519 | ( ((Offset - FZRec.total_out) > 0) and (Origin = soFromBeginning)) then | |
520 | begin | |
521 | if Origin = soFromBeginning then Dec(Offset, FZRec.total_out); | |
522 | if Offset > 0 then | |
523 | begin | |
524 | for I := 1 to Offset div sizeof(Buf) do | |
525 | ReadBuffer(Buf, sizeof(Buf)); | |
526 | ReadBuffer(Buf, Offset mod sizeof(Buf)); | |
527 | end; | |
528 | end | |
529 | else | |
530 | raise EDecompressionError.Create('Invalid stream operation'); | |
531 | Result := FZRec.total_out; | |
532 | end; | |
533 | ||
534 | end. |