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;
added
removed
PNG/zlib/contrib/delphi2/zlib.pas
