1 {*******************************************************}
3 { Delphi Supplemental Components }
4 { ZLIB Data Compression Interface Unit }
6 { Copyright (c) 1997 Borland International }
8 {*******************************************************}
10 { Modified for zlib 1.1.3 by Davide Moretti <dave@rimini.com }
16 uses Sysutils, Classes;
19 TAlloc = function (AppData: Pointer; Items, Size: Integer): Pointer;
20 TFree = procedure (AppData, Block: Pointer);
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
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
32 msg: PChar; // last error message, NULL if no error
33 internal: Pointer; // not visible by applications
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
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
44 // Abstract ancestor class
45 TCustomZlibStream = class(TStream)
49 FOnProgress: TNotifyEvent;
51 FBuffer: array [Word] of Char;
53 procedure Progress(Sender: TObject); dynamic;
54 property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
55 constructor Create(Strm: TStream);
58 { TCompressionStream compresses data on the fly as data is written to it, and
59 stores the compressed data to another stream.
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.
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.
69 The Position property returns the number of uncompressed bytes of
70 data that have been written to the stream so far.
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
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.}
83 TCompressionLevel = (clNone, clFastest, clDefault, clMax);
85 TCompressionStream = class(TCustomZlibStream)
87 function GetCompressionRate: Single;
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;
98 { TDecompressionStream decompresses data on the fly as data is read from it.
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.
108 The Position property returns the number of bytes of uncompressed data that
109 have been read from the stream so far.
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.}
116 TDecompressionStream = class(TCustomZlibStream)
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;
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);
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);
147 zlib_version = '1.1.3';
150 EZlibError = class(Exception);
151 ECompressionError = class(EZlibError);
152 EDecompressionError = class(EZlibError);
154 function adler32(adler: Integer; buf: PChar; len: Integer): Integer;
169 Z_STREAM_ERROR = (-2);
173 Z_VERSION_ERROR = (-6);
175 Z_NO_COMPRESSION = 0;
177 Z_BEST_COMPRESSION = 9;
178 Z_DEFAULT_COMPRESSION = (-1);
182 Z_DEFAULT_STRATEGY = 0;
190 _z_errmsg: array[0..9] of PChar = (
191 'need dictionary', // Z_NEED_DICT (2)
192 'stream end', // Z_STREAM_END (1)
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)
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;
234 procedure _memset(P: Pointer; B: Byte; count: Integer);cdecl;
236 FillChar(P^, count, B);
239 procedure _memcpy(dest, source: Pointer; count: Integer);cdecl;
241 Move(source^, dest^, count);
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;
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;
260 function zcalloc(AppData: Pointer; Items, Size: Integer): Pointer;
262 GetMem(Result, Items*Size);
265 procedure zcfree(AppData, Block: Pointer);
270 function zlibCheck(code: Integer): Integer;
274 raise EZlibError.Create('error'); //!!
277 function CCheck(code: Integer): Integer;
281 raise ECompressionError.Create('error'); //!!
284 function DCheck(code: Integer): Integer;
288 raise EDecompressionError.Create('error'); //!!
291 procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
292 out OutBuf: Pointer; out OutBytes: Integer);
297 FillChar(strm, sizeof(strm), 0);
298 OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255;
299 GetMem(OutBuf, OutBytes);
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)));
307 while CCheck(deflate(strm, Z_FINISH)) <> Z_STREAM_END do
311 ReallocMem(OutBuf, OutBytes);
312 strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
313 strm.avail_out := 256;
316 CCheck(deflateEnd(strm));
318 ReallocMem(OutBuf, strm.total_out);
319 OutBytes := strm.total_out;
327 procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
328 OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);
334 FillChar(strm, sizeof(strm), 0);
335 BufInc := (InBytes + 255) and not 255;
336 if OutEstimate = 0 then
339 OutBytes := OutEstimate;
340 GetMem(OutBuf, OutBytes);
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)));
348 while DCheck(inflate(strm, Z_FINISH)) <> Z_STREAM_END do
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;
357 DCheck(inflateEnd(strm));
359 ReallocMem(OutBuf, strm.total_out);
360 OutBytes := strm.total_out;
370 constructor TCustomZLibStream.Create(Strm: TStream);
374 FStrmPos := Strm.Position;
377 procedure TCustomZLibStream.Progress(Sender: TObject);
379 if Assigned(FOnProgress) then FOnProgress(Sender);
383 // TCompressionStream
385 constructor TCompressionStream.Create(CompressionLevel: TCompressionLevel;
388 Levels: array [TCompressionLevel] of ShortInt =
389 (Z_NO_COMPRESSION, Z_BEST_SPEED, Z_DEFAULT_COMPRESSION, Z_BEST_COMPRESSION);
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)));
397 destructor TCompressionStream.Destroy;
399 FZRec.next_in := nil;
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
406 FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
407 FZRec.next_out := FBuffer;
408 FZRec.avail_out := sizeof(FBuffer);
410 if FZRec.avail_out < sizeof(FBuffer) then
411 FStrm.WriteBuffer(FBuffer, sizeof(FBuffer) - FZRec.avail_out);
418 function TCompressionStream.Read(var Buffer; Count: Longint): Longint;
420 raise ECompressionError.Create('Invalid stream operation');
423 function TCompressionStream.Write(const Buffer; Count: Longint): Longint;
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
430 CCheck(deflate(FZRec, 0));
431 if FZRec.avail_out = 0 then
433 FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
434 FZRec.next_out := FBuffer;
435 FZRec.avail_out := sizeof(FBuffer);
436 FStrmPos := FStrm.Position;
443 function TCompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
445 if (Offset = 0) and (Origin = soFromCurrent) then
446 Result := FZRec.total_in
448 raise ECompressionError.Create('Invalid stream operation');
451 function TCompressionStream.GetCompressionRate: Single;
453 if FZRec.total_in = 0 then
456 Result := (1.0 - (FZRec.total_out / FZRec.total_in)) * 100.0;
460 // TDecompressionStream
462 constructor TDecompressionStream.Create(Source: TStream);
464 inherited Create(Source);
465 FZRec.next_in := FBuffer;
467 DCheck(inflateInit_(FZRec, zlib_version, sizeof(FZRec)));
470 destructor TDecompressionStream.Destroy;
476 function TDecompressionStream.Read(var Buffer; Count: Longint): Longint;
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
483 if FZRec.avail_in = 0 then
485 FZRec.avail_in := FStrm.Read(FBuffer, sizeof(FBuffer));
486 if FZRec.avail_in = 0 then
488 Result := Count - FZRec.avail_out;
491 FZRec.next_in := FBuffer;
492 FStrmPos := FStrm.Position;
495 DCheck(inflate(FZRec, 0));
500 function TDecompressionStream.Write(const Buffer; Count: Longint): Longint;
502 raise EDecompressionError.Create('Invalid stream operation');
505 function TDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
508 Buf: array [0..4095] of Char;
510 if (Offset = 0) and (Origin = soFromBeginning) then
512 DCheck(inflateReset(FZRec));
513 FZRec.next_in := FBuffer;
518 else if ( (Offset >= 0) and (Origin = soFromCurrent)) or
519 ( ((Offset - FZRec.total_out) > 0) and (Origin = soFromBeginning)) then
521 if Origin = soFromBeginning then Dec(Offset, FZRec.total_out);
524 for I := 1 to Offset div sizeof(Buf) do
525 ReadBuffer(Buf, sizeof(Buf));
526 ReadBuffer(Buf, Offset mod sizeof(Buf));
530 raise EDecompressionError.Create('Invalid stream operation');
531 Result := FZRec.total_out;