Delphi控件源码

开发平台：

Delphi

bszlib.pas：源码内容

{*******************************************************************}
{ }
{ Almediadev Visual Component Library }
{ BusinessSkinForm }
{ }
{ }
{ Home: http://www.almdev.com }
{ Support: support@almdev.com }
{ }
{*******************************************************************}
{ Original:
zlib.h -- interface of the 'zlib' general purpose compression library
version 1.1.2, Mar, 1998
This software is provided 'as-is', without any express or implied
warranty. In no event will the authors be held liable for any damages
arising from the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software
in a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
Jean-loup Gailly Mark Adler
jloup@gzip.org madler@alumni.caltech.edu
The data format used by the zlib library is described by RFCs (Request for
Comments) 1950 to 1952 in the files ftp://ds.internic.net/rfc/rfc1950.txt
(zlib format), rfc1951.txt (deflate format) and rfc1952.txt (gzip format).
Pascal tranlastion
}
unit bszlib;
{$WARNINGS OFF}
{$HINTS OFF}
{$T-}
{$define patch112} { apply patch from the zlib home page }
{$define ORG_DEBUG}
{$DEFINE MAX_MATCH_IS_258}
interface
type
{Byte = usigned char; 8 bits}
Bytef = byte;
charf = byte;
int = integer;
intf = int;
uInt = cardinal; { 16 bits or more }
uIntf = uInt;
Long = longint;
uLong = LongInt; { 32 bits or more }
uLongf = uLong;
voidp = pointer;
voidpf = voidp;
pBytef = ^Bytef;
pIntf = ^intf;
puIntf = ^uIntf;
puLong = ^uLongf;
ptr2int = uInt;
{ a pointer to integer casting is used to do pointer arithmetic.
ptr2int must be an integer type and sizeof(ptr2int) must be less
than sizeof(pointer) - Nomssi }
type
zByteArray = array[0..(MaxInt div SizeOf(Bytef))-1] of Bytef;
pzByteArray = ^zByteArray;
type
zIntfArray = array[0..(MaxInt div SizeOf(Intf))-1] of Intf;
pzIntfArray = ^zIntfArray;
type
zuIntArray = array[0..(MaxInt div SizeOf(uInt))-1] of uInt;
PuIntArray = ^zuIntArray;
{ Type declarations - only for deflate }
type
uch = Byte;
uchf = uch; { FAR }
ush = Word;
ushf = ush;
ulg = LongInt;
unsigned = uInt;
pcharf = ^charf;
puchf = ^uchf;
pushf = ^ushf;
type
zuchfArray = zByteArray;
puchfArray = ^zuchfArray;
type
zushfArray = array[0..(MaxInt div SizeOf(ushf))-1] of ushf;
pushfArray = ^zushfArray;
procedure zmemcpy(destp : pBytef; sourcep : pBytef; len : uInt);
function zmemcmp(s1p, s2p : pBytef; len : uInt) : int;
procedure zmemzero(destp : pBytef; len : uInt);
procedure zcfree(opaque : voidpf; ptr : voidpf);
function zcalloc (opaque : voidpf; items : uInt; size : uInt) : voidpf;
{ zlib.h }
{ Maximum value for memLevel in deflateInit2 }
const
MAX_MEM_LEVEL = 9;
DEF_MEM_LEVEL = 8; { if MAX_MEM_LEVEL > 8 }
{ Maximum value for windowBits in deflateInit2 and inflateInit2 }
const
MAX_WBITS = 15; { 32K LZ77 window }
{ default windowBits for decompression. MAX_WBITS is for compression only }
const
DEF_WBITS = MAX_WBITS;
{ The memory requirements for deflate are (in bytes):
1 shl (windowBits+2) + 1 shl (memLevel+9)
that is: 128K for windowBits=15 + 128K for memLevel = 8 (default values)
plus a few kilobytes for small objects. For example, if you want to reduce
the default memory requirements from 256K to 128K, compile with
DMAX_WBITS=14 DMAX_MEM_LEVEL=7
Of course this will generally degrade compression (there's no free lunch).
The memory requirements for inflate are (in bytes) 1 shl windowBits
that is, 32K for windowBits=15 (default value) plus a few kilobytes
for small objects. }
{ Huffman code lookup table entry--this entry is four bytes for machines
that have 16-bit pointers (e.g. PC's in the small or medium model). }
type
pInflate_huft = ^inflate_huft;
inflate_huft = Record
Exop, { number of extra bits or operation }
bits : Byte; { number of bits in this code or subcode }
{pad : uInt;} { pad structure to a power of 2 (4 bytes for }
{ 16-bit, 8 bytes for 32-bit int's) }
base : uInt; { literal, length base, or distance base }
{ or table offset }
End;
type
huft_field = Array[0..(MaxInt div SizeOf(inflate_huft))-1] of inflate_huft;
huft_ptr = ^huft_field;
type
ppInflate_huft = ^pInflate_huft;
type
inflate_codes_mode = ( { waiting for "i:"=input, "o:"=output, "x:"=nothing }
START, { x: set up for LEN }
LEN, { i: get length/literal/eob next }
LENEXT, { i: getting length extra (have base) }
DIST, { i: get distance next }
DISTEXT, { i: getting distance extra }
COPY, { o: copying bytes in window, waiting for space }
LIT, { o: got literal, waiting for output space }
WASH, { o: got eob, possibly still output waiting }
ZEND, { x: got eob and all data flushed }
BADCODE); { x: got error }
{ inflate codes private state }
type
pInflate_codes_state = ^inflate_codes_state;
inflate_codes_state = record
mode : inflate_codes_mode; { current inflate_codes mode }
{ mode dependent information }
len : uInt;
sub : record { submode }
Case Byte of
0:(code : record { if LEN or DIST, where in tree }
tree : pInflate_huft; { pointer into tree }
need : uInt; { bits needed }
end);
1:(lit : uInt); { if LIT, literal }
2:(copy: record { if EXT or COPY, where and how much }
get : uInt; { bits to get for extra }
dist : uInt; { distance back to copy from }
end);
end;
{ mode independent information }
lbits : Byte; { ltree bits decoded per branch }
dbits : Byte; { dtree bits decoder per branch }
ltree : pInflate_huft; { literal/length/eob tree }
dtree : pInflate_huft; { distance tree }
end;
type
check_func = function(check : uLong;
buf : pBytef;
{const buf : array of byte;}
len : uInt) : uLong;
type
inflate_block_mode =
(ZTYPE, { get type bits (3, including end bit) }
LENS, { get lengths for stored }
STORED, { processing stored block }
TABLE, { get table lengths }
BTREE, { get bit lengths tree for a dynamic block }
DTREE, { get length, distance trees for a dynamic block }
CODES, { processing fixed or dynamic block }
DRY, { output remaining window bytes }
BLKDONE, { finished last block, done }
BLKBAD); { got a data error--stuck here }
type
pInflate_blocks_state = ^inflate_blocks_state;
{ inflate blocks semi-private state }
inflate_blocks_state = record
mode : inflate_block_mode; { current inflate_block mode }
{ mode dependent information }
sub : record { submode }
case Byte of
0:(left : uInt); { if STORED, bytes left to copy }
1:(trees : record { if DTREE, decoding info for trees }
table : uInt; { table lengths (14 bits) }
index : uInt; { index into blens (or border) }
blens : PuIntArray; { bit lengths of codes }
bb : uInt; { bit length tree depth }
tb : pInflate_huft; { bit length decoding tree }
end);
2:(decode : record { if CODES, current state }
tl : pInflate_huft;
td : pInflate_huft; { trees to free }
codes : pInflate_codes_state;
end);
end;
last : boolean; { true if this block is the last block }
{ mode independent information }
bitk : uInt; { bits in bit buffer }
bitb : uLong; { bit buffer }
hufts : huft_ptr; {pInflate_huft;} { single malloc for tree space }
window : pBytef; { sliding window }
zend : pBytef; { one byte after sliding window }
read : pBytef; { window read pointer }
write : pBytef; { window write pointer }
checkfn : check_func; { check function }
check : uLong; { check on output }
end;
type
inflate_mode = (
METHOD, { waiting for method byte }
FLAG, { waiting for flag byte }
DICT4, { four dictionary check bytes to go }
DICT3, { three dictionary check bytes to go }
DICT2, { two dictionary check bytes to go }
DICT1, { one dictionary check byte to go }
DICT0, { waiting for inflateSetDictionary }
BLOCKS, { decompressing blocks }
CHECK4, { four check bytes to go }
CHECK3, { three check bytes to go }
CHECK2, { two check bytes to go }
CHECK1, { one check byte to go }
DONE, { finished check, done }
BAD); { got an error--stay here }
{ inflate private state }
type
pInternal_state = ^internal_state; { or point to a deflate_state record }
internal_state = record
mode : inflate_mode; { current inflate mode }
{ mode dependent information }
sub : record { submode }
case byte of
0:(method : uInt); { if FLAGS, method byte }
1:(check : record { if CHECK, check values to compare }
was : uLong; { computed check value }
need : uLong; { stream check value }
end);
2:(marker : uInt); { if BAD, inflateSync's marker bytes count }
end;
{ mode independent information }
nowrap : boolean; { flag for no wrapper }
wbits : uInt; { log2(window size) (8..15, defaults to 15) }
blocks : pInflate_blocks_state; { current inflate_blocks state }
end;
type
alloc_func = function(opaque : voidpf; items : uInt; size : uInt) : voidpf;
free_func = procedure(opaque : voidpf; address : voidpf);
type
z_streamp = ^z_stream;
z_stream = record
next_in : pBytef; { next input byte }
avail_in : uInt; { number of bytes available at next_in }
total_in : uLong; { total nb of input bytes read so far }
next_out : pBytef; { next output byte should be put there }
avail_out : uInt; { remaining free space at next_out }
total_out : uLong; { total nb of bytes output so far }
msg : string; { last error message, '' if no error }
state : pInternal_state; { not visible by applications }
zalloc : alloc_func; { used to allocate the internal state }
zfree : free_func; { used to free the internal state }
opaque : voidpf; { private data object passed to zalloc and zfree }
data_type : int; { best guess about the data type: ascii or binary }
adler : uLong; { adler32 value of the uncompressed data }
reserved : uLong; { reserved for future use }
end;
{ The application must update next_in and avail_in when avail_in has
dropped to zero. It must update next_out and avail_out when avail_out
has dropped to zero. The application must initialize zalloc, zfree and
opaque before calling the init function. All other fields are set by the
compression library and must not be updated by the application.
The opaque value provided by the application will be passed as the first
parameter for calls of zalloc and zfree. This can be useful for custom
memory management. The compression library attaches no meaning to the
opaque value.
zalloc must return Z_NULL if there is not enough memory for the object.
On 16-bit systems, the functions zalloc and zfree must be able to allocate
exactly 65536 bytes, but will not be required to allocate more than this
if the symbol MAXSEG_64K is defined (see zconf.h). WARNING: On MSDOS,
pointers returned by zalloc for objects of exactly 65536 bytes *must*
have their offset normalized to zero. The default allocation function
provided by this library ensures this (see zutil.c). To reduce memory
requirements and avoid any allocation of 64K objects, at the expense of
compression ratio, compile the library with -DMAX_WBITS=14 (see zconf.h).
The fields total_in and total_out can be used for statistics or
progress reports. After compression, total_in holds the total size of
the uncompressed data and may be saved for use in the decompressor
(particularly if the decompressor wants to decompress everything in
a single step). }
const { constants }
Z_NO_FLUSH = 0;
Z_PARTIAL_FLUSH = 1;
Z_SYNC_FLUSH = 2;
Z_FULL_FLUSH = 3;
Z_FINISH = 4;
{ Allowed flush values; see deflate() below for details }
Z_OK = 0;
Z_STREAM_END = 1;
Z_NEED_DICT = 2;
Z_ERRNO = (-1);
Z_STREAM_ERROR = (-2);
Z_DATA_ERROR = (-3);
Z_MEM_ERROR = (-4);
Z_BUF_ERROR = (-5);
Z_VERSION_ERROR = (-6);
{ Return codes for the compression/decompression functions. Negative
values are errors, positive values are used for special but normal events.}
Z_NO_COMPRESSION = 0;
Z_BEST_SPEED = 1;
Z_BEST_COMPRESSION = 9;
Z_DEFAULT_COMPRESSION = (-1);
{ compression levels }
Z_FILTERED = 1;
Z_HUFFMAN_ONLY = 2;
Z_DEFAULT_STRATEGY = 0;
{ compression strategy; see deflateInit2() below for details }
Z_BINARY = 0;
Z_ASCII = 1;
Z_UNKNOWN = 2;
{ Possible values of the data_type field }
Z_DEFLATED = 8;
{ The deflate compression method (the only one supported in this version) }
Z_NULL = NIL; { for initializing zalloc, zfree, opaque }
{$IFDEF GZIO}
var
errno : int;
{$ENDIF}
{ common constants }
{ The three kinds of block type }
const
STORED_BLOCK = 0;
STATIC_TREES = 1;
DYN_TREES = 2;
{ The minimum and maximum match lengths }
const
MIN_MATCH = 3;
{$ifdef MAX_MATCH_IS_258}
MAX_MATCH = 258;
{$else}
MAX_MATCH = ??; { deliberate syntax error }
{$endif}
MIN_LOOKAHEAD = (MAX_MATCH+MIN_MATCH+1);
const
PRESET_DICT = $20; { preset dictionary flag in zlib header }
{$IFDEF DEBUG}
procedure Assert(cond : boolean; msg : string);
{$ENDIF}
procedure Trace(x : string);
procedure Tracev(x : string);
procedure Tracevv(x : string);
procedure Tracevvv(x : string);
procedure Tracec(c : boolean; x : string);
procedure Tracecv(c : boolean; x : string);
function zlibVersion : string;
{ The application can compare zlibVersion and ZLIB_VERSION for consistency.
If the first character differs, the library code actually used is
not compatible with the zlib.h header file used by the application.
This check is automatically made by deflateInit and inflateInit. }
function zError(err : int) : string;
function ZALLOC (var strm : z_stream; items : uInt; size : uInt) : voidpf;
procedure ZFREE (var strm : z_stream; ptr : voidpf);
procedure TRY_FREE (var strm : z_stream; ptr : voidpf);
const
ZLIB_VERSION : string[10] = '1.1.2';
const
z_errbase = Z_NEED_DICT;
z_errmsg : Array[0..9] of string[21] = { indexed by 2-zlib_error }
('need dictionary', { Z_NEED_DICT 2 }
'stream end', { Z_STREAM_END 1 }
'', { Z_OK 0 }
'file error', { Z_ERRNO (-1) }
'stream error', { Z_STREAM_ERROR (-2) }
'data error', { Z_DATA_ERROR (-3) }
'insufficient memory', { Z_MEM_ERROR (-4) }
'buffer error', { Z_BUF_ERROR (-5) }
'incompatible version',{ Z_VERSION_ERROR (-6) }
'');
const
z_verbose : int = 1;
{$IFDEF DEBUG}
procedure z_error (m : string);
{$ENDIF}
function adler32(adler : uLong; buf : pBytef; len : uInt) : uLong;
{ Update a running Adler-32 checksum with the bytes buf[0..len-1] and
return the updated checksum. If buf is NIL, this function returns
the required initial value for the checksum.
An Adler-32 checksum is almost as reliable as a CRC32 but can be computed
much faster. Usage example:
var
adler : uLong;
begin
adler := adler32(0, Z_NULL, 0);
while (read_buffer(buffer, length) <> EOF) do
adler := adler32(adler, buffer, length);
if (adler <> original_adler) then
error();
end;
}
{ Orginal: deflate.h -- internal compression state
deflate.c -- compress data using the deflation algorithm
Pascal tranlastion
For conditions of distribution and use, see copyright notice in readme.txt
}
{ ALGORITHM
The "deflation" process depends on being able to identify portions
of the input text which are identical to earlier input (within a
sliding window trailing behind the input currently being processed).
The most straightforward technique turns out to be the fastest for
most input files: try all possible matches and select the longest.
The key feature of this algorithm is that insertions into the string
dictionary are very simple and thus fast, and deletions are avoided
completely. Insertions are performed at each input character, whereas
string matches are performed only when the previous match ends. So it
is preferable to spend more time in matches to allow very fast string
insertions and avoid deletions. The matching algorithm for small
strings is inspired from that of Rabin & Karp. A brute force approach
is used to find longer strings when a small match has been found.
A similar algorithm is used in comic (by Jan-Mark Wams) and freeze
(by Leonid Broukhis).
A previous version of this file used a more sophisticated algorithm
(by Fiala and Greene) which is guaranteed to run in linear amortized
time, but has a larger average cost, uses more memory and is patented.
However the F&G algorithm may be faster for some highly redundant
files if the parameter max_chain_length (described below) is too large.
ACKNOWLEDGEMENTS
The idea of lazy evaluation of matches is due to Jan-Mark Wams, and
I found it in 'freeze' written by Leonid Broukhis.
Thanks to many people for bug reports and testing.
REFERENCES
Deutsch, L.P.,"'Deflate' Compressed Data Format Specification".
Available in ftp.uu.net:/pub/archiving/zip/doc/deflate-1.1.doc
A description of the Rabin and Karp algorithm is given in the book
"Algorithms" by R. Sedgewick, Addison-Wesley, p252.
Fiala,E.R., and Greene,D.H.
Data Compression with Finite Windows, Comm.ACM, 32,4 (1989) 490-595}
function deflateInit_(strm : z_streamp;
level : int;
const version : string;
stream_size : int) : int;
function deflateInit (var strm : z_stream; level : int) : int;
{ Initializes the internal stream state for compression. The fields
zalloc, zfree and opaque must be initialized before by the caller.
If zalloc and zfree are set to Z_NULL, deflateInit updates them to
use default allocation functions.
The compression level must be Z_DEFAULT_COMPRESSION, or between 0 and 9:
1 gives best speed, 9 gives best compression, 0 gives no compression at
all (the input data is simply copied a block at a time).
Z_DEFAULT_COMPRESSION requests a default compromise between speed and
compression (currently equivalent to level 6).
deflateInit returns Z_OK if success, Z_MEM_ERROR if there was not
enough memory, Z_STREAM_ERROR if level is not a valid compression level,
Z_VERSION_ERROR if the zlib library version (zlib_version) is incompatible
with the version assumed by the caller (ZLIB_VERSION).
msg is set to null if there is no error message. deflateInit does not
perform any compression: this will be done by deflate(). }
{EXPORT}
function deflate (var strm : z_stream; flush : int) : int;
{ Performs one or both of the following actions:
- Compress more input starting at next_in and update next_in and avail_in
accordingly. If not all input can be processed (because there is not
enough room in the output buffer), next_in and avail_in are updated and
processing will resume at this point for the next call of deflate().
- Provide more output starting at next_out and update next_out and avail_out
accordingly. This action is forced if the parameter flush is non zero.
Forcing flush frequently degrades the compression ratio, so this parameter
should be set only when necessary (in interactive applications).
Some output may be provided even if flush is not set.
Before the call of deflate(), the application should ensure that at least
one of the actions is possible, by providing more input and/or consuming
more output, and updating avail_in or avail_out accordingly; avail_out
should never be zero before the call. The application can consume the
compressed output when it wants, for example when the output buffer is full
(avail_out == 0), or after each call of deflate(). If deflate returns Z_OK
and with zero avail_out, it must be called again after making room in the
output buffer because there might be more output pending.
If the parameter flush is set to Z_PARTIAL_FLUSH, the current compression
block is terminated and flushed to the output buffer so that the
decompressor can get all input data available so far. For method 9, a future
variant on method 8, the current block will be flushed but not terminated.
Z_SYNC_FLUSH has the same effect as partial flush except that the compressed
output is byte aligned (the compressor can clear its internal bit buffer)
and the current block is always terminated; this can be useful if the
compressor has to be restarted from scratch after an interruption (in which
case the internal state of the compressor may be lost).
If flush is set to Z_FULL_FLUSH, the compression block is terminated, a
special marker is output and the compression dictionary is discarded; this
is useful to allow the decompressor to synchronize if one compressed block
has been damaged (see inflateSync below). Flushing degrades compression and
so should be used only when necessary. Using Z_FULL_FLUSH too often can
seriously degrade the compression. If deflate returns with avail_out == 0,
this function must be called again with the same value of the flush
parameter and more output space (updated avail_out), until the flush is
complete (deflate returns with non-zero avail_out).
If the parameter flush is set to Z_FINISH, all pending input is processed,
all pending output is flushed and deflate returns with Z_STREAM_END if there
was enough output space; if deflate returns with Z_OK, this function must be
called again with Z_FINISH and more output space (updated avail_out) but no
more input data, until it returns with Z_STREAM_END or an error. After
deflate has returned Z_STREAM_END, the only possible operations on the
stream are deflateReset or deflateEnd.
Z_FINISH can be used immediately after deflateInit if all the compression
is to be done in a single step. In this case, avail_out must be at least
0.1% larger than avail_in plus 12 bytes. If deflate does not return
Z_STREAM_END, then it must be called again as described above.
deflate() may update data_type if it can make a good guess about
the input data type (Z_ASCII or Z_BINARY). In doubt, the data is considered
binary. This field is only for information purposes and does not affect
the compression algorithm in any manner.
deflate() returns Z_OK if some progress has been made (more input
processed or more output produced), Z_STREAM_END if all input has been
consumed and all output has been produced (only when flush is set to
Z_FINISH), Z_STREAM_ERROR if the stream state was inconsistent (for example
if next_in or next_out was NULL), Z_BUF_ERROR if no progress is possible. }
function deflateEnd (var strm : z_stream) : int;
{ All dynamically allocated data structures for this stream are freed.
This function discards any unprocessed input and does not flush any
pending output.
deflateEnd returns Z_OK if success, Z_STREAM_ERROR if the
stream state was inconsistent, Z_DATA_ERROR if the stream was freed
prematurely (some input or output was discarded). In the error case,
msg may be set but then points to a static string (which must not be
deallocated). }
{ Advanced functions }
{ The following functions are needed only in some special applications. }
{EXPORT}
function deflateInit2 (var strm : z_stream;
level : int;
method : int;
windowBits : int;
memLevel : int;
strategy : int) : int;
{ This is another version of deflateInit with more compression options. The
fields next_in, zalloc, zfree and opaque must be initialized before by
the caller.
The method parameter is the compression method. It must be Z_DEFLATED in
this version of the library. (Method 9 will allow a 64K history buffer and
partial block flushes.)
The windowBits parameter is the base two logarithm of the window size
(the size of the history buffer). It should be in the range 8..15 for this
version of the library (the value 16 will be allowed for method 9). Larger
values of this parameter result in better compression at the expense of
memory usage. The default value is 15 if deflateInit is used instead.
The memLevel parameter specifies how much memory should be allocated
for the internal compression state. memLevel=1 uses minimum memory but
is slow and reduces compression ratio; memLevel=9 uses maximum memory
for optimal speed. The default value is 8. See zconf.h for total memory
usage as a function of windowBits and memLevel.
The strategy parameter is used to tune the compression algorithm. Use the
value Z_DEFAULT_STRATEGY for normal data, Z_FILTERED for data produced by a
filter (or predictor), or Z_HUFFMAN_ONLY to force Huffman encoding only (no
string match). Filtered data consists mostly of small values with a
somewhat random distribution. In this case, the compression algorithm is
tuned to compress them better. The effect of Z_FILTERED is to force more
Huffman coding and less string matching; it is somewhat intermediate
between Z_DEFAULT and Z_HUFFMAN_ONLY. The strategy parameter only affects
the compression ratio but not the correctness of the compressed output even
if it is not set appropriately.
If next_in is not null, the library will use this buffer to hold also
some history information; the buffer must either hold the entire input
data, or have at least 1<<(windowBits+1) bytes and be writable. If next_in
is null, the library will allocate its own history buffer (and leave next_in
null). next_out need not be provided here but must be provided by the
application for the next call of deflate().
If the history buffer is provided by the application, next_in must
must never be changed by the application since the compressor maintains
information inside this buffer from call to call; the application
must provide more input only by increasing avail_in. next_in is always
reset by the library in this case.
deflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was
not enough memory, Z_STREAM_ERROR if a parameter is invalid (such as
an invalid method). msg is set to null if there is no error message.
deflateInit2 does not perform any compression: this will be done by
deflate(). }
{EXPORT}
function deflateSetDictionary (var strm : z_stream;
dictionary : pBytef; {const bytes}
dictLength : uint) : int;
{ Initializes the compression dictionary (history buffer) from the given
byte sequence without producing any compressed output. This function must
be called immediately after deflateInit or deflateInit2, before any call
of deflate. The compressor and decompressor must use exactly the same
dictionary (see inflateSetDictionary).
The dictionary should consist of strings (byte sequences) that are likely
to be encountered later in the data to be compressed, with the most commonly
used strings preferably put towards the end of the dictionary. Using a
dictionary is most useful when the data to be compressed is short and
can be predicted with good accuracy; the data can then be compressed better
than with the default empty dictionary. In this version of the library,
only the last 32K bytes of the dictionary are used.
Upon return of this function, strm->adler is set to the Adler32 value
of the dictionary; the decompressor may later use this value to determine
which dictionary has been used by the compressor. (The Adler32 value
applies to the whole dictionary even if only a subset of the dictionary is
actually used by the compressor.)
deflateSetDictionary returns Z_OK if success, or Z_STREAM_ERROR if a
parameter is invalid (such as NULL dictionary) or the stream state
is inconsistent (for example if deflate has already been called for this
stream). deflateSetDictionary does not perform any compression: this will
be done by deflate(). }
{EXPORT}
function deflateCopy (dest : z_streamp;
source : z_streamp) : int;
{ Sets the destination stream as a complete copy of the source stream. If
the source stream is using an application-supplied history buffer, a new
buffer is allocated for the destination stream. The compressed output
buffer is always application-supplied. It's the responsibility of the
application to provide the correct values of next_out and avail_out for the
next call of deflate.
This function can be useful when several compression strategies will be
tried, for example when there are several ways of pre-processing the input
data with a filter. The streams that will be discarded should then be freed
by calling deflateEnd. Note that deflateCopy duplicates the internal
compression state which can be quite large, so this strategy is slow and
can consume lots of memory.
deflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not
enough memory, Z_STREAM_ERROR if the source stream state was inconsistent
(such as zalloc being NULL). msg is left unchanged in both source and
destination. }
{EXPORT}
function deflateReset (var strm : z_stream) : int;
{ This function is equivalent to deflateEnd followed by deflateInit,
but does not free and reallocate all the internal compression state.
The stream will keep the same compression level and any other attributes
that may have been set by deflateInit2.
deflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source
stream state was inconsistent (such as zalloc or state being NIL). }
{EXPORT}
function deflateParams (var strm : z_stream; level : int; strategy : int) : int;
{ Dynamically update the compression level and compression strategy.
This can be used to switch between compression and straight copy of
the input data, or to switch to a different kind of input data requiring
a different strategy. If the compression level is changed, the input
available so far is compressed with the old level (and may be flushed);
the new level will take effect only at the next call of deflate().
Before the call of deflateParams, the stream state must be set as for
a call of deflate(), since the currently available input may have to
be compressed and flushed. In particular, strm->avail_out must be non-zero.
deflateParams returns Z_OK if success, Z_STREAM_ERROR if the source
stream state was inconsistent or if a parameter was invalid, Z_BUF_ERROR
if strm->avail_out was zero. }
const
deflate_copyright : string = ' deflate 1.1.2 Copyright 1995-1998 Jean-loup Gailly ';
{ If you use the zlib library in a product, an acknowledgment is welcome
in the documentation of your product. If for some reason you cannot
include such an acknowledgment, I would appreciate that you keep this
copyright string in the executable of your product. }
function inflate_blocks_new(var z : z_stream;
c : check_func; { check function }
w : uInt { window size }
) : pInflate_blocks_state;
function inflate_blocks (var s : inflate_blocks_state;
var z : z_stream;
r : int { initial return code }
) : int;
procedure inflate_blocks_reset (var s : inflate_blocks_state;
var z : z_stream;
c : puLong); { check value on output }
function inflate_blocks_free(s : pInflate_blocks_state;
var z : z_stream) : int;
procedure inflate_set_dictionary(var s : inflate_blocks_state;
const d : array of byte; { dictionary }
n : uInt); { dictionary length }
function inflate_blocks_sync_point(var s : inflate_blocks_state) : int;
function inflate_codes_new (bl : uInt;
bd : uInt;
tl : pInflate_huft;
td : pInflate_huft;
var z : z_stream): pInflate_codes_state;
function inflate_codes(var s : inflate_blocks_state;
var z : z_stream;
r : int) : int;
procedure inflate_codes_free(c : pInflate_codes_state;
var z : z_stream);
function inflate_fast( bl : uInt;
bd : uInt;
tl : pInflate_huft;
td : pInflate_huft;
var s : inflate_blocks_state;
var z : z_stream) : int;
function inflateInit(var z : z_stream) : int;
{ Initializes the internal stream state for decompression. The fields
zalloc, zfree and opaque must be initialized before by the caller. If
zalloc and zfree are set to Z_NULL, inflateInit updates them to use default
allocation functions.
inflateInit returns Z_OK if success, Z_MEM_ERROR if there was not
enough memory, Z_VERSION_ERROR if the zlib library version is incompatible
with the version assumed by the caller. msg is set to null if there is no
error message. inflateInit does not perform any decompression: this will be
done by inflate(). }
function inflateInit_(z : z_streamp;
const version : string;
stream_size : int) : int;
function inflateInit2_(var z: z_stream;
w : int;
const version : string;
stream_size : int) : int;
{
This is another version of inflateInit with an extra parameter. The
fields next_in, avail_in, zalloc, zfree and opaque must be initialized
before by the caller.
The windowBits parameter is the base two logarithm of the maximum window
size (the size of the history buffer). It should be in the range 8..15 for
this version of the library. The default value is 15 if inflateInit is used
instead. If a compressed stream with a larger window size is given as
input, inflate() will return with the error code Z_DATA_ERROR instead of
trying to allocate a larger window.
inflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough
memory, Z_STREAM_ERROR if a parameter is invalid (such as a negative
memLevel). msg is set to null if there is no error message. inflateInit2
does not perform any decompression apart from reading the zlib header if
present: this will be done by inflate(). (So next_in and avail_in may be
modified, but next_out and avail_out are unchanged.)
}
function inflateEnd(var z : z_stream) : int;
{
All dynamically allocated data structures for this stream are freed.
This function discards any unprocessed input and does not flush any
pending output.
inflateEnd returns Z_OK if success, Z_STREAM_ERROR if the stream state
was inconsistent. In the error case, msg may be set but then points to a
static string (which must not be deallocated).
}
function inflateReset(var z : z_stream) : int;
{
This function is equivalent to inflateEnd followed by inflateInit,
but does not free and reallocate all the internal decompression state.
The stream will keep attributes that may have been set by inflateInit2.
inflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source
stream state was inconsistent (such as zalloc or state being NULL).
}
function inflate(var z : z_stream;
f : int) : int;
{
inflate decompresses as much data as possible, and stops when the input
buffer becomes empty or the output buffer becomes full. It may introduce
some output latency (reading input without producing any output)
except when forced to flush.
The detailed semantics are as follows. inflate performs one or both of the
following actions:
- Decompress more input starting at next_in and update next_in and avail_in
accordingly. If not all input can be processed (because there is not
enough room in the output buffer), next_in is updated and processing
will resume at this point for the next call of inflate().
- Provide more output starting at next_out and update next_out and avail_out
accordingly. inflate() provides as much output as possible, until there
is no more input data or no more space in the output buffer (see below
about the flush parameter).
Before the call of inflate(), the application should ensure that at least
one of the actions is possible, by providing more input and/or consuming
more output, and updating the next_* and avail_* values accordingly.
The application can consume the uncompressed output when it wants, for
example when the output buffer is full (avail_out == 0), or after each
call of inflate(). If inflate returns Z_OK and with zero avail_out, it
must be called again after making room in the output buffer because there
might be more output pending.
If the parameter flush is set to Z_SYNC_FLUSH, inflate flushes as much
output as possible to the output buffer. The flushing behavior of inflate is
not specified for values of the flush parameter other than Z_SYNC_FLUSH
and Z_FINISH, but the current implementation actually flushes as much output
as possible anyway.
inflate() should normally be called until it returns Z_STREAM_END or an
error. However if all decompression is to be performed in a single step
(a single call of inflate), the parameter flush should be set to
Z_FINISH. In this case all pending input is processed and all pending
output is flushed; avail_out must be large enough to hold all the
uncompressed data. (The size of the uncompressed data may have been saved
by the compressor for this purpose.) The next operation on this stream must
be inflateEnd to deallocate the decompression state. The use of Z_FINISH
is never required, but can be used to inform inflate that a faster routine
may be used for the single inflate() call.
If a preset dictionary is needed at this point (see inflateSetDictionary
below), inflate sets strm-adler to the adler32 checksum of the
dictionary chosen by the compressor and returns Z_NEED_DICT; otherwise
it sets strm->adler to the adler32 checksum of all output produced
so far (that is, total_out bytes) and returns Z_OK, Z_STREAM_END or
an error code as described below. At the end of the stream, inflate()
checks that its computed adler32 checksum is equal to that saved by the
compressor and returns Z_STREAM_END only if the checksum is correct.
inflate() returns Z_OK if some progress has been made (more input processed
or more output produced), Z_STREAM_END if the end of the compressed data has
been reached and all uncompressed output has been produced, Z_NEED_DICT if a
preset dictionary is needed at this point, Z_DATA_ERROR if the input data was
corrupted (input stream not conforming to the zlib format or incorrect
adler32 checksum), Z_STREAM_ERROR if the stream structure was inconsistent
(for example if next_in or next_out was NULL), Z_MEM_ERROR if there was not
enough memory, Z_BUF_ERROR if no progress is possible or if there was not
enough room in the output buffer when Z_FINISH is used. In the Z_DATA_ERROR
case, the application may then call inflateSync to look for a good
compression block.
}
function inflateSetDictionary(var z : z_stream;
dictionary : pBytef; {const array of byte}
dictLength : uInt) : int;
{
Initializes the decompression dictionary from the given uncompressed byte
sequence. This function must be called immediately after a call of inflate
if this call returned Z_NEED_DICT. The dictionary chosen by the compressor
can be determined from the Adler32 value returned by this call of
inflate. The compressor and decompressor must use exactly the same
dictionary (see deflateSetDictionary).
inflateSetDictionary returns Z_OK if success, Z_STREAM_ERROR if a
parameter is invalid (such as NULL dictionary) or the stream state is
inconsistent, Z_DATA_ERROR if the given dictionary doesn't match the
expected one (incorrect Adler32 value). inflateSetDictionary does not
perform any decompression: this will be done by subsequent calls of
inflate().
}
function inflateSync(var z : z_stream) : int;
{
Skips invalid compressed data until a full flush point (see above the
description of deflate with Z_FULL_FLUSH) can be found, or until all
available input is skipped. No output is provided.
inflateSync returns Z_OK if a full flush point has been found, Z_BUF_ERROR
if no more input was provided, Z_DATA_ERROR if no flush point has been found,
or Z_STREAM_ERROR if the stream structure was inconsistent. In the success
case, the application may save the current current value of total_in which
indicates where valid compressed data was found. In the error case, the
application may repeatedly call inflateSync, providing more input each time,
until success or end of the input data.
}
function inflateSyncPoint(var z : z_stream) : int;
{ Maximum size of dynamic tree. The maximum found in a long but non-
exhaustive search was 1004 huft structures (850 for length/literals
and 154 for distances, the latter actually the result of an
exhaustive search). The actual maximum is not known, but the
value below is more than safe. }
const
MANY = 1440;
{$ifdef DEBUG}
var
inflate_hufts : uInt;
{$endif}
function inflate_trees_bits(
var c : array of uIntf; { 19 code lengths }
var bb : uIntf; { bits tree desired/actual depth }
var tb : pinflate_huft; { bits tree result }
var hp : array of Inflate_huft; { space for trees }
var z : z_stream { for messages }
) : int;
function inflate_trees_dynamic(
nl : uInt; { number of literal/length codes }
nd : uInt; { number of distance codes }
var c : Array of uIntf; { that many (total) code lengths }
var bl : uIntf; { literal desired/actual bit depth }
var bd : uIntf; { distance desired/actual bit depth }
var tl : pInflate_huft; { literal/length tree result }
var td : pInflate_huft; { distance tree result }
var hp : array of Inflate_huft; { space for trees }
var z : z_stream { for messages }
) : int;
function inflate_trees_fixed (
var bl : uInt; { literal desired/actual bit depth }
var bd : uInt; { distance desired/actual bit depth }
var tl : pInflate_huft; { literal/length tree result }
var td : pInflate_huft; { distance tree result }
var z : z_stream { for memory allocation }
) : int;
{ copy as much as possible from the sliding window to the output area }
function inflate_flush(var s : inflate_blocks_state;
var z : z_stream;
r : int) : int;
{ And'ing with mask[n] masks the lower n bits }
const
inflate_mask : array[0..17-1] of uInt = (
$0000,
$0001, $0003, $0007, $000f, $001f, $003f, $007f, $00ff,
$01ff, $03ff, $07ff, $0fff, $1fff, $3fff, $7fff, $ffff);
{procedure GRABBITS(j : int);}
{procedure DUMPBITS(j : int);}
{procedure NEEDBITS(j : int);}
const
LENGTH_CODES = 29;
LITERALS = 256;
L_CODES = (LITERALS+1+LENGTH_CODES);
D_CODES = 30;
BL_CODES = 19;
HEAP_SIZE = (2*L_CODES+1);
MAX_BITS = 15;
INIT_STATE = 42;
BUSY_STATE = 113;
FINISH_STATE = 666;
type
ct_data_ptr = ^ct_data;
ct_data = record
fc : record
case byte of
0:(freq : ush); { frequency count }
1:(code : ush); { bit string }
end;
dl : record
case byte of
0:(dad : ush); { father node in Huffman tree }
1:(len : ush); { length of bit string }
end;
end;
ltree_type = array[0..HEAP_SIZE-1] of ct_data; { literal and length tree }
dtree_type = array[0..2*D_CODES+1-1] of ct_data; { distance tree }
htree_type = array[0..2*BL_CODES+1-1] of ct_data; { Huffman tree for bit lengths }
{ generic tree type }
tree_type = array[0..(MaxInt div SizeOf(ct_data))-1] of ct_data;
tree_ptr = ^tree_type;
ltree_ptr = ^ltree_type;
dtree_ptr = ^dtree_type;
htree_ptr = ^htree_type;
static_tree_desc_ptr = ^static_tree_desc;
static_tree_desc =
record
{const} static_tree : tree_ptr; { static tree or NIL }
{const} extra_bits : pzIntfArray; { extra bits for each code or NIL }
extra_base : int; { base index for extra_bits }
elems : int; { max number of elements in the tree }
max_length : int; { max bit length for the codes }
end;
tree_desc_ptr = ^tree_desc;
tree_desc = record
dyn_tree : tree_ptr; { the dynamic tree }
max_code : int; { largest code with non zero frequency }
stat_desc : static_tree_desc_ptr; { the corresponding static tree }
end;
Pos = ush;
Posf = Pos; {FAR}
IPos = uInt;
pPosf = ^Posf;
zPosfArray = array[0..(MaxInt div SizeOf(Posf))-1] of Posf;
pzPosfArray = ^zPosfArray;
deflate_state_ptr = ^deflate_state;
deflate_state = record
strm : z_streamp; { pointer back to this zlib stream }
status : int; { as the name implies }
pending_buf : pzByteArray; { output still pending }
pending_buf_size : ulg; { size of pending_buf }
pending_out : pBytef; { next pending byte to output to the stream }
pending : int; { nb of bytes in the pending buffer }
noheader : int; { suppress zlib header and adler32 }
data_type : Byte; { UNKNOWN, BINARY or ASCII }
method : Byte; { STORED (for zip only) or DEFLATED }
last_flush : int; { value of flush param for previous deflate call }
w_size : uInt; { LZ77 window size (32K by default) }
w_bits : uInt; { log2(w_size) (8..16) }
w_mask : uInt; { w_size - 1 }
window : pzByteArray;
window_size : ulg;
prev : pzPosfArray;
head : pzPosfArray; { Heads of the hash chains or NIL. }
ins_h : uInt; { hash index of string to be inserted }
hash_size : uInt; { number of elements in hash table }
hash_bits : uInt; { log2(hash_size) }
hash_mask : uInt; { hash_size-1 }
hash_shift : uInt;
block_start : long;
match_length : uInt; { length of best match }
prev_match : IPos; { previous match }
match_available : boolean; { set if previous match exists }
strstart : uInt; { start of string to insert }
match_start : uInt; { start of matching string }
lookahead : uInt; { number of valid bytes ahead in window }
prev_length : uInt;
max_chain_length : uInt;
level : int; { compression level (1..9) }
strategy : int; { favor or force Huffman coding}
good_match : uInt;
nice_match : int; { Stop searching when current match exceeds this }
dyn_ltree : ltree_type; { literal and length tree }
dyn_dtree : dtree_type; { distance tree }
bl_tree : htree_type; { Huffman tree for bit lengths }
l_desc : tree_desc; { desc. for literal tree }
d_desc : tree_desc; { desc. for distance tree }
bl_desc : tree_desc; { desc. for bit length tree }
bl_count : array[0..MAX_BITS+1-1] of ush;
heap : array[0..2*L_CODES+1-1] of int; { heap used to build the Huffman trees }
heap_len : int; { number of elements in the heap }
heap_max : int; { element of largest frequency }
depth : array[0..2*L_CODES+1-1] of uch;
l_buf : puchfArray; { buffer for literals or lengths }
lit_bufsize : uInt;
last_lit : uInt; { running index in l_buf }
d_buf : pushfArray;
opt_len : ulg; { bit length of current block with optimal trees }
static_len : ulg; { bit length of current block with static trees }
compressed_len : ulg; { total bit length of compressed file }
matches : uInt; { number of string matches in current block }
last_eob_len : int; { bit length of EOB code for last block }
{$ifdef DEBUG}
bits_sent : ulg; { bit length of the compressed data }
{$endif}
bi_buf : ush;
bi_valid : int;
case byte of
0:(max_lazy_match : uInt);
1:(max_insert_length : uInt);
end;
procedure _tr_init (var s : deflate_state);
function _tr_tally (var s : deflate_state;
dist : unsigned;
lc : unsigned) : boolean;
function _tr_flush_block (var s : deflate_state;
buf : pcharf;
stored_len : ulg;
eof : boolean) : ulg;
procedure _tr_align(var s : deflate_state);
procedure _tr_stored_block(var s : deflate_state;
buf : pcharf;
stored_len : ulg;
eof : boolean);
implementation
{$IFDEF CALLDOS}
{ reduce your application memory footprint with $M before using this }
function dosAlloc (Size : Longint) : Pointer;
var
regs: TRegisters;
begin
regs.bx := (Size + 15) div 16; { number of 16-bytes-paragraphs }
regs.ah := $48; { Allocate memory block }
msdos(regs);
if regs.Flags and FCarry <> 0 then
DosAlloc := NIL
else
DosAlloc := Ptr(regs.ax, 0);
end;
function dosFree(P : pointer) : boolean;
var
regs: TRegisters;
begin
dosFree := FALSE;
regs.bx := Seg(P^); { segment }
if Ofs(P) <> 0 then
exit;
regs.ah := $49; { Free memory block }
msdos(regs);
dosFree := (regs.Flags and FCarry = 0);
end;
{$ENDIF}
type
LH = record
L, H : word;
end;
{$IFDEF HugeMem}
{$define HEAP_LIST}
{$endif}
{$IFDEF HEAP_LIST} {--- to avoid Mark and Release --- }
const
MaxAllocEntries = 50;
type
TMemRec = record
orgvalue,
value : pointer;
size: longint;
end;
const
allocatedCount : 0..MaxAllocEntries = 0;
var
allocatedList : array[0..MaxAllocEntries-1] of TMemRec;
function NewAllocation(ptr0, ptr : pointer; memsize : longint) : boolean;
begin
if (allocatedCount < MaxAllocEntries) and (ptr0 <> NIL) then
begin
with allocatedList[allocatedCount] do
begin
orgvalue := ptr0;
value := ptr;
size := memsize;
end;
Inc(allocatedCount); { we don't check for duplicate }
NewAllocation := TRUE;
end
else
NewAllocation := FALSE;
end;
{$ENDIF}
{$IFDEF HugeMem}
{ The code below is extremely version specific to the TP 6/7 heap manager!!}
type
PFreeRec = ^TFreeRec;
TFreeRec = record
next: PFreeRec;
size: Pointer;
end;
type
HugePtr = voidpf;
procedure IncPtr(var p:pointer;count:word);
{ Increments pointer }
begin
inc(LH(p).L,count);
if LH(p).L < count then
inc(LH(p).H,SelectorInc); { $1000 }
end;
procedure DecPtr(var p:pointer;count:word);
{ decrements pointer }
begin
if count > LH(p).L then
dec(LH(p).H,SelectorInc);
dec(LH(p).L,Count);
end;
procedure IncPtrLong(var p:pointer;count:longint);
{ Increments pointer; assumes count > 0 }
begin
inc(LH(p).H,SelectorInc*LH(count).H);
inc(LH(p).L,LH(Count).L);
if LH(p).L < LH(count).L then
inc(LH(p).H,SelectorInc);
end;
procedure DecPtrLong(var p:pointer;count:longint);
{ Decrements pointer; assumes count > 0 }
begin
if LH(count).L > LH(p).L then
dec(LH(p).H,SelectorInc);
dec(LH(p).L,LH(Count).L);
dec(LH(p).H,SelectorInc*LH(Count).H);
end;
{ The next section is for real mode only }
function Normalized(p : pointer) : pointer;
var
count : word;
begin
count := LH(p).L and $FFF0;
Normalized := Ptr(LH(p).H + (count shr 4), LH(p).L and $F);
end;
procedure FreeHuge(var p:HugePtr; size : longint);
const
blocksize = $FFF0;
var
block : word;
begin
while size > 0 do
begin
{ block := minimum(size, blocksize); }
if size > blocksize then
block := blocksize
else
block := size;
dec(size,block);
freemem(p,block);
IncPtr(p,block); { we may get ptr($xxxx, $fff8) and 31 bytes left }
p := Normalized(p); { to free, so we must normalize }
end;
end;
function FreeMemHuge(ptr : pointer) : boolean;
var
i : integer; { -1..MaxAllocEntries }
begin
FreeMemHuge := FALSE;
i := allocatedCount - 1;
while (i >= 0) do
begin
if (ptr = allocatedList[i].value) then
begin
with allocatedList[i] do
FreeHuge(orgvalue, size);
Move(allocatedList[i+1], allocatedList[i],
SizeOf(TMemRec)*(allocatedCount - 1 - i));
Dec(allocatedCount);
FreeMemHuge := TRUE;
break;
end;
Dec(i);
end;
end;
procedure GetMemHuge(var p:HugePtr;memsize:Longint);
const
blocksize = $FFF0;
var
size : longint;
prev,free : PFreeRec;
save,temp : pointer;
block : word;
begin
p := NIL;
{ Handle the easy cases first }
if memsize > maxavail then
exit
else
if memsize <= blocksize then
begin
getmem(p, memsize);
if not NewAllocation(p, p, memsize) then
begin
FreeMem(p, memsize);
p := NIL;
end;
end
else
begin
size := memsize + 15;
{ Find the block that has enough space }
prev := PFreeRec(@freeList);
free := prev^.next;
while (free <> heapptr) and (ptr2int(free^.size) < size) do
begin
prev := free;
free := prev^.next;
end;
{ Now free points to a region with enough space; make it the first one and
multiple allocations will be contiguous. }
save := freelist;
freelist := free;
{ In TP 6, this works; check against other heap managers }
while size > 0 do
begin
{ block := minimum(size, blocksize); }
if size > blocksize then
block := blocksize
else
block := size;
dec(size,block);
getmem(temp,block);
end;
{ We've got what we want now; just sort things out and restore the
free list to normal }
p := free;
if prev^.next <> freelist then
begin
prev^.next := freelist;
freelist := save;
end;
if (p <> NIL) then
begin
{ return pointer with 0 offset }
temp := p;
if Ofs(p^)<>0 Then
p := Ptr(Seg(p^)+1,0); { hack }
if not NewAllocation(temp, p, memsize + 15) then
begin
FreeHuge(temp, size);
p := NIL;
end;
end;
end;
end;
{$ENDIF}
procedure zmemcpy(destp : pBytef; sourcep : pBytef; len : uInt);
begin
Move(sourcep^, destp^, len);
end;
function zmemcmp(s1p, s2p : pBytef; len : uInt) : int;
var
j : uInt;
source,
dest : pBytef;
begin
source := s1p;
dest := s2p;
for j := 0 to pred(len) do
begin
if (source^ <> dest^) then
begin
zmemcmp := 2*Ord(source^ > dest^)-1;
exit;
end;
Inc(source);
Inc(dest);
end;
zmemcmp := 0;
end;
procedure zmemzero(destp : pBytef; len : uInt);
begin
FillChar(destp^, len, 0);
end;
procedure zcfree(opaque : voidpf; ptr : voidpf);
{$ifdef Delphi16}
var
Handle : THandle;
{$endif}
{$IFDEF FPC}
var
memsize : uint;
{$ENDIF}
begin
{$IFDEF DPMI}
{h :=} GlobalFreePtr(ptr);
{$ELSE}
{$IFDEF CALL_DOS}
dosFree(ptr);
{$ELSE}
{$ifdef HugeMem}
FreeMemHuge(ptr);
{$else}
{$ifdef Delphi16}
Handle := GlobalHandle(LH(ptr).H); { HiWord(LongInt(ptr)) }
GlobalUnLock(Handle);
GlobalFree(Handle);
{$else}
{$IFDEF FPC}
Dec(puIntf(ptr));
memsize := puIntf(ptr)^;
FreeMem(ptr, memsize+SizeOf(uInt));
{$ELSE}
FreeMem(ptr); { Delphi 2,3,4 }
{$ENDIF}
{$endif}
{$endif}
{$ENDIF}
{$ENDIF}
end;
function zcalloc (opaque : voidpf; items : uInt; size : uInt) : voidpf;
var
p : voidpf;
memsize : uLong;
{$ifdef Delphi16}
handle : THandle;
{$endif}
begin
memsize := uLong(items) * size;
{$IFDEF DPMI}
p := GlobalAllocPtr(gmem_moveable, memsize);
{$ELSE}
{$IFDEF CALLDOS}
p := dosAlloc(memsize);
{$ELSE}
{$ifdef HugeMem}
GetMemHuge(p, memsize);
{$else}
{$ifdef Delphi16}
Handle := GlobalAlloc(HeapAllocFlags, memsize);
p := GlobalLock(Handle);
{$else}
{$IFDEF FPC}
GetMem(p, memsize+SizeOf(uInt));
puIntf(p)^:= memsize;
Inc(puIntf(p));
{$ELSE}
GetMem(p, memsize); { Delphi: p := AllocMem(memsize); }
{$ENDIF}
{$endif}
{$endif}
{$ENDIF}
{$ENDIF}
zcalloc := p;
end;
function zError(err : int) : string;
begin
zError := z_errmsg[Z_NEED_DICT-err];
end;
function zlibVersion : string;
begin
zlibVersion := ZLIB_VERSION;
end;
procedure z_error (m : string);
begin
WriteLn(output, m);
Write('Zlib - Halt...');
ReadLn;
Halt(1);
end;
procedure Assert(cond : boolean; msg : string);
begin
if not cond then
z_error(msg);
end;
procedure Trace(x : string);
begin
WriteLn(x);
end;
procedure Tracev(x : string);
begin
if (z_verbose>0) then
WriteLn(x);
end;
procedure Tracevv(x : string);
begin
if (z_verbose>1) then
WriteLn(x);
end;
procedure Tracevvv(x : string);
begin
if (z_verbose>2) then
WriteLn(x);
end;
procedure Tracec(c : boolean; x : string);
begin
if (z_verbose>0) and (c) then
WriteLn(x);
end;
procedure Tracecv(c : boolean; x : string);
begin
if (z_verbose>1) and c then
WriteLn(x);
end;
function ZALLOC (var strm : z_stream; items : uInt; size : uInt) : voidpf;
begin
ZALLOC := strm.zalloc(strm.opaque, items, size);
end;
procedure ZFREE (var strm : z_stream; ptr : voidpf);
begin
strm.zfree(strm.opaque, ptr);
end;
procedure TRY_FREE (var strm : z_stream; ptr : voidpf);
begin
{if @strm <> Z_NULL then}
strm.zfree(strm.opaque, ptr);
end;
const
BASE = Long(65521); { largest prime smaller than 65536 }
{NMAX = 5552; original code with unsigned 32 bit integer }
{ NMAX is the largest n such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^32-1 }
NMAX = 3854; { code with signed 32 bit integer }
{ NMAX is the largest n such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^31-1 }
{ The penalty is the time loss in the extra MOD-calls. }
{ ========================================================================= }
function adler32(adler : uLong; buf : pBytef; len : uInt) : uLong;
var
s1, s2 : uLong;
k : int;
begin
s1 := adler and $ffff;
s2 := (adler shr 16) and $ffff;
if not Assigned(buf) then
begin
adler32 := uLong(1);
exit;
end;
while (len > 0) do
begin
if len < NMAX then
k := len
else
k := NMAX;
Dec(len, k);
while (k > 0) do
begin
Inc(s1, buf^);
Inc(s2, s1);
Inc(buf);
Dec(k);
end;
s1 := s1 mod BASE;
s2 := s2 mod BASE;
end;
adler32 := (s2 shl 16) or s1;
end;
{ ===========================================================================
Function prototypes. }
type
block_state = (
need_more, { block not completed, need more input or more output }
block_done, { block flush performed }
finish_started, { finish started, need only more output at next deflate }
finish_done); { finish done, accept no more input or output }
{ Compression function. Returns the block state after the call. }
type
compress_func = function(var s : deflate_state; flush : int) : block_state;
{local}
procedure fill_window(var s : deflate_state); forward;
{local}
function deflate_stored(var s : deflate_state; flush : int) : block_state; far; forward;
{local}
function deflate_fast(var s : deflate_state; flush : int) : block_state; far; forward;
{local}
function deflate_slow(var s : deflate_state; flush : int) : block_state; far; forward;
{local}
procedure lm_init(var s : deflate_state); forward;
{local}
procedure putShortMSB(var s : deflate_state; b : uInt); forward;
{local}
procedure flush_pending (var strm : z_stream); forward;
{local}
function read_buf(strm : z_streamp;
buf : pBytef;
size : unsigned) : int; forward;
{$ifdef ASMV}
procedure match_init; { asm code initialization }
function longest_match(var deflate_state; cur_match : IPos) : uInt; forward;
{$else}
{local}
function longest_match(var s : deflate_state; cur_match : IPos) : uInt;
forward;
{$endif}
{$ifdef DEBUG}
{local}
procedure check_match(var s : deflate_state;
start, match : IPos;
length : int); forward;
{$endif}
{ ==========================================================================
local data }
const
ZNIL = 0;
{ Tail of hash chains }
const
TOO_FAR = 4096;
{ Matches of length 3 are discarded if their distance exceeds TOO_FAR }
{const
MIN_LOOKAHEAD = (MAX_MATCH+MIN_MATCH+1);}
{ Minimum amount of lookahead, except at the end of the input file.
See deflate.c for comments about the MIN_MATCH+1. }
{macro MAX_DIST(var s : deflate_state) : uInt;
begin
MAX_DIST := (s.w_size - MIN_LOOKAHEAD);
end;
In order to simplify the code, particularly on 16 bit machines, match
distances are limited to MAX_DIST instead of WSIZE. }
{ Values for max_lazy_match, good_match and max_chain_length, depending on
the desired pack level (0..9). The values given below have been tuned to
exclude worst case performance for pathological files. Better values may be
found for specific files. }
type
config = record
good_length : ush; { reduce lazy search above this match length }
max_lazy : ush; { do not perform lazy search above this match length }
nice_length : ush; { quit search above this match length }
max_chain : ush;
func : compress_func;
end;
{local}
const
configuration_table : array[0..10-1] of config = (
{ good lazy nice chain }
{0} (good_length:0; max_lazy:0; nice_length:0; max_chain:0; func:deflate_stored), { store only }
{1} (good_length:4; max_lazy:4; nice_length:8; max_chain:4; func:deflate_fast), { maximum speed, no lazy matches }
{2} (good_length:4; max_lazy:5; nice_length:16; max_chain:8; func:deflate_fast),
{3} (good_length:4; max_lazy:6; nice_length:32; max_chain:32; func:deflate_fast),
{4} (good_length:4; max_lazy:4; nice_length:16; max_chain:16; func:deflate_slow), { lazy matches }
{5} (good_length:8; max_lazy:16; nice_length:32; max_chain:32; func:deflate_slow),
{6} (good_length:8; max_lazy:16; nice_length:128; max_chain:128; func:deflate_slow),
{7} (good_length:8; max_lazy:32; nice_length:128; max_chain:256; func:deflate_slow),
{8} (good_length:32; max_lazy:128; nice_length:258; max_chain:1024; func:deflate_slow),
{9} (good_length:32; max_lazy:258; nice_length:258; max_chain:4096; func:deflate_slow)); { maximum compression }
{ Note: the deflate() code requires max_lazy >= MIN_MATCH and max_chain >= 4
For deflate_fast() (levels <= 3) good is ignored and lazy has a different
meaning. }
const
EQUAL = 0;
{ result of memcmp for equal strings }
{ ==========================================================================
Update a hash value with the given input byte
IN assertion: all calls to to UPDATE_HASH are made with consecutive
input characters, so that a running hash key can be computed from the
previous key instead of complete recalculation each time.
macro UPDATE_HASH(s,h,c)
h := (( (h) shl s^.hash_shift) xor (c)) and s^.hash_mask;
}
{ ===========================================================================
Insert string str in the dictionary and set match_head to the previous head
of the hash chain (the most recent string with same hash key). Return
the previous length of the hash chain.
If this file is compiled with -DFASTEST, the compression level is forced
to 1, and no hash chains are maintained.
IN assertion: all calls to to INSERT_STRING are made with consecutive
input characters and the first MIN_MATCH bytes of str are valid
(except for the last MIN_MATCH-1 bytes of the input file). }
procedure INSERT_STRING(var s : deflate_state;
str : uInt;
var match_head : IPos);
begin
{$ifdef FASTEST}
{UPDATE_HASH(s, s.ins_h, s.window[(str) + (MIN_MATCH-1)])}
s.ins_h := ((s.ins_h shl s.hash_shift) xor
(s.window^[(str) + (MIN_MATCH-1)])) and s.hash_mask;
match_head := s.head[s.ins_h]
s.head[s.ins_h] := Pos(str);
{$else}
{UPDATE_HASH(s, s.ins_h, s.window[(str) + (MIN_MATCH-1)])}
s.ins_h := ((s.ins_h shl s.hash_shift) xor
(s.window^[(str) + (MIN_MATCH-1)])) and s.hash_mask;
match_head := s.head^[s.ins_h];
s.prev^[(str) and s.w_mask] := match_head;
s.head^[s.ins_h] := Pos(str);
{$endif}
end;
{ =========================================================================
Initialize the hash table (avoiding 64K overflow for 16 bit systems).
prev[] will be initialized on the fly.
macro CLEAR_HASH(s)
s^.head[s^.hash_size-1] := ZNIL;
zmemzero(pBytef(s^.head), unsigned(s^.hash_size-1)*sizeof(s^.head^[0]));
}
{ ======================================================================== }
function deflateInit2_(var strm : z_stream;
level : int;
method : int;
windowBits : int;
memLevel : int;
strategy : int;
const version : string;
stream_size : int) : int;
var
s : deflate_state_ptr;
noheader : int;
overlay : pushfArray;
{ We overlay pending_buf and d_buf+l_buf. This works since the average
output size for (length,distance) codes is <= 24 bits. }
begin
noheader := 0;
if (version = '') or (version[1] <> ZLIB_VERSION[1]) or
(stream_size <> sizeof(z_stream)) then
begin
deflateInit2_ := Z_VERSION_ERROR;
exit;
end;
{
if (strm = Z_NULL) then
begin
deflateInit2_ := Z_STREAM_ERROR;
exit;
end;
}
{ SetLength(strm.msg, 255); }
strm.msg := '';
if not Assigned(strm.zalloc) then
begin
strm.zalloc := zcalloc;
strm.opaque := voidpf(0);
end;
if not Assigned(strm.zfree) then
strm.zfree := zcfree;
if (level = Z_DEFAULT_COMPRESSION) then
level := 6;
{$ifdef FASTEST}
level := 1;
{$endif}
if (windowBits < 0) then { undocumented feature: suppress zlib header }
begin
noheader := 1;
windowBits := -windowBits;
end;
if (memLevel < 1) or (memLevel > MAX_MEM_LEVEL) or (method <> Z_DEFLATED)
or (windowBits < 8) or (windowBits > 15) or (level < 0)
or (level > 9) or (strategy < 0) or (strategy > Z_HUFFMAN_ONLY) then
begin
deflateInit2_ := Z_STREAM_ERROR;
exit;
end;
s := deflate_state_ptr (ZALLOC(strm, 1, sizeof(deflate_state)));
if (s = Z_NULL) then
begin
deflateInit2_ := Z_MEM_ERROR;
exit;
end;
strm.state := pInternal_state(s);
s^.strm := @strm;
s^.noheader := noheader;
s^.w_bits := windowBits;
s^.w_size := 1 shl s^.w_bits;
s^.w_mask := s^.w_size - 1;
s^.hash_bits := memLevel + 7;
s^.hash_size := 1 shl s^.hash_bits;
s^.hash_mask := s^.hash_size - 1;
s^.hash_shift := ((s^.hash_bits+MIN_MATCH-1) div MIN_MATCH);
s^.window := pzByteArray (ZALLOC(strm, s^.w_size, 2*sizeof(Byte)));
s^.prev := pzPosfArray (ZALLOC(strm, s^.w_size, sizeof(Pos)));
s^.head := pzPosfArray (ZALLOC(strm, s^.hash_size, sizeof(Pos)));
s^.lit_bufsize := 1 shl (memLevel + 6); { 16K elements by default }
overlay := pushfArray (ZALLOC(strm, s^.lit_bufsize, sizeof(ush)+2));
s^.pending_buf := pzByteArray (overlay);
s^.pending_buf_size := ulg(s^.lit_bufsize) * (sizeof(ush)+Long(2));
if (s^.window = Z_NULL) or (s^.prev = Z_NULL) or (s^.head = Z_NULL)
or (s^.pending_buf = Z_NULL) then
begin
{ERR_MSG(Z_MEM_ERROR);}
strm.msg := z_errmsg[z_errbase-Z_MEM_ERROR];
deflateEnd (strm);
deflateInit2_ := Z_MEM_ERROR;
exit;
end;
s^.d_buf := pushfArray( @overlay^[s^.lit_bufsize div sizeof(ush)] );
s^.l_buf := puchfArray( @s^.pending_buf^[(1+sizeof(ush))*s^.lit_bufsize] );
s^.level := level;
s^.strategy := strategy;
s^.method := Byte(method);
deflateInit2_ := deflateReset(strm);
end;
{ ========================================================================= }
function deflateInit2(var strm : z_stream;
level : int;
method : int;
windowBits : int;
memLevel : int;
strategy : int) : int;
{ a macro }
begin
deflateInit2 := deflateInit2_(strm, level, method, windowBits,
memLevel, strategy, ZLIB_VERSION, sizeof(z_stream));
end;
{ ========================================================================= }
function deflateInit_(strm : z_streamp;
level : int;
const version : string;
stream_size : int) : int;
begin
if (strm = Z_NULL) then
deflateInit_ := Z_STREAM_ERROR
else
deflateInit_ := deflateInit2_(strm^, level, Z_DEFLATED, MAX_WBITS,
DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, version, stream_size);
{ To do: ignore strm^.next_in if we use it as window }
end;
{ ========================================================================= }
function deflateInit(var strm : z_stream; level : int) : int;
{ deflateInit is a macro to allow checking the zlib version
and the compiler's view of z_stream: }
begin
deflateInit := deflateInit2_(strm, level, Z_DEFLATED, MAX_WBITS,
DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, ZLIB_VERSION, sizeof(z_stream));
end;
{ ======================================================================== }
function deflateSetDictionary (var strm : z_stream;
dictionary : pBytef;
dictLength : uInt) : int;
var
s : deflate_state_ptr;
length : uInt;
n : uInt;
hash_head : IPos;
var
MAX_DIST : uInt; {macro}
begin
length := dictLength;
hash_head := 0;
if {(@strm = Z_NULL) or}
(strm.state = Z_NULL) or (dictionary = Z_NULL)
or (deflate_state_ptr(strm.state)^.status <> INIT_STATE) then
begin
deflateSetDictionary := Z_STREAM_ERROR;
exit;
end;
s := deflate_state_ptr(strm.state);
strm.adler := adler32(strm.adler, dictionary, dictLength);
if (length < MIN_MATCH) then
begin
deflateSetDictionary := Z_OK;
exit;
end;
MAX_DIST := (s^.w_size - MIN_LOOKAHEAD);
if (length > MAX_DIST) then
begin
length := MAX_DIST;
{$ifndef USE_DICT_HEAD}
Inc(dictionary, dictLength - length); { use the tail of the dictionary }
{$endif}
end;
zmemcpy( pBytef(s^.window), dictionary, length);
s^.strstart := length;
s^.block_start := long(length);
{ Insert all strings in the hash table (except for the last two bytes).
s^.lookahead stays null, so s^.ins_h will be recomputed at the next
call of fill_window. }
s^.ins_h := s^.window^[0];
{UPDATE_HASH(s, s^.ins_h, s^.window[1]);}
s^.ins_h := ((s^.ins_h shl s^.hash_shift) xor (s^.window^[1]))
and s^.hash_mask;
for n := 0 to length - MIN_MATCH do
begin
INSERT_STRING(s^, n, hash_head);
end;
{if (hash_head <> 0) then
hash_head := 0; - to make compiler happy }
deflateSetDictionary := Z_OK;
end;
{ ======================================================================== }
function deflateReset (var strm : z_stream) : int;
var
s : deflate_state_ptr;
begin
if {(@strm = Z_NULL) or}
(strm.state = Z_NULL)
or (not Assigned(strm.zalloc)) or (not Assigned(strm.zfree)) then
begin
deflateReset := Z_STREAM_ERROR;
exit;
end;
strm.total_out := 0;
strm.total_in := 0;
strm.msg := ''; { use zfree if we ever allocate msg dynamically }
strm.data_type := Z_UNKNOWN;
s := deflate_state_ptr(strm.state);
s^.pending := 0;
s^.pending_out := pBytef(s^.pending_buf);
if (s^.noheader < 0) then
begin
s^.noheader := 0; { was set to -1 by deflate(..., Z_FINISH); }
end;
if s^.noheader <> 0 then
s^.status := BUSY_STATE
else
s^.status := INIT_STATE;
strm.adler := 1;
s^.last_flush := Z_NO_FLUSH;
_tr_init(s^);
lm_init(s^);
deflateReset := Z_OK;
end;
{ ======================================================================== }
function deflateParams(var strm : z_stream;
level : int;
strategy : int) : int;
var
s : deflate_state_ptr;
func : compress_func;
err : int;
begin
err := Z_OK;
if {(@strm = Z_NULL) or} (strm.state = Z_NULL) then
begin
deflateParams := Z_STREAM_ERROR;
exit;
end;
s := deflate_state_ptr(strm.state);
if (level = Z_DEFAULT_COMPRESSION) then
begin
level := 6;
end;
if (level < 0) or (level > 9) or (strategy < 0)
or (strategy > Z_HUFFMAN_ONLY) then
begin
deflateParams := Z_STREAM_ERROR;
exit;
end;
func := configuration_table[s^.level].func;
if (@func <> @configuration_table[level].func)
and (strm.total_in <> 0) then
begin
{ Flush the last buffer: }
err := deflate(strm, Z_PARTIAL_FLUSH);
end;
if (s^.level <> level) then
begin
s^.level := level;
s^.max_lazy_match := configuration_table[level].max_lazy;
s^.good_match := configuration_table[level].good_length;
s^.nice_match := configuration_table[level].nice_length;
s^.max_chain_length := configuration_table[level].max_chain;
end;
s^.strategy := strategy;
deflateParams := err;
end;
{ =========================================================================
Put a short in the pending buffer. The 16-bit value is put in MSB order.
IN assertion: the stream state is correct and there is enough room in
pending_buf. }
{local}
procedure putShortMSB (var s : deflate_state; b : uInt);
begin
s.pending_buf^[s.pending] := Byte(b shr 8);
Inc(s.pending);
s.pending_buf^[s.pending] := Byte(b and $ff);
Inc(s.pending);
end;
{ =========================================================================
Flush as much pending output as possible. All deflate() output goes
through this function so some applications may wish to modify it
to avoid allocating a large strm^.next_out buffer and copying into it.
(See also read_buf()). }
{local}
procedure flush_pending(var strm : z_stream);
var
len : unsigned;
s : deflate_state_ptr;
begin
s := deflate_state_ptr(strm.state);
len := s^.pending;
if (len > strm.avail_out) then
len := strm.avail_out;
if (len = 0) then
exit;
zmemcpy(strm.next_out, s^.pending_out, len);
Inc(strm.next_out, len);
Inc(s^.pending_out, len);
Inc(strm.total_out, len);
Dec(strm.avail_out, len);
Dec(s^.pending, len);
if (s^.pending = 0) then
begin
s^.pending_out := pBytef(s^.pending_buf);
end;
end;
{ ========================================================================= }
function deflate (var strm : z_stream; flush : int) : int;
var
old_flush : int; { value of flush param for previous deflate call }
s : deflate_state_ptr;
var
header : uInt;
level_flags : uInt;
var
bstate : block_state;
begin
if {(@strm = Z_NULL) or} (strm.state = Z_NULL)
or (flush > Z_FINISH) or (flush < 0) then
begin
deflate := Z_STREAM_ERROR;
exit;
end;
s := deflate_state_ptr(strm.state);
if (strm.next_out = Z_NULL) or
((strm.next_in = Z_NULL) and (strm.avail_in <> 0)) or
((s^.status = FINISH_STATE) and (flush <> Z_FINISH)) then
begin
{ERR_RETURN(strm^, Z_STREAM_ERROR);}
strm.msg := z_errmsg[z_errbase - Z_STREAM_ERROR];
deflate := Z_STREAM_ERROR;
exit;
end;
if (strm.avail_out = 0) then
begin
{ERR_RETURN(strm^, Z_BUF_ERROR);}
strm.msg := z_errmsg[z_errbase - Z_BUF_ERROR];
deflate := Z_BUF_ERROR;
exit;
end;
s^.strm := @strm; { just in case }
old_flush := s^.last_flush;
s^.last_flush := flush;
{ Write the zlib header }
if (s^.status = INIT_STATE) then
begin
header := (Z_DEFLATED + ((s^.w_bits-8) shl 4)) shl 8;
level_flags := (s^.level-1) shr 1;
if (level_flags > 3) then
level_flags := 3;
header := header or (level_flags shl 6);
if (s^.strstart <> 0) then
header := header or PRESET_DICT;
Inc(header, 31 - (header mod 31));
s^.status := BUSY_STATE;
putShortMSB(s^, header);
{ Save the adler32 of the preset dictionary: }
if (s^.strstart <> 0) then
begin
putShortMSB(s^, uInt(strm.adler shr 16));
putShortMSB(s^, uInt(strm.adler and $ffff));
end;
strm.adler := long(1);
end;
{ Flush as much pending output as possible }
if (s^.pending <> 0) then
begin
flush_pending(strm);
if (strm.avail_out = 0) then
begin
{ Since avail_out is 0, deflate will be called again with
more output space, but possibly with both pending and
avail_in equal to zero. There won't be anything to do,
but this is not an error situation so make sure we
return OK instead of BUF_ERROR at next call of deflate: }
s^.last_flush := -1;
deflate := Z_OK;
exit;
end;
{ Make sure there is something to do and avoid duplicate consecutive
flushes. For repeated and useless calls with Z_FINISH, we keep
returning Z_STREAM_END instead of Z_BUFF_ERROR. }
end
else
if (strm.avail_in = 0) and (flush <= old_flush)
and (flush <> Z_FINISH) then
begin
{ERR_RETURN(strm^, Z_BUF_ERROR);}
strm.msg := z_errmsg[z_errbase - Z_BUF_ERROR];
deflate := Z_BUF_ERROR;
exit;
end;
{ User must not provide more input after the first FINISH: }
if (s^.status = FINISH_STATE) and (strm.avail_in <> 0) then
begin
{ERR_RETURN(strm^, Z_BUF_ERROR);}
strm.msg := z_errmsg[z_errbase - Z_BUF_ERROR];
deflate := Z_BUF_ERROR;
exit;
end;
{ Start a new block or continue the current one. }
if (strm.avail_in <> 0) or (s^.lookahead <> 0)
or ((flush <> Z_NO_FLUSH) and (s^.status <> FINISH_STATE)) then
begin
bstate := configuration_table[s^.level].func(s^, flush);
if (bstate = finish_started) or (bstate = finish_done) then
s^.status := FINISH_STATE;
if (bstate = need_more) or (bstate = finish_started) then
begin
if (strm.avail_out = 0) then
s^.last_flush := -1; { avoid BUF_ERROR next call, see above }
deflate := Z_OK;
exit;
{ If flush != Z_NO_FLUSH && avail_out == 0, the next call
of deflate should use the same flush parameter to make sure
that the flush is complete. So we don't have to output an
empty block here, this will be done at next call. This also
ensures that for a very small output buffer, we emit at most
one empty block. }
end;
if (bstate = block_done) then
begin
if (flush = Z_PARTIAL_FLUSH) then
_tr_align(s^)
else
begin { FULL_FLUSH or SYNC_FLUSH }
_tr_stored_block(s^, pcharf(NIL), Long(0), FALSE);
{ For a full flush, this empty block will be recognized
as a special marker by inflate_sync(). }
if (flush = Z_FULL_FLUSH) then
begin
{macro CLEAR_HASH(s);} { forget history }
s^.head^[s^.hash_size-1] := ZNIL;
zmemzero(pBytef(s^.head), unsigned(s^.hash_size-1)*sizeof(s^.head^[0]));
end;
end;
flush_pending(strm);
if (strm.avail_out = 0) then
begin
s^.last_flush := -1; { avoid BUF_ERROR at next call, see above }
deflate := Z_OK;
exit;
end;
end;
end;
{$IFDEF DEBUG}
Assert(strm.avail_out > 0, 'bug2');
{$ENDIF}
if (flush <> Z_FINISH) then
begin
deflate := Z_OK;
exit;
end;
if (s^.noheader <> 0) then
begin
deflate := Z_STREAM_END;
exit;
end;
{ Write the zlib trailer (adler32) }
putShortMSB(s^, uInt(strm.adler shr 16));
putShortMSB(s^, uInt(strm.adler and $ffff));
flush_pending(strm);
{ If avail_out is zero, the application will call deflate again
to flush the rest. }
s^.noheader := -1; { write the trailer only once! }
if s^.pending <> 0 then
deflate := Z_OK
else
deflate := Z_STREAM_END;
end;
{ ========================================================================= }
function deflateEnd (var strm : z_stream) : int;
var
status : int;
s : deflate_state_ptr;
begin
if {(@strm = Z_NULL) or} (strm.state = Z_NULL) then
begin
deflateEnd := Z_STREAM_ERROR;
exit;
end;
s := deflate_state_ptr(strm.state);
status := s^.status;
if (status <> INIT_STATE) and (status <> BUSY_STATE) and
(status <> FINISH_STATE) then
begin
deflateEnd := Z_STREAM_ERROR;
exit;
end;
{ Deallocate in reverse order of allocations: }
TRY_FREE(strm, s^.pending_buf);
TRY_FREE(strm, s^.head);
TRY_FREE(strm, s^.prev);
TRY_FREE(strm, s^.window);
ZFREE(strm, s);
strm.state := Z_NULL;
if status = BUSY_STATE then
deflateEnd := Z_DATA_ERROR
else
deflateEnd := Z_OK;
end;
{ =========================================================================
Copy the source state to the destination state.
To simplify the source, this is not supported for 16-bit MSDOS (which
doesn't have enough memory anyway to duplicate compression states). }
{ ========================================================================= }
function deflateCopy (dest, source : z_streamp) : int;
{$ifndef MAXSEG_64K}
var
ds : deflate_state_ptr;
ss : deflate_state_ptr;
overlay : pushfArray;
{$endif}
begin
{$ifdef MAXSEG_64K}
deflateCopy := Z_STREAM_ERROR;
exit;
{$else}
if (source = Z_NULL) or (dest = Z_NULL) or (source^.state = Z_NULL) then
begin
deflateCopy := Z_STREAM_ERROR;
exit;
end;
ss := deflate_state_ptr(source^.state);
dest^ := source^;
ds := deflate_state_ptr( ZALLOC(dest^, 1, sizeof(deflate_state)) );
if (ds = Z_NULL) then
begin
deflateCopy := Z_MEM_ERROR;
exit;
end;
dest^.state := pInternal_state(ds);
ds^ := ss^;
ds^.strm := dest;
ds^.window := pzByteArray ( ZALLOC(dest^, ds^.w_size, 2*sizeof(Byte)) );
ds^.prev := pzPosfArray ( ZALLOC(dest^, ds^.w_size, sizeof(Pos)) );
ds^.head := pzPosfArray ( ZALLOC(dest^, ds^.hash_size, sizeof(Pos)) );
overlay := pushfArray ( ZALLOC(dest^, ds^.lit_bufsize, sizeof(ush)+2) );
ds^.pending_buf := pzByteArray ( overlay );
if (ds^.window = Z_NULL) or (ds^.prev = Z_NULL) or (ds^.head = Z_NULL)
or (ds^.pending_buf = Z_NULL) then
begin
deflateEnd (dest^);
deflateCopy := Z_MEM_ERROR;
exit;
end;
{ following zmemcpy do not work for 16-bit MSDOS }
zmemcpy(pBytef(ds^.window), pBytef(ss^.window), ds^.w_size * 2 * sizeof(Byte));
zmemcpy(pBytef(ds^.prev), pBytef(ss^.prev), ds^.w_size * sizeof(Pos));
zmemcpy(pBytef(ds^.head), pBytef(ss^.head), ds^.hash_size * sizeof(Pos));
zmemcpy(pBytef(ds^.pending_buf), pBytef(ss^.pending_buf), uInt(ds^.pending_buf_size));
ds^.pending_out := @ds^.pending_buf^[ptr2int(ss^.pending_out) - ptr2int(ss^.pending_buf)];
ds^.d_buf := pushfArray (@overlay^[ds^.lit_bufsize div sizeof(ush)] );
ds^.l_buf := puchfArray (@ds^.pending_buf^[(1+sizeof(ush))*ds^.lit_bufsize]);
ds^.l_desc.dyn_tree := tree_ptr(@ds^.dyn_ltree);
ds^.d_desc.dyn_tree := tree_ptr(@ds^.dyn_dtree);
ds^.bl_desc.dyn_tree := tree_ptr(@ds^.bl_tree);
deflateCopy := Z_OK;
{$endif}
end;
{ ===========================================================================
Read a new buffer from the current input stream, update the adler32
and total number of bytes read. All deflate() input goes through
this function so some applications may wish to modify it to avoid
allocating a large strm^.next_in buffer and copying from it.
(See also flush_pending()). }
{local}
function read_buf(strm : z_streamp; buf : pBytef; size : unsigned) : int;
var
len : unsigned;
begin
len := strm^.avail_in;
if (len > size) then
len := size;
if (len = 0) then
begin
read_buf := 0;
exit;
end;
Dec(strm^.avail_in, len);
if deflate_state_ptr(strm^.state)^.noheader = 0 then
begin
strm^.adler := adler32(strm^.adler, strm^.next_in, len);
end;
zmemcpy(buf, strm^.next_in, len);
Inc(strm^.next_in, len);
Inc(strm^.total_in, len);
read_buf := int(len);
end;
{ ===========================================================================
Initialize the "longest match" routines for a new zlib stream }
{local}
procedure lm_init (var s : deflate_state);
begin
{$WARNINGS OFF}
s.window_size := ulg(uLong(2)*s.w_size);
{$WARNINGS ON}
{macro CLEAR_HASH(s);}
s.head^[s.hash_size-1] := ZNIL;
zmemzero(pBytef(s.head), unsigned(s.hash_size-1)*sizeof(s.head^[0]));
{ Set the default configuration parameters: }
s.max_lazy_match := configuration_table[s.level].max_lazy;
s.good_match := configuration_table[s.level].good_length;
s.nice_match := configuration_table[s.level].nice_length;
s.max_chain_length := configuration_table[s.level].max_chain;
s.strstart := 0;
s.block_start := long(0);
s.lookahead := 0;
s.prev_length := MIN_MATCH-1;
s.match_length := MIN_MATCH-1;
s.match_available := FALSE;
s.ins_h := 0;
{$ifdef ASMV}
match_init; { initialize the asm code }
{$endif}
end;
{ ===========================================================================
Set match_start to the longest match starting at the given string and
return its length. Matches shorter or equal to prev_length are discarded,
in which case the result is equal to prev_length and match_start is
garbage.
IN assertions: cur_match is the head of the hash chain for the current
string (strstart) and its distance is <= MAX_DIST, and prev_length >= 1
OUT assertion: the match length is not greater than s^.lookahead. }
{$ifndef ASMV}
{ For 80x86 and 680x0, an optimized version will be provided in match.asm or
match.S. The code will be functionally equivalent. }
{$ifndef FASTEST}
{local}
function longest_match(var s : deflate_state;
cur_match : IPos { current match }
) : uInt;
label
nextstep;
var
chain_length : unsigned; { max hash chain length }
{register} scan : pBytef; { current string }
{register} match : pBytef; { matched string }
{register} len : int; { length of current match }
best_len : int; { best match length so far }
nice_match : int; { stop if match long enough }
limit : IPos;
prev : pzPosfArray;
wmask : uInt;
{$ifdef UNALIGNED_OK}
{register} strend : pBytef;
{register} scan_start : ush;
{register} scan_end : ush;
{$else}
{register} strend : pBytef;
{register} scan_end1 : Byte;
{register} scan_end : Byte;
{$endif}
var
MAX_DIST : uInt;
begin
chain_length := s.max_chain_length; { max hash chain length }
scan := @(s.window^[s.strstart]);
best_len := s.prev_length; { best match length so far }
nice_match := s.nice_match; { stop if match long enough }
MAX_DIST := s.w_size - MIN_LOOKAHEAD;
{In order to simplify the code, particularly on 16 bit machines, match
distances are limited to MAX_DIST instead of WSIZE. }
if s.strstart > IPos(MAX_DIST) then
limit := s.strstart - IPos(MAX_DIST)
else
limit := ZNIL;
{ Stop when cur_match becomes <= limit. To simplify the code,
we prevent matches with the string of window index 0. }
prev := s.prev;
wmask := s.w_mask;
{$ifdef UNALIGNED_OK}
{ Compare two bytes at a time. Note: this is not always beneficial.
Try with and without -DUNALIGNED_OK to check. }
strend := pBytef(@(s.window^[s.strstart + MAX_MATCH - 1]));
scan_start := pushf(scan)^;
scan_end := pushfArray(scan)^[best_len-1]; { fix }
{$else}
strend := pBytef(@(s.window^[s.strstart + MAX_MATCH]));
{$IFOPT R+} {$R-} {$DEFINE NoRangeCheck} {$ENDIF}
scan_end1 := pzByteArray(scan)^[best_len-1];
{$IFDEF NoRangeCheck} {$R+} {$UNDEF NoRangeCheck} {$ENDIF}
scan_end := pzByteArray(scan)^[best_len];
{$endif}
{ The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16.
It is easy to get rid of this optimization if necessary. }
{$IFDEF DEBUG}
Assert((s.hash_bits >= 8) and (MAX_MATCH = 258), 'Code too clever');
{$ENDIF}
{ Do not waste too much time if we already have a good match: }
if (s.prev_length >= s.good_match) then
begin
chain_length := chain_length shr 2;
end;
{ Do not look for matches beyond the end of the input. This is necessary
to make deflate deterministic. }
if (uInt(nice_match) > s.lookahead) then
nice_match := s.lookahead;
{$IFDEF DEBUG}
Assert(ulg(s.strstart) <= s.window_size-MIN_LOOKAHEAD, 'need lookahead');
{$ENDIF}
repeat
{$IFDEF DEBUG}
Assert(cur_match < s.strstart, 'no future');
{$ENDIF}
match := @(s.window^[cur_match]);
{ Skip to next match if the match length cannot increase
or if the match length is less than 2: }
{$undef DO_UNALIGNED_OK}
{$ifdef UNALIGNED_OK}
{$ifdef MAX_MATCH_IS_258}
{$define DO_UNALIGNED_OK}
{$endif}
{$endif}
{$ifdef DO_UNALIGNED_OK}
{ This code assumes sizeof(unsigned short) = 2. Do not use
UNALIGNED_OK if your compiler uses a different size. }
{$IFOPT R+} {$R-} {$DEFINE NoRangeCheck} {$ENDIF}
if (pushfArray(match)^[best_len-1] <> scan_end) or
(pushf(match)^ <> scan_start) then
goto nextstep; {continue;}
{$IFDEF NoRangeCheck} {$R+} {$UNDEF NoRangeCheck} {$ENDIF}
{ It is not necessary to compare scan[2] and match[2] since they are
always equal when the other bytes match, given that the hash keys
are equal and that HASH_BITS >= 8. Compare 2 bytes at a time at
strstart+3, +5, ... up to strstart+257. We check for insufficient
lookahead only every 4th comparison; the 128th check will be made
at strstart+257. If MAX_MATCH-2 is not a multiple of 8, it is
necessary to put more guard bytes at the end of the window, or
to check more often for insufficient lookahead. }
{$IFDEF DEBUG}
Assert(pzByteArray(scan)^[2] = pzByteArray(match)^[2], 'scan[2]?');
{$ENDIF}
Inc(scan);
Inc(match);
repeat
Inc(scan,2); Inc(match,2); if (pushf(scan)^<>pushf(match)^) then break;
Inc(scan,2); Inc(match,2); if (pushf(scan)^<>pushf(match)^) then break;
Inc(scan,2); Inc(match,2); if (pushf(scan)^<>pushf(match)^) then break;
Inc(scan,2); Inc(match,2); if (pushf(scan)^<>pushf(match)^) then break;
until (ptr2int(scan) >= ptr2int(strend));
{ The funny "do while" generates better code on most compilers }
{ Here, scan <= window+strstart+257 }
{$IFDEF DEBUG}
Assert(ptr2int(scan) <=
ptr2int(@(s.window^[unsigned(s.window_size-1)])),
'wild scan');
{$ENDIF}
if (scan^ = match^) then
Inc(scan);
len := (MAX_MATCH - 1) - int(ptr2int(strend)-ptr2int(scan));
scan := strend;
Dec(scan, (MAX_MATCH-1));
{$else} { UNALIGNED_OK }
{$IFOPT R+} {$R-} {$DEFINE NoRangeCheck} {$ENDIF}
if (pzByteArray(match)^[best_len] <> scan_end) or
(pzByteArray(match)^[best_len-1] <> scan_end1) or
(match^ <> scan^) then
goto nextstep; {continue;}
{$IFDEF NoRangeCheck} {$R+} {$UNDEF NoRangeCheck} {$ENDIF}
Inc(match);
if (match^ <> pzByteArray(scan)^[1]) then
goto nextstep; {continue;}
{ The check at best_len-1 can be removed because it will be made
again later. (This heuristic is not always a win.)
It is not necessary to compare scan[2] and match[2] since they
are always equal when the other bytes match, given that
the hash keys are equal and that HASH_BITS >= 8. }
Inc(scan, 2);
Inc(match);
{$IFDEF DEBUG}
Assert( scan^ = match^, 'match[2]?');
{$ENDIF}
{ We check for insufficient lookahead only every 8th comparison;
the 256th check will be made at strstart+258. }
repeat
Inc(scan); Inc(match); if (scan^ <> match^) then break;
Inc(scan); Inc(match); if (scan^ <> match^) then break;
Inc(scan); Inc(match); if (scan^ <> match^) then break;
Inc(scan); Inc(match); if (scan^ <> match^) then break;
Inc(scan); Inc(match); if (scan^ <> match^) then break;
Inc(scan); Inc(match); if (scan^ <> match^) then break;
Inc(scan); Inc(match); if (scan^ <> match^) then break;
Inc(scan); Inc(match); if (scan^ <> match^) then break;
until (ptr2int(scan) >= ptr2int(strend));
{$IFDEF DEBUG}
Assert(ptr2int(scan) <=
ptr2int(@(s.window^[unsigned(s.window_size-1)])),
'wild scan');
{$ENDIF}
len := MAX_MATCH - int(ptr2int(strend) - ptr2int(scan));
scan := strend;
Dec(scan, MAX_MATCH);
{$endif} { UNALIGNED_OK }
if (len > best_len) then
begin