diff options
Diffstat (limited to 'contrib/delphi2/zlib.pas')
-rw-r--r-- | contrib/delphi2/zlib.pas | 534 |
1 files changed, 534 insertions, 0 deletions
diff --git a/contrib/delphi2/zlib.pas b/contrib/delphi2/zlib.pas new file mode 100644 index 0000000..10ae4ca --- /dev/null +++ b/contrib/delphi2/zlib.pas | |||
@@ -0,0 +1,534 @@ | |||
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. | ||