1 {*******************************************************}
3 { Delphi Supplemental Components }
4 { ZLIB Data Compression Interface Unit }
6 { Copyright (c) 1997 Borland International }
7 { Copyright (c) 1998 Jacques Nomssi Nzali }
9 {*******************************************************}
13 Vampyre Imaging Library
15 http://imaginglib.sourceforge.net
17 You can choose which pascal zlib implementation will be
18 used. IMPASZLIB and FPCPASZLIB are translations of zlib
19 to pascal so they don't need any *.obj files.
20 The others are interfaces to *.obj files (Windows) or
21 *.so libraries (Linux).
22 Default implementation is IMPASZLIB because it can be compiled
23 by all supported compilers and works on all supported platforms.
24 I usually use implementation with the fastest decompression
25 when building release Win32 binaries.
26 FPCPASZLIB is useful for Lazarus applications. FPC's zlib is linked
27 to exe by default so there is no need to link additional (and almost identical)
30 There is a small speed comparison table of some of the
31 supported implementations (TGA image 28 311 570 bytes, compression level = 6,
32 Delphi 9, Win32, Athlon XP 1900).
34 ZLib version Decompression Compression Comp. Size
35 IMPASZLIB | 1.1.2 | 824 ms | 4 280 ms | 18 760 133 B
36 ZLIBEX | 1.2.2 | 710 ms | 1 590 ms* | 19 056 621 B
37 DELPHIZLIB | 1.0.4 | 976 ms | 9 190 ms | 18 365 562 B
38 ZLIBPAS | 1.2.3 | 680 ms | 3 790 ms | 18 365 387 B
39 * obj files are compiled with compression level hardcoded to 1 (fastest)
44 {$I ../ImagingOptions.inc}
54 { Automatically use FPC's PasZLib when compiling with FPC.}
62 {$IF Defined(IMPASZLIB)}
63 { Use paszlib modified by me for Delphi and FPC }
64 imzdeflate
, imzinflate
, impaszlib
,
65 {$ELSEIF Defined(FPCPASZLIB)}
68 {$ELSEIF Defined(ZLIBPAS)}
69 { Pascal interface to ZLib shipped with ZLib C source }
71 {$ELSEIF Defined(ZLIBEX)}
74 {$ELSEIF Defined(DELPHIZLIB)}
75 { Use ZLib unit shipped with Delphi }
78 ImagingTypes
, SysUtils
, Classes
;
80 {$IF Defined(IMPASZLIB) or Defined(FPCPASZLIB) or Defined(ZLIBPAS)}
82 TZStreamRec
= z_stream
;
100 Z_VERSION_ERROR
= -6;
102 Z_NO_COMPRESSION
= 0;
104 Z_BEST_COMPRESSION
= 9;
105 Z_DEFAULT_COMPRESSION
= -1;
110 Z_DEFAULT_STRATEGY
= 0;
119 { Abstract ancestor class }
120 TCustomZlibStream
= class(TStream
)
124 FOnProgress
: TNotifyEvent
;
126 FBuffer
: array [Word] of Byte;
128 procedure Progress(Sender
: TObject
); dynamic;
129 property OnProgress
: TNotifyEvent read FOnProgress write FOnProgress
;
130 constructor Create(Strm
: TStream
);
133 { TCompressionStream compresses data on the fly as data is written to it, and
134 stores the compressed data to another stream.
136 TCompressionStream is write-only and strictly sequential. Reading from the
137 stream will raise an exception. Using Seek to move the stream pointer
138 will raise an exception.
140 Output data is cached internally, written to the output stream only when
141 the internal output buffer is full. All pending output data is flushed
142 when the stream is destroyed.
144 The Position property returns the number of uncompressed bytes of
145 data that have been written to the stream so far.
147 CompressionRate returns the on-the-fly percentage by which the original
148 data has been compressed: (1 - (CompressedBytes / UncompressedBytes)) * 100
149 If raw data size = 100 and compressed data size = 25, the CompressionRate
152 The OnProgress event is called each time the output buffer is filled and
153 written to the output stream. This is useful for updating a progress
154 indicator when you are writing a large chunk of data to the compression
155 stream in a single call.}
158 TCompressionLevel
= (clNone
, clFastest
, clDefault
, clMax
);
160 TCompressionStream
= class(TCustomZlibStream
)
162 function GetCompressionRate
: Single;
164 constructor Create(CompressionLevel
: TCompressionLevel
; Dest
: TStream
);
165 destructor Destroy
; override;
166 function Read(var Buffer
; Count
: Longint): Longint; override;
167 function Write(const Buffer
; Count
: Longint): Longint; override;
168 function Seek(Offset
: Longint; Origin
: Word): Longint; override;
169 property CompressionRate
: Single read GetCompressionRate
;
173 { TDecompressionStream decompresses data on the fly as data is read from it.
175 Compressed data comes from a separate source stream. TDecompressionStream
176 is read-only and unidirectional; you can seek forward in the stream, but not
177 backwards. The special case of setting the stream position to zero is
178 allowed. Seeking forward decompresses data until the requested position in
179 the uncompressed data has been reached. Seeking backwards, seeking relative
180 to the end of the stream, requesting the size of the stream, and writing to
181 the stream will raise an exception.
183 The Position property returns the number of bytes of uncompressed data that
184 have been read from the stream so far.
186 The OnProgress event is called each time the internal input buffer of
187 compressed data is exhausted and the next block is read from the input stream.
188 This is useful for updating a progress indicator when you are reading a
189 large chunk of data from the decompression stream in a single call.}
191 TDecompressionStream
= class(TCustomZlibStream
)
193 constructor Create(Source
: TStream
);
194 destructor Destroy
; override;
195 function Read(var Buffer
; Count
: Longint): Longint; override;
196 function Write(const Buffer
; Count
: Longint): Longint; override;
197 function Seek(Offset
: Longint; Origin
: Word): Longint; override;
203 { CompressBuf compresses data, buffer to buffer, in one call.
204 In: InBuf = ptr to compressed data
205 InBytes = number of bytes in InBuf
206 Out: OutBuf = ptr to newly allocated buffer containing decompressed data
207 OutBytes = number of bytes in OutBuf }
208 procedure CompressBuf(const InBuf
: Pointer; InBytes
: Integer;
209 var OutBuf
: Pointer; var OutBytes
: Integer;
210 CompressLevel
: Integer = Z_DEFAULT_COMPRESSION
;
211 CompressStrategy
: Integer = Z_DEFAULT_STRATEGY
);
213 { DecompressBuf decompresses data, buffer to buffer, in one call.
214 In: InBuf = ptr to compressed data
215 InBytes = number of bytes in InBuf
216 OutEstimate = zero, or est. size of the decompressed data
217 Out: OutBuf = ptr to newly allocated buffer containing decompressed data
218 OutBytes = number of bytes in OutBuf }
219 procedure DecompressBuf(const InBuf
: Pointer; InBytes
: Integer;
220 OutEstimate
: Integer; var OutBuf
: Pointer; var OutBytes
: Integer);
224 EZlibError
= class(Exception
);
225 ECompressionError
= class(EZlibError
);
226 EDecompressionError
= class(EZlibError
);
231 ZErrorMessages
: array[0..9] of PAnsiChar
= (
232 'need dictionary', // Z_NEED_DICT (2)
233 'stream end', // Z_STREAM_END (1)
235 'file error', // Z_ERRNO (-1)
236 'stream error', // Z_STREAM_ERROR (-2)
237 'data error', // Z_DATA_ERROR (-3)
238 'insufficient memory', // Z_MEM_ERROR (-4)
239 'buffer error', // Z_BUF_ERROR (-5)
240 'incompatible version', // Z_VERSION_ERROR (-6)
243 function zlibAllocMem(AppData
: Pointer; Items
, Size
: Cardinal): Pointer;
245 GetMem(Result
, Items
*Size
);
248 procedure zlibFreeMem(AppData
, Block
: Pointer);
253 function CCheck(code
: Integer): Integer;
257 raise ECompressionError
.Create('zlib: ' + ZErrorMessages
[2 - code
]);
260 function DCheck(code
: Integer): Integer;
264 raise EDecompressionError
.Create('zlib: ' + ZErrorMessages
[2 - code
]);
267 procedure CompressBuf(const InBuf
: Pointer; InBytes
: Integer;
268 var OutBuf
: Pointer; var OutBytes
: Integer;
269 CompressLevel
, CompressStrategy
: Integer);
274 FillChar(strm
, sizeof(strm
), 0);
276 strm
.zalloc
:= @zlibAllocMem
;
277 strm
.zfree
:= @zlibFreeMem
;
279 OutBytes
:= ((InBytes
+ (InBytes
div 10) + 12) + 255) and not 255;
280 GetMem(OutBuf
, OutBytes
);
282 strm
.next_in
:= InBuf
;
283 strm
.avail_in
:= InBytes
;
284 strm
.next_out
:= OutBuf
;
285 strm
.avail_out
:= OutBytes
;
287 CCheck(deflateInit2(strm
, CompressLevel
, Z_DEFLATED
, MAX_WBITS
,
288 DEF_MEM_LEVEL
, CompressStrategy
));
291 while CCheck(deflate(strm
, Z_FINISH
)) <> Z_STREAM_END
do
295 ReallocMem(OutBuf
, OutBytes
);
296 strm
.next_out
:= Pointer(PtrUInt(OutBuf
) + (PtrUInt(strm
.next_out
) - PtrUInt(P
)));
297 strm
.avail_out
:= 256;
300 CCheck(deflateEnd(strm
));
302 ReallocMem(OutBuf
, strm
.total_out
);
303 OutBytes
:= strm
.total_out
;
305 zlibFreeMem(nil, OutBuf
);
310 procedure DecompressBuf(const InBuf
: Pointer; InBytes
: Integer;
311 OutEstimate
: Integer; var OutBuf
: Pointer; var OutBytes
: Integer);
317 FillChar(strm
, sizeof(strm
), 0);
319 strm
.zalloc
:= @zlibAllocMem
;
320 strm
.zfree
:= @zlibFreeMem
;
322 BufInc
:= (InBytes
+ 255) and not 255;
323 if OutEstimate
= 0 then
326 OutBytes
:= OutEstimate
;
327 GetMem(OutBuf
, OutBytes
);
329 strm
.next_in
:= InBuf
;
330 strm
.avail_in
:= InBytes
;
331 strm
.next_out
:= OutBuf
;
332 strm
.avail_out
:= OutBytes
;
333 DCheck(inflateInit_(strm
, zlib_version
, sizeof(strm
)));
335 while DCheck(inflate(strm
, Z_NO_FLUSH
)) <> Z_STREAM_END
do
338 Inc(OutBytes
, BufInc
);
339 ReallocMem(OutBuf
, OutBytes
);
340 strm
.next_out
:= Pointer(PtrUInt(OutBuf
) + (PtrUInt(strm
.next_out
) - PtrUInt(P
)));
341 strm
.avail_out
:= BufInc
;
344 DCheck(inflateEnd(strm
));
346 ReallocMem(OutBuf
, strm
.total_out
);
347 OutBytes
:= strm
.total_out
;
349 zlibFreeMem(nil, OutBuf
);
355 { TCustomZlibStream }
357 constructor TCustomZLibStream
.Create(Strm
: TStream
);
361 FStrmPos
:= Strm
.Position
;
363 FZRec
.zalloc
:= @zlibAllocMem
;
364 FZRec
.zfree
:= @zlibFreeMem
;
368 procedure TCustomZLibStream
.Progress(Sender
: TObject
);
370 if Assigned(FOnProgress
) then FOnProgress(Sender
);
373 { TCompressionStream }
375 constructor TCompressionStream
.Create(CompressionLevel
: TCompressionLevel
;
378 Levels
: array [TCompressionLevel
] of ShortInt
=
379 (Z_NO_COMPRESSION
, Z_BEST_SPEED
, Z_DEFAULT_COMPRESSION
, Z_BEST_COMPRESSION
);
381 inherited Create(Dest
);
382 FZRec
.next_out
:= @FBuffer
;
383 FZRec
.avail_out
:= sizeof(FBuffer
);
384 CCheck(deflateInit_(FZRec
, Levels
[CompressionLevel
], zlib_version
, sizeof(FZRec
)));
387 destructor TCompressionStream
.Destroy
;
389 FZRec
.next_in
:= nil;
392 if FStrm
.Position
<> FStrmPos
then FStrm
.Position
:= FStrmPos
;
393 while (CCheck(deflate(FZRec
, Z_FINISH
)) <> Z_STREAM_END
)
394 and (FZRec
.avail_out
= 0) do
396 FStrm
.WriteBuffer(FBuffer
, sizeof(FBuffer
));
397 FZRec
.next_out
:= @FBuffer
;
398 FZRec
.avail_out
:= sizeof(FBuffer
);
400 if FZRec
.avail_out
< sizeof(FBuffer
) then
401 FStrm
.WriteBuffer(FBuffer
, sizeof(FBuffer
) - FZRec
.avail_out
);
408 function TCompressionStream
.Read(var Buffer
; Count
: Longint): Longint;
410 raise ECompressionError
.Create('Invalid stream operation');
413 function TCompressionStream
.Write(const Buffer
; Count
: Longint): Longint;
415 FZRec
.next_in
:= @Buffer
;
416 FZRec
.avail_in
:= Count
;
417 if FStrm
.Position
<> FStrmPos
then FStrm
.Position
:= FStrmPos
;
418 while (FZRec
.avail_in
> 0) do
420 CCheck(deflate(FZRec
, 0));
421 if FZRec
.avail_out
= 0 then
423 FStrm
.WriteBuffer(FBuffer
, sizeof(FBuffer
));
424 FZRec
.next_out
:= @FBuffer
;
425 FZRec
.avail_out
:= sizeof(FBuffer
);
426 FStrmPos
:= FStrm
.Position
;
433 function TCompressionStream
.Seek(Offset
: Longint; Origin
: Word): Longint;
435 if (Offset
= 0) and (Origin
= soFromCurrent
) then
436 Result
:= FZRec
.total_in
438 raise ECompressionError
.Create('Invalid stream operation');
441 function TCompressionStream
.GetCompressionRate
: Single;
443 if FZRec
.total_in
= 0 then
446 Result
:= (1.0 - (FZRec
.total_out
/ FZRec
.total_in
)) * 100.0;
449 { TDecompressionStream }
451 constructor TDecompressionStream
.Create(Source
: TStream
);
453 inherited Create(Source
);
454 FZRec
.next_in
:= @FBuffer
;
456 DCheck(inflateInit_(FZRec
, zlib_version
, sizeof(FZRec
)));
459 destructor TDecompressionStream
.Destroy
;
465 function TDecompressionStream
.Read(var Buffer
; Count
: Longint): Longint;
467 FZRec
.next_out
:= @Buffer
;
468 FZRec
.avail_out
:= Count
;
469 if FStrm
.Position
<> FStrmPos
then FStrm
.Position
:= FStrmPos
;
470 while (FZRec
.avail_out
> 0) do
472 if FZRec
.avail_in
= 0 then
474 FZRec
.avail_in
:= FStrm
.Read(FBuffer
, sizeof(FBuffer
));
475 if FZRec
.avail_in
= 0 then
477 Result
:= Count
- Integer(FZRec
.avail_out
);
480 FZRec
.next_in
:= @FBuffer
;
481 FStrmPos
:= FStrm
.Position
;
484 CCheck(inflate(FZRec
, 0));
489 function TDecompressionStream
.Write(const Buffer
; Count
: Longint): Longint;
491 raise EDecompressionError
.Create('Invalid stream operation');
494 function TDecompressionStream
.Seek(Offset
: Longint; Origin
: Word): Longint;
497 Buf
: array [0..4095] of Byte;
499 if (Offset
= 0) and (Origin
= soFromBeginning
) then
501 DCheck(inflateReset(FZRec
));
502 FZRec
.next_in
:= @FBuffer
;
507 else if ( (Offset
>= 0) and (Origin
= soFromCurrent
)) or
508 ( ((Offset
- Integer(FZRec
.total_out
)) > 0) and (Origin
= soFromBeginning
)) then
510 if Origin
= soFromBeginning
then Dec(Offset
, FZRec
.total_out
);
513 for I
:= 1 to Offset
div sizeof(Buf
) do
514 ReadBuffer(Buf
, sizeof(Buf
));
515 ReadBuffer(Buf
, Offset
mod sizeof(Buf
));
519 raise EDecompressionError
.Create('Invalid stream operation');
520 Result
:= FZRec
.total_out
;