aksdb/CentrED
1
0
Fork 0
Code Issues 2 Pull Requests Releases Wiki Activity

- Initial import from internal repository

Browse Source
This commit is contained in:
Andreas Schneider
2007-12-21 21:31:58 +01:00
commit c0a125042b
194 changed files with 86503 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

520
Imaging/ZLib/dzlib.pas Normal file
View File

@@ -0,0 +1,520 @@
{*******************************************************}
{ }
{ Delphi Supplemental Components }
{ ZLIB Data Compression Interface Unit }
{ }
{ Copyright (c) 1997 Borland International }
{ Copyright (c) 1998 Jacques Nomssi Nzali }
{ }
{*******************************************************}
{
Modified for
Vampyre Imaging Library
by Marek Mauder
http://imaginglib.sourceforge.net
You can choose which pascal zlib implementation will be
used. IMPASZLIB and FPCPASZLIB are translations of zlib
to pascal so they don't need any *.obj files.
The others are interfaces to *.obj files (Windows) or
*.so libraries (Linux).
Default implementation is IMPASZLIB because it can be compiled
by all supported compilers and works on all supported platforms.
I usually use implementation with the fastest decompression
when building release Win32 binaries.
FPCPASZLIB is useful for Lazarus applications. FPC's zlib is linked
to exe by default so there is no need to link additional (and almost identical)
IMPASZLIB.
There is a small speed comparison table of some of the
supported implementations (TGA image 28 311 570 bytes, compression level = 6,
Delphi 9, Win32, Athlon XP 1900).
ZLib version Decompression Compression Comp. Size
IMPASZLIB | 1.1.2 | 824 ms | 4 280 ms | 18 760 133 B
ZLIBEX | 1.2.2 | 710 ms | 1 590 ms* | 19 056 621 B
DELPHIZLIB | 1.0.4 | 976 ms | 9 190 ms | 18 365 562 B
ZLIBPAS | 1.2.3 | 680 ms | 3 790 ms | 18 365 387 B
* obj files are compiled with compression level hardcoded to 1 (fastest)
}
unit dzlib;
{$I ImagingOptions.inc}
interface
{ $DEFINE ZLIBEX}
{ $DEFINE DELPHIZLIB}
{ $DEFINE ZLIBPAS}
{$DEFINE IMPASZLIB}
{ $DEFINE FPCPASZLIB}
{ Automatically use FPC's PasZLib when compiling with Lazarus.}
{$IFDEF LCL}
{$UNDEF IMPASZLIB}
{$DEFINE FPCPASZLIB}
{$ENDIF}
uses
{$IF Defined(ZLIBEX)}
{ Use ZlibEx unit.}
ZLibEx,
{$ELSEIF Defined(DELPHIZLIB)}
{ Use ZLib unit shipped with Delphi.}
ZLib,
{$ELSEIF Defined(ZLIBPAS)}
{ Pascal interface to ZLib shipped with ZLib C source.}
zlibpas,
{$ELSEIF Defined(IMPASZLIB)}
{ Use paszlib modified by me for Delphi and FPC.}
imzdeflate, imzinflate, impaszlib,
{$ELSEIF Defined(FPCPASZLIB)}
{ Use FPC's paszlib.}
zbase, paszlib,
{$IFEND}
SysUtils, Classes;
{$IF Defined(IMPASZLIB) or Defined(FPCPASZLIB) or Defined(ZLIBPAS)}
type
TZStreamRec = z_stream;
{$IFEND}
{$IFDEF ZLIBEX}
const
Z_NO_FLUSH = 0;
Z_PARTIAL_FLUSH = 1;
Z_SYNC_FLUSH = 2;
Z_FULL_FLUSH = 3;
Z_FINISH = 4;
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;
Z_NO_COMPRESSION = 0;
Z_BEST_SPEED = 1;
Z_BEST_COMPRESSION = 9;
Z_DEFAULT_COMPRESSION = -1;
Z_FILTERED = 1;
Z_HUFFMAN_ONLY = 2;
Z_RLE = 3;
Z_DEFAULT_STRATEGY = 0;
Z_BINARY = 0;
Z_ASCII = 1;
Z_UNKNOWN = 2;
Z_DEFLATED = 8;
{$ENDIF}
type
{ Abstract ancestor class }
TCustomZlibStream = class(TStream)
private
FStrm: TStream;
FStrmPos: Integer;
FOnProgress: TNotifyEvent;
FZRec: TZStreamRec;
FBuffer: array [Word] of Char;
protected
procedure Progress(Sender: TObject); dynamic;
property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
constructor Create(Strm: TStream);
end;
{ TCompressionStream compresses data on the fly as data is written to it, and
stores the compressed data to another stream.
TCompressionStream is write-only and strictly sequential. Reading from the
stream will raise an exception. Using Seek to move the stream pointer
will raise an exception.
Output data is cached internally, written to the output stream only when
the internal output buffer is full. All pending output data is flushed
when the stream is destroyed.
The Position property returns the number of uncompressed bytes of
data that have been written to the stream so far.
CompressionRate returns the on-the-fly percentage by which the original
data has been compressed: (1 - (CompressedBytes / UncompressedBytes)) * 100
If raw data size = 100 and compressed data size = 25, the CompressionRate
is 75%
The OnProgress event is called each time the output buffer is filled and
written to the output stream. This is useful for updating a progress
indicator when you are writing a large chunk of data to the compression
stream in a single call.}
TCompressionLevel = (clNone, clFastest, clDefault, clMax);
TCompressionStream = class(TCustomZlibStream)
private
function GetCompressionRate: Single;
public
constructor Create(CompressionLevel: TCompressionLevel; Dest: TStream);
destructor Destroy; override;
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
function Seek(Offset: Longint; Origin: Word): Longint; override;
property CompressionRate: Single read GetCompressionRate;
property OnProgress;
end;
{ TDecompressionStream decompresses data on the fly as data is read from it.
Compressed data comes from a separate source stream. TDecompressionStream
is read-only and unidirectional; you can seek forward in the stream, but not
backwards. The special case of setting the stream position to zero is
allowed. Seeking forward decompresses data until the requested position in
the uncompressed data has been reached. Seeking backwards, seeking relative
to the end of the stream, requesting the size of the stream, and writing to
the stream will raise an exception.
The Position property returns the number of bytes of uncompressed data that
have been read from the stream so far.
The OnProgress event is called each time the internal input buffer of
compressed data is exhausted and the next block is read from the input stream.
This is useful for updating a progress indicator when you are reading a
large chunk of data from the decompression stream in a single call.}
TDecompressionStream = class(TCustomZlibStream)
public
constructor Create(Source: TStream);
destructor Destroy; override;
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
function Seek(Offset: Longint; Origin: Word): Longint; override;
property OnProgress;
end;
{ CompressBuf compresses data, buffer to buffer, in one call.
In: InBuf = ptr to compressed data
InBytes = number of bytes in InBuf
Out: OutBuf = ptr to newly allocated buffer containing decompressed data
OutBytes = number of bytes in OutBuf }
procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
var OutBuf: Pointer; var OutBytes: Integer;
CompressLevel: Integer = Z_DEFAULT_COMPRESSION);
{ DecompressBuf decompresses data, buffer to buffer, in one call.
In: InBuf = ptr to compressed data
InBytes = number of bytes in InBuf
OutEstimate = zero, or est. size of the decompressed data
Out: OutBuf = ptr to newly allocated buffer containing decompressed data
OutBytes = number of bytes in OutBuf }
procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
OutEstimate: Integer; var OutBuf: Pointer; var OutBytes: Integer);
type
EZlibError = class(Exception);
ECompressionError = class(EZlibError);
EDecompressionError = class(EZlibError);
implementation
const
ZErrorMessages: array[0..9] of PChar = (
'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)
'');
function zlibAllocMem(AppData: Pointer; Items, Size: Cardinal): Pointer;
begin
GetMem(Result, Items*Size);
end;
procedure zlibFreeMem(AppData, Block: Pointer);
begin
FreeMem(Block);
end;
function CCheck(code: Integer): Integer;
begin
Result := code;
if code < 0 then
raise ECompressionError.Create('zlib: ' + ZErrorMessages[2 - code]);
end;
function DCheck(code: Integer): Integer;
begin
Result := code;
if code < 0 then
raise EDecompressionError.Create('zlib: ' + ZErrorMessages[2 - code]);
end;
procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
var OutBuf: Pointer; var OutBytes: Integer;
CompressLevel: Integer);
var
strm: TZStreamRec;
P: Pointer;
begin
FillChar(strm, sizeof(strm), 0);
{$IFNDEF FPCPASZLIB}
strm.zalloc := @zlibAllocMem;
strm.zfree := @zlibFreeMem;
{$ENDIF}
OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255;
GetMem(OutBuf, OutBytes);
try
strm.next_in := InBuf;
strm.avail_in := InBytes;
strm.next_out := OutBuf;
strm.avail_out := OutBytes;
CCheck(deflateInit_(strm, CompressLevel, zlib_version, sizeof(strm)));
try
while CCheck(deflate(strm, Z_FINISH)) <> Z_STREAM_END do
begin
P := OutBuf;
Inc(OutBytes, 256);
ReallocMem(OutBuf, OutBytes);
strm.next_out := Pointer(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
strm.avail_out := 256;
end;
finally
CCheck(deflateEnd(strm));
end;
ReallocMem(OutBuf, strm.total_out);
OutBytes := strm.total_out;
except
zlibFreeMem(nil, OutBuf);
raise
end;
end;
procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
OutEstimate: Integer; var OutBuf: Pointer; var OutBytes: Integer);
var
strm: TZStreamRec;
P: Pointer;
BufInc: Integer;
begin
FillChar(strm, sizeof(strm), 0);
{$IFNDEF FPCPASZLIB}
strm.zalloc := @zlibAllocMem;
strm.zfree := @zlibFreeMem;
{$ENDIF}
BufInc := (InBytes + 255) and not 255;
if OutEstimate = 0 then
OutBytes := BufInc
else
OutBytes := OutEstimate;
GetMem(OutBuf, OutBytes);
try
strm.next_in := InBuf;
strm.avail_in := InBytes;
strm.next_out := OutBuf;
strm.avail_out := OutBytes;
DCheck(inflateInit_(strm, zlib_version, sizeof(strm)));
try
while DCheck(inflate(strm, Z_NO_FLUSH)) <> Z_STREAM_END do
begin
P := OutBuf;
Inc(OutBytes, BufInc);
ReallocMem(OutBuf, OutBytes);
strm.next_out := Pointer(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
strm.avail_out := BufInc;
end;
finally
DCheck(inflateEnd(strm));
end;
ReallocMem(OutBuf, strm.total_out);
OutBytes := strm.total_out;
except
zlibFreeMem(nil, OutBuf);
raise
end;
end;
{ TCustomZlibStream }
constructor TCustomZLibStream.Create(Strm: TStream);
begin
inherited Create;
FStrm := Strm;
FStrmPos := Strm.Position;
{$IFNDEF FPCPASZLIB}
FZRec.zalloc := @zlibAllocMem;
FZRec.zfree := @zlibFreeMem;
{$ENDIF}
end;
procedure TCustomZLibStream.Progress(Sender: TObject);
begin
if Assigned(FOnProgress) then FOnProgress(Sender);
end;
{ TCompressionStream }
constructor TCompressionStream.Create(CompressionLevel: TCompressionLevel;
Dest: TStream);
const
Levels: array [TCompressionLevel] of ShortInt =
(Z_NO_COMPRESSION, Z_BEST_SPEED, Z_DEFAULT_COMPRESSION, Z_BEST_COMPRESSION);
begin
inherited Create(Dest);
FZRec.next_out := @FBuffer;
FZRec.avail_out := sizeof(FBuffer);
CCheck(deflateInit_(FZRec, Levels[CompressionLevel], zlib_version, sizeof(FZRec)));
end;
destructor TCompressionStream.Destroy;
begin
FZRec.next_in := nil;
FZRec.avail_in := 0;
try
if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
while (CCheck(deflate(FZRec, Z_FINISH)) <> Z_STREAM_END)
and (FZRec.avail_out = 0) do
begin
FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
FZRec.next_out := @FBuffer;
FZRec.avail_out := sizeof(FBuffer);
end;
if FZRec.avail_out < sizeof(FBuffer) then
FStrm.WriteBuffer(FBuffer, sizeof(FBuffer) - FZRec.avail_out);
finally
deflateEnd(FZRec);
end;
inherited Destroy;
end;
function TCompressionStream.Read(var Buffer; Count: Longint): Longint;
begin
raise ECompressionError.Create('Invalid stream operation');
end;
function TCompressionStream.Write(const Buffer; Count: Longint): Longint;
begin
FZRec.next_in := @Buffer;
FZRec.avail_in := Count;
if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
while (FZRec.avail_in > 0) do
begin
CCheck(deflate(FZRec, 0));
if FZRec.avail_out = 0 then
begin
FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
FZRec.next_out := @FBuffer;
FZRec.avail_out := sizeof(FBuffer);
FStrmPos := FStrm.Position;
Progress(Self);
end;
end;
Result := Count;
end;
function TCompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
if (Offset = 0) and (Origin = soFromCurrent) then
Result := FZRec.total_in
else
raise ECompressionError.Create('Invalid stream operation');
end;
function TCompressionStream.GetCompressionRate: Single;
begin
if FZRec.total_in = 0 then
Result := 0
else
Result := (1.0 - (FZRec.total_out / FZRec.total_in)) * 100.0;
end;
{ TDecompressionStream }
constructor TDecompressionStream.Create(Source: TStream);
begin
inherited Create(Source);
FZRec.next_in := @FBuffer;
FZRec.avail_in := 0;
DCheck(inflateInit_(FZRec, zlib_version, sizeof(FZRec)));
end;
destructor TDecompressionStream.Destroy;
begin
inflateEnd(FZRec);
inherited Destroy;
end;
function TDecompressionStream.Read(var Buffer; Count: Longint): Longint;
begin
FZRec.next_out := @Buffer;
FZRec.avail_out := Count;
if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
while (FZRec.avail_out > 0) do
begin
if FZRec.avail_in = 0 then
begin
FZRec.avail_in := FStrm.Read(FBuffer, sizeof(FBuffer));
if FZRec.avail_in = 0 then
begin
Result := Count - Integer(FZRec.avail_out);
Exit;
end;
FZRec.next_in := @FBuffer;
FStrmPos := FStrm.Position;
Progress(Self);
end;
CCheck(inflate(FZRec, 0));
end;
Result := Count;
end;
function TDecompressionStream.Write(const Buffer; Count: Longint): Longint;
begin
raise EDecompressionError.Create('Invalid stream operation');
end;
function TDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
var
I: Integer;
Buf: array [0..4095] of Char;
begin
if (Offset = 0) and (Origin = soFromBeginning) then
begin
DCheck(inflateReset(FZRec));
FZRec.next_in := @FBuffer;
FZRec.avail_in := 0;
FStrm.Position := 0;
FStrmPos := 0;
end
else if ( (Offset >= 0) and (Origin = soFromCurrent)) or
( ((Offset - Integer(FZRec.total_out)) > 0) and (Origin = soFromBeginning)) then
begin
if Origin = soFromBeginning then Dec(Offset, FZRec.total_out);
if Offset > 0 then
begin
for I := 1 to Offset div sizeof(Buf) do
ReadBuffer(Buf, sizeof(Buf));
ReadBuffer(Buf, Offset mod sizeof(Buf));
end;
end
else
raise EDecompressionError.Create('Invalid stream operation');
Result := FZRec.total_out;
end;
end.

114
Imaging/ZLib/imadler.pas Normal file
View File

@@ -0,0 +1,114 @@
Unit imadler;
{
adler32.c -- compute the Adler-32 checksum of a data stream
Copyright (C) 1995-1998 Mark Adler
Pascal tranlastion
Copyright (C) 1998 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt
}
interface
{$I imzconf.inc}
uses
imzutil;
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;
}
implementation
const
BASE = uLong(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 >= 16) do
begin
DO16(buf);
Inc(buf, 16);
Dec(k, 16);
end;
if (k <> 0) then
repeat
Inc(s1, buf^);
Inc(puf);
Inc(s2, s1);
Dec(k);
until (k = 0);
}
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;
{
#define DO1(buf,i)
begin
Inc(s1, buf[i]);
Inc(s2, s1);
end;
#define DO2(buf,i) DO1(buf,i); DO1(buf,i+1);
#define DO4(buf,i) DO2(buf,i); DO2(buf,i+2);
#define DO8(buf,i) DO4(buf,i); DO4(buf,i+4);
#define DO16(buf) DO8(buf,0); DO8(buf,8);
}
end.

951
Imaging/ZLib/iminfblock.pas Normal file
View File

@@ -0,0 +1,951 @@
Unit iminfblock;
{ infblock.h and
infblock.c -- interpret and process block types to last block
Copyright (C) 1995-1998 Mark Adler
Pascal tranlastion
Copyright (C) 1998 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt
}
interface
{$I imzconf.inc}
uses
{$IFDEF DEBUG}
SysUtils, strutils,
{$ENDIF}
imzutil, impaszlib;
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;
implementation
uses
iminfcodes, iminftrees, iminfutil;
{ Tables for deflate from PKZIP's appnote.txt. }
Const
border : Array [0..18] Of Word { Order of the bit length code lengths }
= (16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15);
{ Notes beyond the 1.93a appnote.txt:
1. Distance pointers never point before the beginning of the output
stream.
2. Distance pointers can point back across blocks, up to 32k away.
3. There is an implied maximum of 7 bits for the bit length table and
15 bits for the actual data.
4. If only one code exists, then it is encoded using one bit. (Zero
would be more efficient, but perhaps a little confusing.) If two
codes exist, they are coded using one bit each (0 and 1).
5. There is no way of sending zero distance codes--a dummy must be
sent if there are none. (History: a pre 2.0 version of PKZIP would
store blocks with no distance codes, but this was discovered to be
too harsh a criterion.) Valid only for 1.93a. 2.04c does allow
zero distance codes, which is sent as one code of zero bits in
length.
6. There are up to 286 literal/length codes. Code 256 represents the
end-of-block. Note however that the static length tree defines
288 codes just to fill out the Huffman codes. Codes 286 and 287
cannot be used though, since there is no length base or extra bits
defined for them. Similarily, there are up to 30 distance codes.
However, static trees define 32 codes (all 5 bits) to fill out the
Huffman codes, but the last two had better not show up in the data.
7. Unzip can check dynamic Huffman blocks for complete code sets.
The exception is that a single code would not be complete (see #4).
8. The five bits following the block type is really the number of
literal codes sent minus 257.
9. Length codes 8,16,16 are interpreted as 13 length codes of 8 bits
(1+6+6). Therefore, to output three times the length, you output
three codes (1+1+1), whereas to output four times the same length,
you only need two codes (1+3). Hmm.
10. In the tree reconstruction algorithm, Code = Code + Increment
only if BitLength(i) is not zero. (Pretty obvious.)
11. Correction: 4 Bits: # of Bit Length codes - 4 (4 - 19)
12. Note: length code 284 can represent 227-258, but length code 285
really is 258. The last length deserves its own, short code
since it gets used a lot in very redundant files. The length
258 is special since 258 - 3 (the min match length) is 255.
13. The literal/length and distance code bit lengths are read as a
single stream of lengths. It is possible (and advantageous) for
a repeat code (16, 17, or 18) to go across the boundary between
the two sets of lengths. }
procedure inflate_blocks_reset (var s : inflate_blocks_state;
var z : z_stream;
c : puLong); { check value on output }
begin
if (c <> Z_NULL) then
c^ := s.check;
if (s.mode = BTREE) or (s.mode = DTREE) then
ZFREE(z, s.sub.trees.blens);
if (s.mode = CODES) then
inflate_codes_free(s.sub.decode.codes, z);
s.mode := ZTYPE;
s.bitk := 0;
s.bitb := 0;
s.write := s.window;
s.read := s.window;
if Assigned(s.checkfn) then
begin
s.check := s.checkfn(uLong(0), pBytef(NIL), 0);
z.adler := s.check;
end;
{$IFDEF DEBUG}
Tracev('inflate: blocks reset');
{$ENDIF}
end;
function inflate_blocks_new(var z : z_stream;
c : check_func; { check function }
w : uInt { window size }
) : pInflate_blocks_state;
var
s : pInflate_blocks_state;
begin
s := pInflate_blocks_state( ZALLOC(z,1, sizeof(inflate_blocks_state)) );
if (s = Z_NULL) then
begin
inflate_blocks_new := s;
exit;
end;
s^.hufts := huft_ptr( ZALLOC(z, sizeof(inflate_huft), MANY) );
if (s^.hufts = Z_NULL) then
begin
ZFREE(z, s);
inflate_blocks_new := Z_NULL;
exit;
end;
s^.window := pBytef( ZALLOC(z, 1, w) );
if (s^.window = Z_NULL) then
begin
ZFREE(z, s^.hufts);
ZFREE(z, s);
inflate_blocks_new := Z_NULL;
exit;
end;
s^.zend := s^.window;
Inc(s^.zend, w);
s^.checkfn := c;
s^.mode := ZTYPE;
{$IFDEF DEBUG}
Tracev('inflate: blocks allocated');
{$ENDIF}
inflate_blocks_reset(s^, z, Z_NULL);
inflate_blocks_new := s;
end;
function inflate_blocks (var s : inflate_blocks_state;
var z : z_stream;
r : int) : int; { initial return code }
label
start_btree, start_dtree,
start_blkdone, start_dry,
start_codes;
var
t : uInt; { temporary storage }
b : uLong; { bit buffer }
k : uInt; { bits in bit buffer }
p : pBytef; { input data pointer }
n : uInt; { bytes available there }
q : pBytef; { output window write pointer }
m : uInt; { bytes to end of window or read pointer }
{ fixed code blocks }
var
bl, bd : uInt;
tl, td : pInflate_huft;
var
h : pInflate_huft;
i, j, c : uInt;
var
cs : pInflate_codes_state;
begin
{ copy input/output information to locals }
p := z.next_in;
n := z.avail_in;
b := s.bitb;
k := s.bitk;
q := s.write;
if ptr2int(q) < ptr2int(s.read) then
m := uInt(ptr2int(s.read)-ptr2int(q)-1)
else
m := uInt(ptr2int(s.zend)-ptr2int(q));
{ decompress an inflated block }
{ process input based on current state }
while True do
Case s.mode of
ZTYPE:
begin
{NEEDBITS(3);}
while (k < 3) do
begin
{NEEDBYTE;}
if (n <> 0) then
r :=Z_OK
else
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
Dec(n);
b := b or (uLong(p^) shl k);
Inc(p);
Inc(k, 8);
end;
t := uInt(b) and 7;
s.last := boolean(t and 1);
case (t shr 1) of
0: { stored }
begin
{$IFDEF DEBUG}
if s.last then
Tracev('inflate: stored block (last)')
else
Tracev('inflate: stored block');
{$ENDIF}
{DUMPBITS(3);}
b := b shr 3;
Dec(k, 3);
t := k and 7; { go to byte boundary }
{DUMPBITS(t);}
b := b shr t;
Dec(k, t);
s.mode := LENS; { get length of stored block }
end;
1: { fixed }
begin
begin
{$IFDEF DEBUG}
if s.last then
Tracev('inflate: fixed codes blocks (last)')
else
Tracev('inflate: fixed codes blocks');
{$ENDIF}
inflate_trees_fixed(bl, bd, tl, td, z);
s.sub.decode.codes := inflate_codes_new(bl, bd, tl, td, z);
if (s.sub.decode.codes = Z_NULL) then
begin
r := Z_MEM_ERROR;
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
end;
{DUMPBITS(3);}
b := b shr 3;
Dec(k, 3);
s.mode := CODES;
end;
2: { dynamic }
begin
{$IFDEF DEBUG}
if s.last then
Tracev('inflate: dynamic codes block (last)')
else
Tracev('inflate: dynamic codes block');
{$ENDIF}
{DUMPBITS(3);}
b := b shr 3;
Dec(k, 3);
s.mode := TABLE;
end;
3:
begin { illegal }
{DUMPBITS(3);}
b := b shr 3;
Dec(k, 3);
s.mode := BLKBAD;
z.msg := 'invalid block type';
r := Z_DATA_ERROR;
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
end;
end;
LENS:
begin
{NEEDBITS(32);}
while (k < 32) do
begin
{NEEDBYTE;}
if (n <> 0) then
r :=Z_OK
else
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
Dec(n);
b := b or (uLong(p^) shl k);
Inc(p);
Inc(k, 8);
end;
if (((not b) shr 16) and $ffff) <> (b and $ffff) then
begin
s.mode := BLKBAD;
z.msg := 'invalid stored block lengths';
r := Z_DATA_ERROR;
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
s.sub.left := uInt(b) and $ffff;
k := 0;
b := 0; { dump bits }
{$IFDEF DEBUG}
Tracev('inflate: stored length '+IntToStr(s.sub.left));
{$ENDIF}
if s.sub.left <> 0 then
s.mode := STORED
else
if s.last then
s.mode := DRY
else
s.mode := ZTYPE;
end;
STORED:
begin
if (n = 0) then
begin
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
{NEEDOUT}
if (m = 0) then
begin
{WRAP}
if (q = s.zend) and (s.read <> s.window) then
begin
q := s.window;
if ptr2int(q) < ptr2int(s.read) then
m := uInt(ptr2int(s.read)-ptr2int(q)-1)
else
m := uInt(ptr2int(s.zend)-ptr2int(q));
end;
if (m = 0) then
begin
{FLUSH}
s.write := q;
r := inflate_flush(s,z,r);
q := s.write;
if ptr2int(q) < ptr2int(s.read) then
m := uInt(ptr2int(s.read)-ptr2int(q)-1)
else
m := uInt(ptr2int(s.zend)-ptr2int(q));
{WRAP}
if (q = s.zend) and (s.read <> s.window) then
begin
q := s.window;
if ptr2int(q) < ptr2int(s.read) then
m := uInt(ptr2int(s.read)-ptr2int(q)-1)
else
m := uInt(ptr2int(s.zend)-ptr2int(q));
end;
if (m = 0) then
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
end;
end;
r := Z_OK;
t := s.sub.left;
if (t > n) then
t := n;
if (t > m) then
t := m;
zmemcpy(q, p, t);
Inc(p, t); Dec(n, t);
Inc(q, t); Dec(m, t);
Dec(s.sub.left, t);
if (s.sub.left = 0) then
begin
{$IFDEF DEBUG}
if (ptr2int(q) >= ptr2int(s.read)) then
Tracev('inflate: stored end '+
IntToStr(z.total_out + ptr2int(q) - ptr2int(s.read)) + ' total out')
else
Tracev('inflate: stored end '+
IntToStr(z.total_out + ptr2int(s.zend) - ptr2int(s.read) +
ptr2int(q) - ptr2int(s.window)) + ' total out');
{$ENDIF}
if s.last then
s.mode := DRY
else
s.mode := ZTYPE;
end;
end;
TABLE:
begin
{NEEDBITS(14);}
while (k < 14) do
begin
{NEEDBYTE;}
if (n <> 0) then
r :=Z_OK
else
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
Dec(n);
b := b or (uLong(p^) shl k);
Inc(p);
Inc(k, 8);
end;
t := uInt(b) and $3fff;
s.sub.trees.table := t;
{$ifndef PKZIP_BUG_WORKAROUND}
if ((t and $1f) > 29) or (((t shr 5) and $1f) > 29) then
begin
s.mode := BLKBAD;
z.msg := 'too many length or distance symbols';
r := Z_DATA_ERROR;
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
{$endif}
t := 258 + (t and $1f) + ((t shr 5) and $1f);
s.sub.trees.blens := puIntArray( ZALLOC(z, t, sizeof(uInt)) );
if (s.sub.trees.blens = Z_NULL) then
begin
r := Z_MEM_ERROR;
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
{DUMPBITS(14);}
b := b shr 14;
Dec(k, 14);
s.sub.trees.index := 0;
{$IFDEF DEBUG}
Tracev('inflate: table sizes ok');
{$ENDIF}
s.mode := BTREE;
{ fall trough case is handled by the while }
{ try GOTO for speed - Nomssi }
goto start_btree;
end;
BTREE:
begin
start_btree:
while (s.sub.trees.index < 4 + (s.sub.trees.table shr 10)) do
begin
{NEEDBITS(3);}
while (k < 3) do
begin
{NEEDBYTE;}
if (n <> 0) then
r :=Z_OK
else
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
Dec(n);
b := b or (uLong(p^) shl k);
Inc(p);
Inc(k, 8);
end;
s.sub.trees.blens^[border[s.sub.trees.index]] := uInt(b) and 7;
Inc(s.sub.trees.index);
{DUMPBITS(3);}
b := b shr 3;
Dec(k, 3);
end;
while (s.sub.trees.index < 19) do
begin
s.sub.trees.blens^[border[s.sub.trees.index]] := 0;
Inc(s.sub.trees.index);
end;
s.sub.trees.bb := 7;
t := inflate_trees_bits(s.sub.trees.blens^, s.sub.trees.bb,
s.sub.trees.tb, s.hufts^, z);
if (t <> Z_OK) then
begin
ZFREE(z, s.sub.trees.blens);
r := t;
if (r = Z_DATA_ERROR) then
s.mode := BLKBAD;
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
s.sub.trees.index := 0;
{$IFDEF DEBUG}
Tracev('inflate: bits tree ok');
{$ENDIF}
s.mode := DTREE;
{ fall through again }
goto start_dtree;
end;
DTREE:
begin
start_dtree:
while TRUE do
begin
t := s.sub.trees.table;
if not (s.sub.trees.index < 258 +
(t and $1f) + ((t shr 5) and $1f)) then
break;
t := s.sub.trees.bb;
{NEEDBITS(t);}
while (k < t) do
begin
{NEEDBYTE;}
if (n <> 0) then
r :=Z_OK
else
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
Dec(n);
b := b or (uLong(p^) shl k);
Inc(p);
Inc(k, 8);
end;
h := s.sub.trees.tb;
Inc(h, uInt(b) and inflate_mask[t]);
t := h^.Bits;
c := h^.Base;
if (c < 16) then
begin
{DUMPBITS(t);}
b := b shr t;
Dec(k, t);
s.sub.trees.blens^[s.sub.trees.index] := c;
Inc(s.sub.trees.index);
end
else { c = 16..18 }
begin
if c = 18 then
begin
i := 7;
j := 11;
end
else
begin
i := c - 14;
j := 3;
end;
{NEEDBITS(t + i);}
while (k < t + i) do
begin
{NEEDBYTE;}
if (n <> 0) then
r :=Z_OK
else
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
Dec(n);
b := b or (uLong(p^) shl k);
Inc(p);
Inc(k, 8);
end;
{DUMPBITS(t);}
b := b shr t;
Dec(k, t);
Inc(j, uInt(b) and inflate_mask[i]);
{DUMPBITS(i);}
b := b shr i;
Dec(k, i);
i := s.sub.trees.index;
t := s.sub.trees.table;
if (i + j > 258 + (t and $1f) + ((t shr 5) and $1f)) or
((c = 16) and (i < 1)) then
begin
ZFREE(z, s.sub.trees.blens);
s.mode := BLKBAD;
z.msg := 'invalid bit length repeat';
r := Z_DATA_ERROR;
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
if c = 16 then
c := s.sub.trees.blens^[i - 1]
else
c := 0;
repeat
s.sub.trees.blens^[i] := c;
Inc(i);
Dec(j);
until (j=0);
s.sub.trees.index := i;
end;
end; { while }
s.sub.trees.tb := Z_NULL;
begin
bl := 9; { must be <= 9 for lookahead assumptions }
bd := 6; { must be <= 9 for lookahead assumptions }
t := s.sub.trees.table;
t := inflate_trees_dynamic(257 + (t and $1f),
1 + ((t shr 5) and $1f),
s.sub.trees.blens^, bl, bd, tl, td, s.hufts^, z);
ZFREE(z, s.sub.trees.blens);
if (t <> Z_OK) then
begin
if (t = uInt(Z_DATA_ERROR)) then
s.mode := BLKBAD;
r := t;
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
{$IFDEF DEBUG}
Tracev('inflate: trees ok');
{$ENDIF}
{ c renamed to cs }
cs := inflate_codes_new(bl, bd, tl, td, z);
if (cs = Z_NULL) then
begin
r := Z_MEM_ERROR;
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
s.sub.decode.codes := cs;
end;
s.mode := CODES;
{ yet another falltrough }
goto start_codes;
end;
CODES:
begin
start_codes:
{ update pointers }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in));
z.next_in := p;
s.write := q;
r := inflate_codes(s, z, r);
if (r <> Z_STREAM_END) then
begin
inflate_blocks := inflate_flush(s, z, r);
exit;
end;
r := Z_OK;
inflate_codes_free(s.sub.decode.codes, z);
{ load local pointers }
p := z.next_in;
n := z.avail_in;
b := s.bitb;
k := s.bitk;
q := s.write;
if ptr2int(q) < ptr2int(s.read) then
m := uInt(ptr2int(s.read)-ptr2int(q)-1)
else
m := uInt(ptr2int(s.zend)-ptr2int(q));
{$IFDEF DEBUG}
if (ptr2int(q) >= ptr2int(s.read)) then
Tracev('inflate: codes end '+
IntToStr(z.total_out + ptr2int(q) - ptr2int(s.read)) + ' total out')
else
Tracev('inflate: codes end '+
IntToStr(z.total_out + ptr2int(s.zend) - ptr2int(s.read) +
ptr2int(q) - ptr2int(s.window)) + ' total out');
{$ENDIF}
if (not s.last) then
begin
s.mode := ZTYPE;
continue; { break for switch statement in C-code }
end;
{$ifndef patch112}
if (k > 7) then { return unused byte, if any }
begin
{$IFDEF DEBUG}
Assert(k < 16, 'inflate_codes grabbed too many bytes');
{$ENDIF}
Dec(k, 8);
Inc(n);
Dec(p); { can always return one }
end;
{$endif}
s.mode := DRY;
{ another falltrough }
goto start_dry;
end;
DRY:
begin
start_dry:
{FLUSH}
s.write := q;
r := inflate_flush(s,z,r);
q := s.write;
{ not needed anymore, we are done:
if ptr2int(q) < ptr2int(s.read) then
m := uInt(ptr2int(s.read)-ptr2int(q)-1)
else
m := uInt(ptr2int(s.zend)-ptr2int(q));
}
if (s.read <> s.write) then
begin
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
s.mode := BLKDONE;
goto start_blkdone;
end;
BLKDONE:
begin
start_blkdone:
r := Z_STREAM_END;
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
BLKBAD:
begin
r := Z_DATA_ERROR;
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
else
begin
r := Z_STREAM_ERROR;
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
end; { Case s.mode of }
end;
function inflate_blocks_free(s : pInflate_blocks_state;
var z : z_stream) : int;
begin
inflate_blocks_reset(s^, z, Z_NULL);
ZFREE(z, s^.window);
ZFREE(z, s^.hufts);
ZFREE(z, s);
{$IFDEF DEBUG}
Trace('inflate: blocks freed');
{$ENDIF}
inflate_blocks_free := Z_OK;
end;
procedure inflate_set_dictionary(var s : inflate_blocks_state;
const d : array of byte; { dictionary }
n : uInt); { dictionary length }
begin
zmemcpy(s.window, pBytef(@d), n);
s.write := s.window;
Inc(s.write, n);
s.read := s.write;
end;
{ Returns true if inflate is currently at the end of a block generated
by Z_SYNC_FLUSH or Z_FULL_FLUSH.
IN assertion: s <> Z_NULL }
function inflate_blocks_sync_point(var s : inflate_blocks_state) : int;
begin
inflate_blocks_sync_point := int(s.mode = LENS);
end;
end.

576
Imaging/ZLib/iminfcodes.pas Normal file
View File

@@ -0,0 +1,576 @@
Unit iminfcodes;
{ infcodes.c -- process literals and length/distance pairs
Copyright (C) 1995-1998 Mark Adler
Pascal tranlastion
Copyright (C) 1998 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt
}
interface
{$I imzconf.inc}
uses
{$IFDEF DEBUG}
SysUtils, strutils,
{$ENDIF}
imzutil, impaszlib;
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);
implementation
uses
iminfutil, iminffast;
function inflate_codes_new (bl : uInt;
bd : uInt;
tl : pInflate_huft;
td : pInflate_huft;
var z : z_stream): pInflate_codes_state;
var
c : pInflate_codes_state;
begin
c := pInflate_codes_state( ZALLOC(z,1,sizeof(inflate_codes_state)) );
if (c <> Z_NULL) then
begin
c^.mode := START;
c^.lbits := Byte(bl);
c^.dbits := Byte(bd);
c^.ltree := tl;
c^.dtree := td;
{$IFDEF DEBUG}
Tracev('inflate: codes new');
{$ENDIF}
end;
inflate_codes_new := c;
end;
function inflate_codes(var s : inflate_blocks_state;
var z : z_stream;
r : int) : int;
var
j : uInt; { temporary storage }
t : pInflate_huft; { temporary pointer }
e : uInt; { extra bits or operation }
b : uLong; { bit buffer }
k : uInt; { bits in bit buffer }
p : pBytef; { input data pointer }
n : uInt; { bytes available there }
q : pBytef; { output window write pointer }
m : uInt; { bytes to end of window or read pointer }
f : pBytef; { pointer to copy strings from }
var
c : pInflate_codes_state;
begin
c := s.sub.decode.codes; { codes state }
{ copy input/output information to locals }
p := z.next_in;
n := z.avail_in;
b := s.bitb;
k := s.bitk;
q := s.write;
if ptr2int(q) < ptr2int(s.read) then
m := uInt(ptr2int(s.read)-ptr2int(q)-1)
else
m := uInt(ptr2int(s.zend)-ptr2int(q));
{ process input and output based on current state }
while True do
case (c^.mode) of
{ waiting for "i:"=input, "o:"=output, "x:"=nothing }
START: { x: set up for LEN }
begin
{$ifndef SLOW}
if (m >= 258) and (n >= 10) then
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
r := inflate_fast(c^.lbits, c^.dbits, c^.ltree, c^.dtree, s, z);
{LOAD}
p := z.next_in;
n := z.avail_in;
b := s.bitb;
k := s.bitk;
q := s.write;
if ptr2int(q) < ptr2int(s.read) then
m := uInt(ptr2int(s.read)-ptr2int(q)-1)
else
m := uInt(ptr2int(s.zend)-ptr2int(q));
if (r <> Z_OK) then
begin
if (r = Z_STREAM_END) then
c^.mode := WASH
else
c^.mode := BADCODE;
continue; { break for switch-statement in C }
end;
end;
{$endif} { not SLOW }
c^.sub.code.need := c^.lbits;
c^.sub.code.tree := c^.ltree;
c^.mode := LEN; { falltrough }
end;
LEN: { i: get length/literal/eob next }
begin
j := c^.sub.code.need;
{NEEDBITS(j);}
while (k < j) do
begin
{NEEDBYTE;}
if (n <> 0) then
r :=Z_OK
else
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_codes := inflate_flush(s,z,r);
exit;
end;
Dec(n);
b := b or (uLong(p^) shl k);
Inc(p);
Inc(k, 8);
end;
t := c^.sub.code.tree;
Inc(t, uInt(b) and inflate_mask[j]);
{DUMPBITS(t^.bits);}
b := b shr t^.bits;
Dec(k, t^.bits);
e := uInt(t^.exop);
if (e = 0) then { literal }
begin
c^.sub.lit := t^.base;
{$IFDEF DEBUG}
if (t^.base >= $20) and (t^.base < $7f) then
Tracevv('inflate: literal '+char(t^.base))
else
Tracevv('inflate: literal '+IntToStr(t^.base));
{$ENDIF}
c^.mode := LIT;
continue; { break switch statement }
end;
if (e and 16 <> 0) then { length }
begin
c^.sub.copy.get := e and 15;
c^.len := t^.base;
c^.mode := LENEXT;
continue; { break C-switch statement }
end;
if (e and 64 = 0) then { next table }
begin
c^.sub.code.need := e;
c^.sub.code.tree := @huft_ptr(t)^[t^.base];
continue; { break C-switch statement }
end;
if (e and 32 <> 0) then { end of block }
begin
{$IFDEF DEBUG}
Tracevv('inflate: end of block');
{$ENDIF}
c^.mode := WASH;
continue; { break C-switch statement }
end;
c^.mode := BADCODE; { invalid code }
z.msg := 'invalid literal/length code';
r := Z_DATA_ERROR;
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_codes := inflate_flush(s,z,r);
exit;
end;
LENEXT: { i: getting length extra (have base) }
begin
j := c^.sub.copy.get;
{NEEDBITS(j);}
while (k < j) do
begin
{NEEDBYTE;}
if (n <> 0) then
r :=Z_OK
else
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_codes := inflate_flush(s,z,r);
exit;
end;
Dec(n);
b := b or (uLong(p^) shl k);
Inc(p);
Inc(k, 8);
end;
Inc(c^.len, uInt(b and inflate_mask[j]));
{DUMPBITS(j);}
b := b shr j;
Dec(k, j);
c^.sub.code.need := c^.dbits;
c^.sub.code.tree := c^.dtree;
{$IFDEF DEBUG}
Tracevv('inflate: length '+IntToStr(c^.len));
{$ENDIF}
c^.mode := DIST;
{ falltrough }
end;
DIST: { i: get distance next }
begin
j := c^.sub.code.need;
{NEEDBITS(j);}
while (k < j) do
begin
{NEEDBYTE;}
if (n <> 0) then
r :=Z_OK
else
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_codes := inflate_flush(s,z,r);
exit;
end;
Dec(n);
b := b or (uLong(p^) shl k);
Inc(p);
Inc(k, 8);
end;
t := @huft_ptr(c^.sub.code.tree)^[uInt(b) and inflate_mask[j]];
{DUMPBITS(t^.bits);}
b := b shr t^.bits;
Dec(k, t^.bits);
e := uInt(t^.exop);
if (e and 16 <> 0) then { distance }
begin
c^.sub.copy.get := e and 15;
c^.sub.copy.dist := t^.base;
c^.mode := DISTEXT;
continue; { break C-switch statement }
end;
if (e and 64 = 0) then { next table }
begin
c^.sub.code.need := e;
c^.sub.code.tree := @huft_ptr(t)^[t^.base];
continue; { break C-switch statement }
end;
c^.mode := BADCODE; { invalid code }
z.msg := 'invalid distance code';
r := Z_DATA_ERROR;
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_codes := inflate_flush(s,z,r);
exit;
end;
DISTEXT: { i: getting distance extra }
begin
j := c^.sub.copy.get;
{NEEDBITS(j);}
while (k < j) do
begin
{NEEDBYTE;}
if (n <> 0) then
r :=Z_OK
else
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_codes := inflate_flush(s,z,r);
exit;
end;
Dec(n);
b := b or (uLong(p^) shl k);
Inc(p);
Inc(k, 8);
end;
Inc(c^.sub.copy.dist, uInt(b) and inflate_mask[j]);
{DUMPBITS(j);}
b := b shr j;
Dec(k, j);
{$IFDEF DEBUG}
Tracevv('inflate: distance '+ IntToStr(c^.sub.copy.dist));
{$ENDIF}
c^.mode := COPY;
{ falltrough }
end;
COPY: { o: copying bytes in window, waiting for space }
begin
f := q;
Dec(f, c^.sub.copy.dist);
if (uInt(ptr2int(q) - ptr2int(s.window)) < c^.sub.copy.dist) then
begin
f := s.zend;
Dec(f, c^.sub.copy.dist - uInt(ptr2int(q) - ptr2int(s.window)));
end;
while (c^.len <> 0) do
begin
{NEEDOUT}
if (m = 0) then
begin
{WRAP}
if (q = s.zend) and (s.read <> s.window) then
begin
q := s.window;
if ptr2int(q) < ptr2int(s.read) then
m := uInt(ptr2int(s.read)-ptr2int(q)-1)
else
m := uInt(ptr2int(s.zend)-ptr2int(q));
end;
if (m = 0) then
begin
{FLUSH}
s.write := q;
r := inflate_flush(s,z,r);
q := s.write;
if ptr2int(q) < ptr2int(s.read) then
m := uInt(ptr2int(s.read)-ptr2int(q)-1)
else
m := uInt(ptr2int(s.zend)-ptr2int(q));
{WRAP}
if (q = s.zend) and (s.read <> s.window) then
begin
q := s.window;
if ptr2int(q) < ptr2int(s.read) then
m := uInt(ptr2int(s.read)-ptr2int(q)-1)
else
m := uInt(ptr2int(s.zend)-ptr2int(q));
end;
if (m = 0) then
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_codes := inflate_flush(s,z,r);
exit;
end;
end;
end;
r := Z_OK;
{OUTBYTE( *f++)}
q^ := f^;
Inc(q);
Inc(f);
Dec(m);
if (f = s.zend) then
f := s.window;
Dec(c^.len);
end;
c^.mode := START;
{ C-switch break; not needed }
end;
LIT: { o: got literal, waiting for output space }
begin
{NEEDOUT}
if (m = 0) then
begin
{WRAP}
if (q = s.zend) and (s.read <> s.window) then
begin
q := s.window;
if ptr2int(q) < ptr2int(s.read) then
m := uInt(ptr2int(s.read)-ptr2int(q)-1)
else
m := uInt(ptr2int(s.zend)-ptr2int(q));
end;
if (m = 0) then
begin
{FLUSH}
s.write := q;
r := inflate_flush(s,z,r);
q := s.write;
if ptr2int(q) < ptr2int(s.read) then
m := uInt(ptr2int(s.read)-ptr2int(q)-1)
else
m := uInt(ptr2int(s.zend)-ptr2int(q));
{WRAP}
if (q = s.zend) and (s.read <> s.window) then
begin
q := s.window;
if ptr2int(q) < ptr2int(s.read) then
m := uInt(ptr2int(s.read)-ptr2int(q)-1)
else
m := uInt(ptr2int(s.zend)-ptr2int(q));
end;
if (m = 0) then
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_codes := inflate_flush(s,z,r);
exit;
end;
end;
end;
r := Z_OK;
{OUTBYTE(c^.sub.lit);}
q^ := c^.sub.lit;
Inc(q);
Dec(m);
c^.mode := START;
{break;}
end;
WASH: { o: got eob, possibly more output }
begin
{$ifdef patch112}
if (k > 7) then { return unused byte, if any }
begin
{$IFDEF DEBUG}
Assert(k < 16, 'inflate_codes grabbed too many bytes');
{$ENDIF}
Dec(k, 8);
Inc(n);
Dec(p); { can always return one }
end;
{$endif}
{FLUSH}
s.write := q;
r := inflate_flush(s,z,r);
q := s.write;
if ptr2int(q) < ptr2int(s.read) then
m := uInt(ptr2int(s.read)-ptr2int(q)-1)
else
m := uInt(ptr2int(s.zend)-ptr2int(q));
if (s.read <> s.write) then
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_codes := inflate_flush(s,z,r);
exit;
end;
c^.mode := ZEND;
{ falltrough }
end;
ZEND:
begin
r := Z_STREAM_END;
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_codes := inflate_flush(s,z,r);
exit;
end;
BADCODE: { x: got error }
begin
r := Z_DATA_ERROR;
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_codes := inflate_flush(s,z,r);
exit;
end;
else
begin
r := Z_STREAM_ERROR;
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_codes := inflate_flush(s,z,r);
exit;
end;
end;
{NEED_DUMMY_RETURN - Delphi2+ dumb compilers complain without this }
inflate_codes := Z_STREAM_ERROR;
end;
procedure inflate_codes_free(c : pInflate_codes_state;
var z : z_stream);
begin
ZFREE(z, c);
{$IFDEF DEBUG}
Tracev('inflate: codes free');
{$ENDIF}
end;
end.

318
Imaging/ZLib/iminffast.pas Normal file
View File

@@ -0,0 +1,318 @@
Unit iminffast;
{
inffast.h and
inffast.c -- process literals and length/distance pairs fast
Copyright (C) 1995-1998 Mark Adler
Pascal tranlastion
Copyright (C) 1998 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt
}
interface
{$I imzconf.inc}
uses
{$ifdef DEBUG}
SysUtils, strutils,
{$ENDIF}
imzutil, impaszlib;
function inflate_fast( bl : uInt;
bd : uInt;
tl : pInflate_huft;
td : pInflate_huft;
var s : inflate_blocks_state;
var z : z_stream) : int;
implementation
uses
iminfutil;
{ Called with number of bytes left to write in window at least 258
(the maximum string length) and number of input bytes available
at least ten. The ten bytes are six bytes for the longest length/
distance pair plus four bytes for overloading the bit buffer. }
function inflate_fast( bl : uInt;
bd : uInt;
tl : pInflate_huft;
td : pInflate_huft;
var s : inflate_blocks_state;
var z : z_stream) : int;
var
t : pInflate_huft; { temporary pointer }
e : uInt; { extra bits or operation }
b : uLong; { bit buffer }
k : uInt; { bits in bit buffer }
p : pBytef; { input data pointer }
n : uInt; { bytes available there }
q : pBytef; { output window write pointer }
m : uInt; { bytes to end of window or read pointer }
ml : uInt; { mask for literal/length tree }
md : uInt; { mask for distance tree }
c : uInt; { bytes to copy }
d : uInt; { distance back to copy from }
r : pBytef; { copy source pointer }
begin
{ load input, output, bit values (macro LOAD) }
p := z.next_in;
n := z.avail_in;
b := s.bitb;
k := s.bitk;
q := s.write;
if ptr2int(q) < ptr2int(s.read) then
m := uInt(ptr2int(s.read)-ptr2int(q)-1)
else
m := uInt(ptr2int(s.zend)-ptr2int(q));
{ initialize masks }
ml := inflate_mask[bl];
md := inflate_mask[bd];
{ do until not enough input or output space for fast loop }
repeat { assume called with (m >= 258) and (n >= 10) }
{ get literal/length code }
{GRABBITS(20);} { max bits for literal/length code }
while (k < 20) do
begin
Dec(n);
b := b or (uLong(p^) shl k);
Inc(p);
Inc(k, 8);
end;
t := @(huft_ptr(tl)^[uInt(b) and ml]);
e := t^.exop;
if (e = 0) then
begin
{DUMPBITS(t^.bits);}
b := b shr t^.bits;
Dec(k, t^.bits);
{$IFDEF DEBUG}
if (t^.base >= $20) and (t^.base < $7f) then
Tracevv('inflate: * literal '+char(t^.base))
else
Tracevv('inflate: * literal '+ IntToStr(t^.base));
{$ENDIF}
q^ := Byte(t^.base);
Inc(q);
Dec(m);
continue;
end;
repeat
{DUMPBITS(t^.bits);}
b := b shr t^.bits;
Dec(k, t^.bits);
if (e and 16 <> 0) then
begin
{ get extra bits for length }
e := e and 15;
c := t^.base + (uInt(b) and inflate_mask[e]);
{DUMPBITS(e);}
b := b shr e;
Dec(k, e);
{$IFDEF DEBUG}
Tracevv('inflate: * length ' + IntToStr(c));
{$ENDIF}
{ decode distance base of block to copy }
{GRABBITS(15);} { max bits for distance code }
while (k < 15) do
begin
Dec(n);
b := b or (uLong(p^) shl k);
Inc(p);
Inc(k, 8);
end;
t := @huft_ptr(td)^[uInt(b) and md];
e := t^.exop;
repeat
{DUMPBITS(t^.bits);}
b := b shr t^.bits;
Dec(k, t^.bits);
if (e and 16 <> 0) then
begin
{ get extra bits to add to distance base }
e := e and 15;
{GRABBITS(e);} { get extra bits (up to 13) }
while (k < e) do
begin
Dec(n);
b := b or (uLong(p^) shl k);
Inc(p);
Inc(k, 8);
end;
d := t^.base + (uInt(b) and inflate_mask[e]);
{DUMPBITS(e);}
b := b shr e;
Dec(k, e);
{$IFDEF DEBUG}
Tracevv('inflate: * distance '+IntToStr(d));
{$ENDIF}
{ do the copy }
Dec(m, c);
if (uInt(ptr2int(q) - ptr2int(s.window)) >= d) then { offset before dest }
begin { just copy }
r := q;
Dec(r, d);
q^ := r^; Inc(q); Inc(r); Dec(c); { minimum count is three, }
q^ := r^; Inc(q); Inc(r); Dec(c); { so unroll loop a little }
end
else { else offset after destination }
begin
e := d - uInt(ptr2int(q) - ptr2int(s.window)); { bytes from offset to end }
r := s.zend;
Dec(r, e); { pointer to offset }
if (c > e) then { if source crosses, }
begin
Dec(c, e); { copy to end of window }
repeat
q^ := r^;
Inc(q);
Inc(r);
Dec(e);
until (e=0);
r := s.window; { copy rest from start of window }
end;
end;
repeat { copy all or what's left }
q^ := r^;
Inc(q);
Inc(r);
Dec(c);
until (c = 0);
break;
end
else
if (e and 64 = 0) then
begin
Inc(t, t^.base + (uInt(b) and inflate_mask[e]));
e := t^.exop;
end
else
begin
z.msg := 'invalid distance code';
{UNGRAB}
c := z.avail_in-n;
if (k shr 3) < c then
c := k shr 3;
Inc(n, c);
Dec(p, c);
Dec(k, c shl 3);
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_fast := Z_DATA_ERROR;
exit;
end;
until FALSE;
break;
end;
if (e and 64 = 0) then
begin
{t += t->base;
e = (t += ((uInt)b & inflate_mask[e]))->exop;}
Inc(t, t^.base + (uInt(b) and inflate_mask[e]));
e := t^.exop;
if (e = 0) then
begin
{DUMPBITS(t^.bits);}
b := b shr t^.bits;
Dec(k, t^.bits);
{$IFDEF DEBUG}
if (t^.base >= $20) and (t^.base < $7f) then
Tracevv('inflate: * literal '+char(t^.base))
else
Tracevv('inflate: * literal '+IntToStr(t^.base));
{$ENDIF}
q^ := Byte(t^.base);
Inc(q);
Dec(m);
break;
end;
end
else
if (e and 32 <> 0) then
begin
{$IFDEF DEBUG}
Tracevv('inflate: * end of block');
{$ENDIF}
{UNGRAB}
c := z.avail_in-n;
if (k shr 3) < c then
c := k shr 3;
Inc(n, c);
Dec(p, c);
Dec(k, c shl 3);
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_fast := Z_STREAM_END;
exit;
end
else
begin
z.msg := 'invalid literal/length code';
{UNGRAB}
c := z.avail_in-n;
if (k shr 3) < c then
c := k shr 3;
Inc(n, c);
Dec(p, c);
Dec(k, c shl 3);
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_fast := Z_DATA_ERROR;
exit;
end;
until FALSE;
until (m < 258) or (n < 10);
{ not enough input or output--restore pointers and return }
{UNGRAB}
c := z.avail_in-n;
if (k shr 3) < c then
c := k shr 3;
Inc(n, c);
Dec(p, c);
Dec(k, c shl 3);
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_fast := Z_OK;
end;
end.

781
Imaging/ZLib/iminftrees.pas Normal file
View File

@@ -0,0 +1,781 @@
Unit iminftrees;
{ inftrees.h -- header to use inftrees.c
inftrees.c -- generate Huffman trees for efficient decoding
Copyright (C) 1995-1998 Mark Adler
WARNING: this file should *not* be used by applications. It is
part of the implementation of the compression library and is
subject to change.
Pascal tranlastion
Copyright (C) 1998 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt
}
Interface
{$I imzconf.inc}
uses
imzutil, impaszlib;
{ 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;
implementation
const
inflate_copyright = 'inflate 1.1.2 Copyright 1995-1998 Mark Adler';
{
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.
}
const
{ Tables for deflate from PKZIP's appnote.txt. }
cplens : Array [0..30] Of uInt { Copy lengths for literal codes 257..285 }
= (3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31,
35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258, 0, 0);
{ actually lengths - 2; also see note #13 above about 258 }
invalid_code = 112;
cplext : Array [0..30] Of uInt { Extra bits for literal codes 257..285 }
= (0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2,
3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 0, invalid_code, invalid_code);
cpdist : Array [0..29] Of uInt { Copy offsets for distance codes 0..29 }
= (1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193,
257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145,
8193, 12289, 16385, 24577);
cpdext : Array [0..29] Of uInt { Extra bits for distance codes }
= (0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6,
7, 7, 8, 8, 9, 9, 10, 10, 11, 11,
12, 12, 13, 13);
{ Huffman code decoding is performed using a multi-level table lookup.
The fastest way to decode is to simply build a lookup table whose
size is determined by the longest code. However, the time it takes
to build this table can also be a factor if the data being decoded
is not very long. The most common codes are necessarily the
shortest codes, so those codes dominate the decoding time, and hence
the speed. The idea is you can have a shorter table that decodes the
shorter, more probable codes, and then point to subsidiary tables for
the longer codes. The time it costs to decode the longer codes is
then traded against the time it takes to make longer tables.
This results of this trade are in the variables lbits and dbits
below. lbits is the number of bits the first level table for literal/
length codes can decode in one step, and dbits is the same thing for
the distance codes. Subsequent tables are also less than or equal to
those sizes. These values may be adjusted either when all of the
codes are shorter than that, in which case the longest code length in
bits is used, or when the shortest code is *longer* than the requested
table size, in which case the length of the shortest code in bits is
used.
There are two different values for the two tables, since they code a
different number of possibilities each. The literal/length table
codes 286 possible values, or in a flat code, a little over eight
bits. The distance table codes 30 possible values, or a little less
than five bits, flat. The optimum values for speed end up being
about one bit more than those, so lbits is 8+1 and dbits is 5+1.
The optimum values may differ though from machine to machine, and
possibly even between compilers. Your mileage may vary. }
{ If BMAX needs to be larger than 16, then h and x[] should be uLong. }
const
BMAX = 15; { maximum bit length of any code }
{$DEFINE USE_PTR}
function huft_build(
var b : array of uIntf; { code lengths in bits (all assumed <= BMAX) }
n : uInt; { number of codes (assumed <= N_MAX) }
s : uInt; { number of simple-valued codes (0..s-1) }
const d : array of uIntf; { list of base values for non-simple codes }
{ array of word }
const e : array of uIntf; { list of extra bits for non-simple codes }
{ array of byte }
t : ppInflate_huft; { result: starting table }
var m : uIntf; { maximum lookup bits, returns actual }
var hp : array of inflate_huft; { space for trees }
var hn : uInt; { hufts used in space }
var v : array of uIntf { working area: values in order of bit length }
) : int;
{ Given a list of code lengths and a maximum table size, make a set of
tables to decode that set of codes. Return Z_OK on success, Z_BUF_ERROR
if the given code set is incomplete (the tables are still built in this
case), Z_DATA_ERROR if the input is invalid (an over-subscribed set of
lengths), or Z_MEM_ERROR if not enough memory. }
Var
a : uInt; { counter for codes of length k }
c : Array [0..BMAX] Of uInt; { bit length count table }
f : uInt; { i repeats in table every f entries }
g : int; { maximum code length }
h : int; { table level }
i : uInt; {register} { counter, current code }
j : uInt; {register} { counter }
k : Int; {register} { number of bits in current code }
l : int; { bits per table (returned in m) }
mask : uInt; { (1 shl w) - 1, to avoid cc -O bug on HP }
p : ^uIntf; {register} { pointer into c[], b[], or v[] }
q : pInflate_huft; { points to current table }
r : inflate_huft; { table entry for structure assignment }
u : Array [0..BMAX-1] Of pInflate_huft; { table stack }
w : int; {register} { bits before this table = (l*h) }
x : Array [0..BMAX] Of uInt; { bit offsets, then code stack }
{$IFDEF USE_PTR}
xp : puIntf; { pointer into x }
{$ELSE}
xp : uInt;
{$ENDIF}
y : int; { number of dummy codes added }
z : uInt; { number of entries in current table }
Begin
{ Generate counts for each bit length }
FillChar(c,SizeOf(c),0) ; { clear c[] }
for i := 0 to n-1 do
Inc (c[b[i]]); { assume all entries <= BMAX }
If (c[0] = n) Then { null input--all zero length codes }
Begin
t^ := pInflate_huft(NIL);
m := 0 ;
huft_build := Z_OK ;
Exit;
End ;
{ Find minimum and maximum length, bound [m] by those }
l := m;
for j:=1 To BMAX do
if (c[j] <> 0) then
break;
k := j ; { minimum code length }
if (uInt(l) < j) then
l := j;
for i := BMAX downto 1 do
if (c[i] <> 0) then
break ;
g := i ; { maximum code length }
if (uInt(l) > i) then
l := i;
m := l;
{ Adjust last length count to fill out codes, if needed }
y := 1 shl j ;
while (j < i) do
begin
Dec(y, c[j]) ;
if (y < 0) then
begin
huft_build := Z_DATA_ERROR; { bad input: more codes than bits }
exit;
end ;
Inc(j) ;
y := y shl 1
end;
Dec (y, c[i]) ;
if (y < 0) then
begin
huft_build := Z_DATA_ERROR; { bad input: more codes than bits }
exit;
end;
Inc(c[i], y);
{ Generate starting offsets into the value table FOR each length }
{$IFDEF USE_PTR}
x[1] := 0;
j := 0;
p := @c[1];
xp := @x[2];
dec(i); { note that i = g from above }
WHILE (i > 0) DO
BEGIN
inc(j, p^);
xp^ := j;
inc(p);
inc(xp);
dec(i);
END;
{$ELSE}
x[1] := 0;
j := 0 ;
for i := 1 to g do
begin
x[i] := j;
Inc(j, c[i]);
end;
{$ENDIF}
{ Make a table of values in order of bit lengths }
for i := 0 to n-1 do
begin
j := b[i];
if (j <> 0) then
begin
v[ x[j] ] := i;
Inc(x[j]);
end;
end;
n := x[g]; { set n to length of v }
{ Generate the Huffman codes and for each, make the table entries }
i := 0 ;
x[0] := 0 ; { first Huffman code is zero }
p := Addr(v) ; { grab values in bit order }
h := -1 ; { no tables yet--level -1 }
w := -l ; { bits decoded = (l*h) }
u[0] := pInflate_huft(NIL); { just to keep compilers happy }
q := pInflate_huft(NIL); { ditto }
z := 0 ; { ditto }
{ go through the bit lengths (k already is bits in shortest code) }
while (k <= g) Do
begin
a := c[k] ;
while (a<>0) Do
begin
Dec (a) ;
{ here i is the Huffman code of length k bits for value p^ }
{ make tables up to required level }
while (k > w + l) do
begin
Inc (h) ;
Inc (w, l); { add bits already decoded }
{ previous table always l bits }
{ compute minimum size table less than or equal to l bits }
{ table size upper limit }
z := g - w;
If (z > uInt(l)) Then
z := l;
{ try a k-w bit table }
j := k - w;
f := 1 shl j;
if (f > a+1) Then { too few codes for k-w bit table }
begin
Dec(f, a+1); { deduct codes from patterns left }
{$IFDEF USE_PTR}
xp := Addr(c[k]);
if (j < z) then
begin
Inc(j);
while (j < z) do
begin { try smaller tables up to z bits }
f := f shl 1;
Inc (xp) ;
If (f <= xp^) Then
break; { enough codes to use up j bits }
Dec(f, xp^); { else deduct codes from patterns }
Inc(j);
end;
end;
{$ELSE}
xp := k;
if (j < z) then
begin
Inc (j) ;
While (j < z) Do
begin { try smaller tables up to z bits }
f := f * 2;
Inc (xp) ;
if (f <= c[xp]) then
Break ; { enough codes to use up j bits }
Dec (f, c[xp]) ; { else deduct codes from patterns }
Inc (j);
end;
end;
{$ENDIF}
end;
z := 1 shl j; { table entries for j-bit table }
{ allocate new table }
if (hn + z > MANY) then { (note: doesn't matter for fixed) }
begin
huft_build := Z_MEM_ERROR; { not enough memory }
exit;
end;
q := @hp[hn];
u[h] := q;
Inc(hn, z);
{ connect to last table, if there is one }
if (h <> 0) then
begin
x[h] := i; { save pattern for backing up }
r.bits := Byte(l); { bits to dump before this table }
r.exop := Byte(j); { bits in this table }
j := i shr (w - l);
{r.base := uInt( q - u[h-1] -j);} { offset to this table }
r.base := (ptr2int(q) - ptr2int(u[h-1]) ) div sizeof(q^) - j;
huft_Ptr(u[h-1])^[j] := r; { connect to last table }
end
else
t^ := q; { first table is returned result }
end;
{ set up table entry in r }
r.bits := Byte(k - w);
{ C-code: if (p >= v + n) - see ZUTIL.PAS for comments }
if ptr2int(p)>=ptr2int(@(v[n])) then { also works under DPMI ?? }
r.exop := 128 + 64 { out of values--invalid code }
else
if (p^ < s) then
begin
if (p^ < 256) then { 256 is end-of-block code }
r.exop := 0
Else
r.exop := 32 + 64; { EOB_code; }
r.base := p^; { simple code is just the value }
Inc(p);
end
Else
begin
r.exop := Byte(e[p^-s] + 16 + 64); { non-simple--look up in lists }
r.base := d[p^-s];
Inc (p);
end ;
{ fill code-like entries with r }
f := 1 shl (k - w);
j := i shr w;
while (j < z) do
begin
huft_Ptr(q)^[j] := r;
Inc(j, f);
end;
{ backwards increment the k-bit code i }
j := 1 shl (k-1) ;
while (i and j) <> 0 do
begin
i := i xor j; { bitwise exclusive or }
j := j shr 1
end ;
i := i xor j;
{ backup over finished tables }
mask := (1 shl w) - 1; { needed on HP, cc -O bug }
while ((i and mask) <> x[h]) do
begin
Dec(h); { don't need to update q }
Dec(w, l);
mask := (1 shl w) - 1;
end;
end;
Inc(k);
end;
{ Return Z_BUF_ERROR if we were given an incomplete table }
if (y <> 0) And (g <> 1) then
huft_build := Z_BUF_ERROR
else
huft_build := Z_OK;
end; { huft_build}
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;
var
r : int;
hn : uInt; { hufts used in space }
v : PuIntArray; { work area for huft_build }
begin
hn := 0;
v := PuIntArray( ZALLOC(z, 19, sizeof(uInt)) );
if (v = Z_NULL) then
begin
inflate_trees_bits := Z_MEM_ERROR;
exit;
end;
r := huft_build(c, 19, 19, cplens, cplext,
{puIntf(Z_NULL), puIntf(Z_NULL),}
@tb, bb, hp, hn, v^);
if (r = Z_DATA_ERROR) then
z.msg := 'oversubscribed dynamic bit lengths tree'
else
if (r = Z_BUF_ERROR) or (bb = 0) then
begin
z.msg := 'incomplete dynamic bit lengths tree';
r := Z_DATA_ERROR;
end;
ZFREE(z, v);
inflate_trees_bits := r;
end;
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;
var
r : int;
hn : uInt; { hufts used in space }
v : PuIntArray; { work area for huft_build }
begin
hn := 0;
{ allocate work area }
v := PuIntArray( ZALLOC(z, 288, sizeof(uInt)) );
if (v = Z_NULL) then
begin
inflate_trees_dynamic := Z_MEM_ERROR;
exit;
end;
{ build literal/length tree }
r := huft_build(c, nl, 257, cplens, cplext, @tl, bl, hp, hn, v^);
if (r <> Z_OK) or (bl = 0) then
begin
if (r = Z_DATA_ERROR) then
z.msg := 'oversubscribed literal/length tree'
else
if (r <> Z_MEM_ERROR) then
begin
z.msg := 'incomplete literal/length tree';
r := Z_DATA_ERROR;
end;
ZFREE(z, v);
inflate_trees_dynamic := r;
exit;
end;
{ build distance tree }
r := huft_build(puIntArray(@c[nl])^, nd, 0,
cpdist, cpdext, @td, bd, hp, hn, v^);
if (r <> Z_OK) or ((bd = 0) and (nl > 257)) then
begin
if (r = Z_DATA_ERROR) then
z.msg := 'oversubscribed literal/length tree'
else
if (r = Z_BUF_ERROR) then
begin
{$ifdef PKZIP_BUG_WORKAROUND}
r := Z_OK;
end;
{$else}
z.msg := 'incomplete literal/length tree';
r := Z_DATA_ERROR;
end
else
if (r <> Z_MEM_ERROR) then
begin
z.msg := 'empty distance tree with lengths';
r := Z_DATA_ERROR;
end;
ZFREE(z, v);
inflate_trees_dynamic := r;
exit;
{$endif}
end;
{ done }
ZFREE(z, v);
inflate_trees_dynamic := Z_OK;
end;
{$UNDEF BUILDFIXED}
{ build fixed tables only once--keep them here }
{$IFNDEF BUILDFIXED}
{ locals }
var
fixed_built : Boolean = false;
const
FIXEDH = 544; { number of hufts used by fixed tables }
var
fixed_mem : array[0..FIXEDH-1] of inflate_huft;
fixed_bl : uInt;
fixed_bd : uInt;
fixed_tl : pInflate_huft;
fixed_td : pInflate_huft;
{$ELSE}
{ inffixed.h -- table for decoding fixed codes }
{local}
const
fixed_bl = uInt(9);
{local}
const
fixed_bd = uInt(5);
{local}
const
fixed_tl : array [0..288-1] of inflate_huft = (
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 }
((96,7),256), ((0,8),80), ((0,8),16), ((84,8),115), ((82,7),31),
((0,8),112), ((0,8),48), ((0,9),192), ((80,7),10), ((0,8),96),
((0,8),32), ((0,9),160), ((0,8),0), ((0,8),128), ((0,8),64),
((0,9),224), ((80,7),6), ((0,8),88), ((0,8),24), ((0,9),144),
((83,7),59), ((0,8),120), ((0,8),56), ((0,9),208), ((81,7),17),
((0,8),104), ((0,8),40), ((0,9),176), ((0,8),8), ((0,8),136),
((0,8),72), ((0,9),240), ((80,7),4), ((0,8),84), ((0,8),20),
((85,8),227), ((83,7),43), ((0,8),116), ((0,8),52), ((0,9),200),
((81,7),13), ((0,8),100), ((0,8),36), ((0,9),168), ((0,8),4),
((0,8),132), ((0,8),68), ((0,9),232), ((80,7),8), ((0,8),92),
((0,8),28), ((0,9),152), ((84,7),83), ((0,8),124), ((0,8),60),
((0,9),216), ((82,7),23), ((0,8),108), ((0,8),44), ((0,9),184),
((0,8),12), ((0,8),140), ((0,8),76), ((0,9),248), ((80,7),3),
((0,8),82), ((0,8),18), ((85,8),163), ((83,7),35), ((0,8),114),
((0,8),50), ((0,9),196), ((81,7),11), ((0,8),98), ((0,8),34),
((0,9),164), ((0,8),2), ((0,8),130), ((0,8),66), ((0,9),228),
((80,7),7), ((0,8),90), ((0,8),26), ((0,9),148), ((84,7),67),
((0,8),122), ((0,8),58), ((0,9),212), ((82,7),19), ((0,8),106),
((0,8),42), ((0,9),180), ((0,8),10), ((0,8),138), ((0,8),74),
((0,9),244), ((80,7),5), ((0,8),86), ((0,8),22), ((192,8),0),
((83,7),51), ((0,8),118), ((0,8),54), ((0,9),204), ((81,7),15),
((0,8),102), ((0,8),38), ((0,9),172), ((0,8),6), ((0,8),134),
((0,8),70), ((0,9),236), ((80,7),9), ((0,8),94), ((0,8),30),
((0,9),156), ((84,7),99), ((0,8),126), ((0,8),62), ((0,9),220),
((82,7),27), ((0,8),110), ((0,8),46), ((0,9),188), ((0,8),14),
((0,8),142), ((0,8),78), ((0,9),252), ((96,7),256), ((0,8),81),
((0,8),17), ((85,8),131), ((82,7),31), ((0,8),113), ((0,8),49),
((0,9),194), ((80,7),10), ((0,8),97), ((0,8),33), ((0,9),162),
((0,8),1), ((0,8),129), ((0,8),65), ((0,9),226), ((80,7),6),
((0,8),89), ((0,8),25), ((0,9),146), ((83,7),59), ((0,8),121),
((0,8),57), ((0,9),210), ((81,7),17), ((0,8),105), ((0,8),41),
((0,9),178), ((0,8),9), ((0,8),137), ((0,8),73), ((0,9),242),
((80,7),4), ((0,8),85), ((0,8),21), ((80,8),258), ((83,7),43),
((0,8),117), ((0,8),53), ((0,9),202), ((81,7),13), ((0,8),101),
((0,8),37), ((0,9),170), ((0,8),5), ((0,8),133), ((0,8),69),
((0,9),234), ((80,7),8), ((0,8),93), ((0,8),29), ((0,9),154),
((84,7),83), ((0,8),125), ((0,8),61), ((0,9),218), ((82,7),23),
((0,8),109), ((0,8),45), ((0,9),186), ((0,8),13), ((0,8),141),
((0,8),77), ((0,9),250), ((80,7),3), ((0,8),83), ((0,8),19),
((85,8),195), ((83,7),35), ((0,8),115), ((0,8),51), ((0,9),198),
((81,7),11), ((0,8),99), ((0,8),35), ((0,9),166), ((0,8),3),
((0,8),131), ((0,8),67), ((0,9),230), ((80,7),7), ((0,8),91),
((0,8),27), ((0,9),150), ((84,7),67), ((0,8),123), ((0,8),59),
((0,9),214), ((82,7),19), ((0,8),107), ((0,8),43), ((0,9),182),
((0,8),11), ((0,8),139), ((0,8),75), ((0,9),246), ((80,7),5),
((0,8),87), ((0,8),23), ((192,8),0), ((83,7),51), ((0,8),119),
((0,8),55), ((0,9),206), ((81,7),15), ((0,8),103), ((0,8),39),
((0,9),174), ((0,8),7), ((0,8),135), ((0,8),71), ((0,9),238),
((80,7),9), ((0,8),95), ((0,8),31), ((0,9),158), ((84,7),99),
((0,8),127), ((0,8),63), ((0,9),222), ((82,7),27), ((0,8),111),
((0,8),47), ((0,9),190), ((0,8),15), ((0,8),143), ((0,8),79),
((0,9),254), ((96,7),256), ((0,8),80), ((0,8),16), ((84,8),115),
((82,7),31), ((0,8),112), ((0,8),48), ((0,9),193), ((80,7),10),
((0,8),96), ((0,8),32), ((0,9),161), ((0,8),0), ((0,8),128),
((0,8),64), ((0,9),225), ((80,7),6), ((0,8),88), ((0,8),24),
((0,9),145), ((83,7),59), ((0,8),120), ((0,8),56), ((0,9),209),
((81,7),17), ((0,8),104), ((0,8),40), ((0,9),177), ((0,8),8),
((0,8),136), ((0,8),72), ((0,9),241), ((80,7),4), ((0,8),84),
((0,8),20), ((85,8),227), ((83,7),43), ((0,8),116), ((0,8),52),
((0,9),201), ((81,7),13), ((0,8),100), ((0,8),36), ((0,9),169),
((0,8),4), ((0,8),132), ((0,8),68), ((0,9),233), ((80,7),8),
((0,8),92), ((0,8),28), ((0,9),153), ((84,7),83), ((0,8),124),
((0,8),60), ((0,9),217), ((82,7),23), ((0,8),108), ((0,8),44),
((0,9),185), ((0,8),12), ((0,8),140), ((0,8),76), ((0,9),249),
((80,7),3), ((0,8),82), ((0,8),18), ((85,8),163), ((83,7),35),
((0,8),114), ((0,8),50), ((0,9),197), ((81,7),11), ((0,8),98),
((0,8),34), ((0,9),165), ((0,8),2), ((0,8),130), ((0,8),66),
((0,9),229), ((80,7),7), ((0,8),90), ((0,8),26), ((0,9),149),
((84,7),67), ((0,8),122), ((0,8),58), ((0,9),213), ((82,7),19),
((0,8),106), ((0,8),42), ((0,9),181), ((0,8),10), ((0,8),138),
((0,8),74), ((0,9),245), ((80,7),5), ((0,8),86), ((0,8),22),
((192,8),0), ((83,7),51), ((0,8),118), ((0,8),54), ((0,9),205),
((81,7),15), ((0,8),102), ((0,8),38), ((0,9),173), ((0,8),6),
((0,8),134), ((0,8),70), ((0,9),237), ((80,7),9), ((0,8),94),
((0,8),30), ((0,9),157), ((84,7),99), ((0,8),126), ((0,8),62),
((0,9),221), ((82,7),27), ((0,8),110), ((0,8),46), ((0,9),189),
((0,8),14), ((0,8),142), ((0,8),78), ((0,9),253), ((96,7),256),
((0,8),81), ((0,8),17), ((85,8),131), ((82,7),31), ((0,8),113),
((0,8),49), ((0,9),195), ((80,7),10), ((0,8),97), ((0,8),33),
((0,9),163), ((0,8),1), ((0,8),129), ((0,8),65), ((0,9),227),
((80,7),6), ((0,8),89), ((0,8),25), ((0,9),147), ((83,7),59),
((0,8),121), ((0,8),57), ((0,9),211), ((81,7),17), ((0,8),105),
((0,8),41), ((0,9),179), ((0,8),9), ((0,8),137), ((0,8),73),
((0,9),243), ((80,7),4), ((0,8),85), ((0,8),21), ((80,8),258),
((83,7),43), ((0,8),117), ((0,8),53), ((0,9),203), ((81,7),13),
((0,8),101), ((0,8),37), ((0,9),171), ((0,8),5), ((0,8),133),
((0,8),69), ((0,9),235), ((80,7),8), ((0,8),93), ((0,8),29),
((0,9),155), ((84,7),83), ((0,8),125), ((0,8),61), ((0,9),219),
((82,7),23), ((0,8),109), ((0,8),45), ((0,9),187), ((0,8),13),
((0,8),141), ((0,8),77), ((0,9),251), ((80,7),3), ((0,8),83),
((0,8),19), ((85,8),195), ((83,7),35), ((0,8),115), ((0,8),51),
((0,9),199), ((81,7),11), ((0,8),99), ((0,8),35), ((0,9),167),
((0,8),3), ((0,8),131), ((0,8),67), ((0,9),231), ((80,7),7),
((0,8),91), ((0,8),27), ((0,9),151), ((84,7),67), ((0,8),123),
((0,8),59), ((0,9),215), ((82,7),19), ((0,8),107), ((0,8),43),
((0,9),183), ((0,8),11), ((0,8),139), ((0,8),75), ((0,9),247),
((80,7),5), ((0,8),87), ((0,8),23), ((192,8),0), ((83,7),51),
((0,8),119), ((0,8),55), ((0,9),207), ((81,7),15), ((0,8),103),
((0,8),39), ((0,9),175), ((0,8),7), ((0,8),135), ((0,8),71),
((0,9),239), ((80,7),9), ((0,8),95), ((0,8),31), ((0,9),159),
((84,7),99), ((0,8),127), ((0,8),63), ((0,9),223), ((82,7),27),
((0,8),111), ((0,8),47), ((0,9),191), ((0,8),15), ((0,8),143),
((0,8),79), ((0,9),255)
);
{local}
const
fixed_td : array[0..32-1] of inflate_huft = (
(Exop:80;bits:5;base:1), (Exop:87;bits:5;base:257), (Exop:83;bits:5;base:17),
(Exop:91;bits:5;base:4097), (Exop:81;bits:5;base), (Exop:89;bits:5;base:1025),
(Exop:85;bits:5;base:65), (Exop:93;bits:5;base:16385), (Exop:80;bits:5;base:3),
(Exop:88;bits:5;base:513), (Exop:84;bits:5;base:33), (Exop:92;bits:5;base:8193),
(Exop:82;bits:5;base:9), (Exop:90;bits:5;base:2049), (Exop:86;bits:5;base:129),
(Exop:192;bits:5;base:24577), (Exop:80;bits:5;base:2), (Exop:87;bits:5;base:385),
(Exop:83;bits:5;base:25), (Exop:91;bits:5;base:6145), (Exop:81;bits:5;base:7),
(Exop:89;bits:5;base:1537), (Exop:85;bits:5;base:97), (Exop:93;bits:5;base:24577),
(Exop:80;bits:5;base:4), (Exop:88;bits:5;base:769), (Exop:84;bits:5;base:49),
(Exop:92;bits:5;base:12289), (Exop:82;bits:5;base:13), (Exop:90;bits:5;base:3073),
(Exop:86;bits:5;base:193), (Exop:192;bits:5;base:24577)
);
{$ENDIF}
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;
type
pFixed_table = ^fixed_table;
fixed_table = array[0..288-1] of uIntf;
var
k : int; { temporary variable }
c : pFixed_table; { length list for huft_build }
v : PuIntArray; { work area for huft_build }
var
f : uInt; { number of hufts used in fixed_mem }
begin
{ build fixed tables if not already (multiple overlapped executions ok) }
if not fixed_built then
begin
f := 0;
{ allocate memory }
c := pFixed_table( ZALLOC(z, 288, sizeof(uInt)) );
if (c = Z_NULL) then
begin
inflate_trees_fixed := Z_MEM_ERROR;
exit;
end;
v := PuIntArray( ZALLOC(z, 288, sizeof(uInt)) );
if (v = Z_NULL) then
begin
ZFREE(z, c);
inflate_trees_fixed := Z_MEM_ERROR;
exit;
end;
{ literal table }
for k := 0 to Pred(144) do
c^[k] := 8;
for k := 144 to Pred(256) do
c^[k] := 9;
for k := 256 to Pred(280) do
c^[k] := 7;
for k := 280 to Pred(288) do
c^[k] := 8;
fixed_bl := 9;
huft_build(c^, 288, 257, cplens, cplext, @fixed_tl, fixed_bl,
fixed_mem, f, v^);
{ distance table }
for k := 0 to Pred(30) do
c^[k] := 5;
fixed_bd := 5;
huft_build(c^, 30, 0, cpdist, cpdext, @fixed_td, fixed_bd,
fixed_mem, f, v^);
{ done }
ZFREE(z, v);
ZFREE(z, c);
fixed_built := True;
end;
bl := fixed_bl;
bd := fixed_bd;
tl := fixed_tl;
td := fixed_td;
inflate_trees_fixed := Z_OK;
end; { inflate_trees_fixed }
end.

222
Imaging/ZLib/iminfutil.pas Normal file
View File

@@ -0,0 +1,222 @@
Unit iminfutil;
{ types and macros common to blocks and codes
Copyright (C) 1995-1998 Mark Adler
WARNING: this file should *not* be used by applications. It is
part of the implementation of the compression library and is
subject to change.
Pascal tranlastion
Copyright (C) 1998 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt
}
interface
{$I imzconf.inc}
uses
imzutil, impaszlib;
{ 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);}
implementation
{ macros for bit input with no checking and for returning unused bytes }
procedure GRABBITS(j : int);
begin
{while (k < j) do
begin
Dec(z^.avail_in);
Inc(z^.total_in);
b := b or (uLong(z^.next_in^) shl k);
Inc(z^.next_in);
Inc(k, 8);
end;}
end;
procedure DUMPBITS(j : int);
begin
{b := b shr j;
Dec(k, j);}
end;
procedure NEEDBITS(j : int);
begin
(*
while (k < j) do
begin
{NEEDBYTE;}
if (n <> 0) then
r :=Z_OK
else
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, LongInt(p)-LongInt(z.next_in));
z.next_in := p;
s.write := q;
result := inflate_flush(s,z,r);
exit;
end;
Dec(n);
b := b or (uLong(p^) shl k);
Inc(p);
Inc(k, 8);
end;
*)
end;
procedure NEEDOUT;
begin
(*
if (m = 0) then
begin
{WRAP}
if (q = s.zend) and (s.read <> s.window) then
begin
q := s.window;
if LongInt(q) < LongInt(s.read) then
m := uInt(LongInt(s.read)-LongInt(q)-1)
else
m := uInt(LongInt(s.zend)-LongInt(q));
end;
if (m = 0) then
begin
{FLUSH}
s.write := q;
r := inflate_flush(s,z,r);
q := s.write;
if LongInt(q) < LongInt(s.read) then
m := uInt(LongInt(s.read)-LongInt(q)-1)
else
m := uInt(LongInt(s.zend)-LongInt(q));
{WRAP}
if (q = s.zend) and (s.read <> s.window) then
begin
q := s.window;
if LongInt(q) < LongInt(s.read) then
m := uInt(LongInt(s.read)-LongInt(q)-1)
else
m := uInt(LongInt(s.zend)-LongInt(q));
end;
if (m = 0) then
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, LongInt(p)-LongInt(z.next_in));
z.next_in := p;
s.write := q;
result := inflate_flush(s,z,r);
exit;
end;
end;
end;
r := Z_OK;
*)
end;
{ 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;
var
n : uInt;
p : pBytef;
q : pBytef;
begin
{ local copies of source and destination pointers }
p := z.next_out;
q := s.read;
{ compute number of bytes to copy as far as end of window }
if ptr2int(q) <= ptr2int(s.write) then
n := uInt(ptr2int(s.write) - ptr2int(q))
else
n := uInt(ptr2int(s.zend) - ptr2int(q));
if (n > z.avail_out) then
n := z.avail_out;
if (n <> 0) and (r = Z_BUF_ERROR) then
r := Z_OK;
{ update counters }
Dec(z.avail_out, n);
Inc(z.total_out, n);
{ update check information }
if Assigned(s.checkfn) then
begin
s.check := s.checkfn(s.check, q, n);
z.adler := s.check;
end;
{ copy as far as end of window }
zmemcpy(p, q, n);
Inc(p, n);
Inc(q, n);
{ see if more to copy at beginning of window }
if (q = s.zend) then
begin
{ wrap pointers }
q := s.window;
if (s.write = s.zend) then
s.write := s.window;
{ compute bytes to copy }
n := uInt(ptr2int(s.write) - ptr2int(q));
if (n > z.avail_out) then
n := z.avail_out;
if (n <> 0) and (r = Z_BUF_ERROR) then
r := Z_OK;
{ update counters }
Dec( z.avail_out, n);
Inc( z.total_out, n);
{ update check information }
if Assigned(s.checkfn) then
begin
s.check := s.checkfn(s.check, q, n);
z.adler := s.check;
end;
{ copy }
zmemcpy(p, q, n);
Inc(p, n);
Inc(q, n);
end;
{ update pointers }
z.next_out := p;
s.read := q;
{ done }
inflate_flush := r;
end;
end.

520
Imaging/ZLib/impaszlib.pas Normal file
View File

@@ -0,0 +1,520 @@
Unit impaszlib;
{ Original:
zlib.h -- interface of the 'zlib' general purpose compression library
version 1.1.0, Feb 24th, 1998
Copyright (C) 1995-1998 Jean-loup Gailly and Mark Adler
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
Copyright (C) 1998 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt
}
interface
{$I imzconf.inc}
uses
imzutil;
{ zconf.h -- configuration of the zlib compression library }
{ zutil.c -- target dependent utility functions for the compression library }
{ The 'zlib' compression library provides in-memory compression and
decompression functions, including integrity checks of the uncompressed
data. This version of the library supports only one compression method
(deflation) but other algorithms will be added later and will have the same
stream interface.
Compression can be done in a single step if the buffers are large
enough (for example if an input file is mmap'ed), or can be done by
repeated calls of the compression function. In the latter case, the
application must provide more input and/or consume the output
(providing more output space) before each call.
The library also supports reading and writing files in gzip (.gz) format
with an interface similar to that of stdio.
The library does not install any signal handler. The decoder checks
the consistency of the compressed data, so the library should never
crash even in case of corrupted input. }
{ Compile with -DMAXSEG_64K if the alloc function cannot allocate more
than 64k bytes at a time (needed on systems with 16-bit int). }
{ 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[255]; { 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;
MAX_MATCH = 258;
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;
function deflateInit_(var Stream: z_stream; Level: LongInt; const Version: string;
Stream_size: LongInt): LongInt;
function inflateInit_(var Stream: z_stream; const Version: string;
Stream_size: Longint): LongInt;
{$IFDEF DEBUG}
procedure z_error (m : string);
{$ENDIF}
implementation
uses
imzdeflate, imzinflate;
function deflateInit_(var Stream: z_stream; Level: LongInt; const Version: string;
Stream_size: LongInt): LongInt;
begin
Result := imzdeflate.deflateInit_(@Stream, Level, Version, Stream_size);
end;
function inflateInit_(var Stream: z_stream; const Version: string;
Stream_size: Longint): LongInt;
begin
Result := imzinflate.inflateInit_(@Stream, Version, Stream_size);
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;
end.

2249
Imaging/ZLib/imtrees.pas Normal file
View File

File diff suppressed because it is too large Load Diff

25
Imaging/ZLib/imzconf.inc Normal file
View File

@@ -0,0 +1,25 @@
{ -------------------------------------------------------------------- }
{$DEFINE MAX_MATCH_IS_258}
{ Compile with -DMAXSEG_64K if the alloc function cannot allocate more
than 64k bytes at a time (needed on systems with 16-bit int). }
{$UNDEF MAXSEG_64K}
{$DEFINE UNALIGNED_OK} { requires SizeOf(ush) = 2 ! }
{$UNDEF DYNAMIC_CRC_TABLE}
{$UNDEF FASTEST}
{$DEFINE Use32}
{$DEFINE patch112} { apply patch from the zlib home page }
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
{$UNDEF DEBUG} // for Delphi 2007 in DEBUG mode
{$RANGECHECKS OFF}
{$OVERFLOWCHECKS OFF}
{ -------------------------------------------------------------------- }

2129
Imaging/ZLib/imzdeflate.pas Normal file
View File

File diff suppressed because it is too large Load Diff

750
Imaging/ZLib/imzinflate.pas Normal file
View File

@@ -0,0 +1,750 @@
Unit imzinflate;
{ inflate.c -- zlib interface to inflate modules
Copyright (C) 1995-1998 Mark Adler
Pascal tranlastion
Copyright (C) 1998 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt
}
interface
{$I imzconf.inc}
uses
imzutil, impaszlib, iminfblock, iminfutil;
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;
function inflateInit2(var z: z_stream;
windowBits : 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;
implementation
uses
imadler;
function inflateReset(var z : z_stream) : int;
begin
if (z.state = Z_NULL) then
begin
inflateReset := Z_STREAM_ERROR;
exit;
end;
z.total_out := 0;
z.total_in := 0;
z.msg := '';
if z.state^.nowrap then
z.state^.mode := BLOCKS
else
z.state^.mode := METHOD;
inflate_blocks_reset(z.state^.blocks^, z, Z_NULL);
{$IFDEF DEBUG}
Tracev('inflate: reset');
{$ENDIF}
inflateReset := Z_OK;
end;
function inflateEnd(var z : z_stream) : int;
begin
if (z.state = Z_NULL) or not Assigned(z.zfree) then
begin
inflateEnd := Z_STREAM_ERROR;
exit;
end;
if (z.state^.blocks <> Z_NULL) then
inflate_blocks_free(z.state^.blocks, z);
ZFREE(z, z.state);
z.state := Z_NULL;
{$IFDEF DEBUG}
Tracev('inflate: end');
{$ENDIF}
inflateEnd := Z_OK;
end;
function inflateInit2_(var z: z_stream;
w : int;
const version : string;
stream_size : int) : int;
begin
if (version = '') or (version[1] <> ZLIB_VERSION[1]) or
(stream_size <> sizeof(z_stream)) then
begin
inflateInit2_ := Z_VERSION_ERROR;
exit;
end;
{ initialize state }
{ SetLength(strm.msg, 255); }
z.msg := '';
if not Assigned(z.zalloc) then
begin
{$IFDEF FPC} z.zalloc := @zcalloc; {$ELSE}
z.zalloc := zcalloc;
{$endif}
z.opaque := voidpf(0);
end;
if not Assigned(z.zfree) then
{$IFDEF FPC} z.zfree := @zcfree; {$ELSE}
z.zfree := zcfree;
{$ENDIF}
z.state := pInternal_state( ZALLOC(z,1,sizeof(internal_state)) );
if (z.state = Z_NULL) then
begin
inflateInit2_ := Z_MEM_ERROR;
exit;
end;
z.state^.blocks := Z_NULL;
{ handle undocumented nowrap option (no zlib header or check) }
z.state^.nowrap := FALSE;
if (w < 0) then
begin
w := - w;
z.state^.nowrap := TRUE;
end;
{ set window size }
if (w < 8) or (w > 15) then
begin
inflateEnd(z);
inflateInit2_ := Z_STREAM_ERROR;
exit;
end;
z.state^.wbits := uInt(w);
{ create inflate_blocks state }
if z.state^.nowrap then
z.state^.blocks := inflate_blocks_new(z, NIL, uInt(1) shl w)
else
{$IFDEF FPC}
z.state^.blocks := inflate_blocks_new(z, @adler32, uInt(1) shl w);
{$ELSE}
z.state^.blocks := inflate_blocks_new(z, adler32, uInt(1) shl w);
{$ENDIF}
if (z.state^.blocks = Z_NULL) then
begin
inflateEnd(z);
inflateInit2_ := Z_MEM_ERROR;
exit;
end;
{$IFDEF DEBUG}
Tracev('inflate: allocated');
{$ENDIF}
{ reset state }
inflateReset(z);
inflateInit2_ := Z_OK;
end;
function inflateInit2(var z: z_stream; windowBits : int) : int;
begin
inflateInit2 := inflateInit2_(z, windowBits, ZLIB_VERSION, sizeof(z_stream));
end;
function inflateInit(var z : z_stream) : int;
{ inflateInit is a macro to allow checking the zlib version
and the compiler's view of z_stream: }
begin
inflateInit := inflateInit2_(z, DEF_WBITS, ZLIB_VERSION, sizeof(z_stream));
end;
function inflateInit_(z : z_streamp;
const version : string;
stream_size : int) : int;
begin
{ initialize state }
if (z = Z_NULL) then
inflateInit_ := Z_STREAM_ERROR
else
inflateInit_ := inflateInit2_(z^, DEF_WBITS, version, stream_size);
end;
function inflate(var z : z_stream;
f : int) : int;
var
r : int;
b : uInt;
begin
if (z.state = Z_NULL) or (z.next_in = Z_NULL) then
begin
inflate := Z_STREAM_ERROR;
exit;
end;
if f = Z_FINISH then
f := Z_BUF_ERROR
else
f := Z_OK;
r := Z_BUF_ERROR;
while True do
case (z.state^.mode) of
BLOCKS:
begin
r := inflate_blocks(z.state^.blocks^, z, r);
if (r = Z_DATA_ERROR) then
begin
z.state^.mode := BAD;
z.state^.sub.marker := 0; { can try inflateSync }
continue; { break C-switch }
end;
if (r = Z_OK) then
r := f;
if (r <> Z_STREAM_END) then
begin
inflate := r;
exit;
end;
r := f;
inflate_blocks_reset(z.state^.blocks^, z, @z.state^.sub.check.was);
if (z.state^.nowrap) then
begin
z.state^.mode := DONE;
continue; { break C-switch }
end;
z.state^.mode := CHECK4; { falltrough }
end;
CHECK4:
begin
{NEEDBYTE}
if (z.avail_in = 0) then
begin
inflate := r;
exit;
end;
r := f;
{z.state^.sub.check.need := uLong(NEXTBYTE(z)) shl 24;}
Dec(z.avail_in);
Inc(z.total_in);
z.state^.sub.check.need := uLong(z.next_in^) shl 24;
Inc(z.next_in);
z.state^.mode := CHECK3; { falltrough }
end;
CHECK3:
begin
{NEEDBYTE}
if (z.avail_in = 0) then
begin
inflate := r;
exit;
end;
r := f;
{Inc( z.state^.sub.check.need, uLong(NEXTBYTE(z)) shl 16);}
Dec(z.avail_in);
Inc(z.total_in);
Inc(z.state^.sub.check.need, uLong(z.next_in^) shl 16);
Inc(z.next_in);
z.state^.mode := CHECK2; { falltrough }
end;
CHECK2:
begin
{NEEDBYTE}
if (z.avail_in = 0) then
begin
inflate := r;
exit;
end;
r := f;
{Inc( z.state^.sub.check.need, uLong(NEXTBYTE(z)) shl 8);}
Dec(z.avail_in);
Inc(z.total_in);
Inc(z.state^.sub.check.need, uLong(z.next_in^) shl 8);
Inc(z.next_in);
z.state^.mode := CHECK1; { falltrough }
end;
CHECK1:
begin
{NEEDBYTE}
if (z.avail_in = 0) then
begin
inflate := r;
exit;
end;
r := f;
{Inc( z.state^.sub.check.need, uLong(NEXTBYTE(z)) );}
Dec(z.avail_in);
Inc(z.total_in);
Inc(z.state^.sub.check.need, uLong(z.next_in^) );
Inc(z.next_in);
if (z.state^.sub.check.was <> z.state^.sub.check.need) then
begin
z.state^.mode := BAD;
z.msg := 'incorrect data check';
z.state^.sub.marker := 5; { can't try inflateSync }
continue; { break C-switch }
end;
{$IFDEF DEBUG}
Tracev('inflate: zlib check ok');
{$ENDIF}
z.state^.mode := DONE; { falltrough }
end;
DONE:
begin
inflate := Z_STREAM_END;
exit;
end;
METHOD:
begin
{NEEDBYTE}
if (z.avail_in = 0) then
begin
inflate := r;
exit;
end;
r := f; {}
{z.state^.sub.method := NEXTBYTE(z);}
Dec(z.avail_in);
Inc(z.total_in);
z.state^.sub.method := z.next_in^;
Inc(z.next_in);
if ((z.state^.sub.method and $0f) <> Z_DEFLATED) then
begin
z.state^.mode := BAD;
z.msg := 'unknown compression method';
z.state^.sub.marker := 5; { can't try inflateSync }
continue; { break C-switch }
end;
if ((z.state^.sub.method shr 4) + 8 > z.state^.wbits) then
begin
z.state^.mode := BAD;
z.msg := 'invalid window size';
z.state^.sub.marker := 5; { can't try inflateSync }
continue; { break C-switch }
end;
z.state^.mode := FLAG;
{ fall trough }
end;
FLAG:
begin
{NEEDBYTE}
if (z.avail_in = 0) then
begin
inflate := r;
exit;
end;
r := f; {}
{b := NEXTBYTE(z);}
Dec(z.avail_in);
Inc(z.total_in);
b := z.next_in^;
Inc(z.next_in);
if (((z.state^.sub.method shl 8) + b) mod 31) <> 0 then {% mod ?}
begin
z.state^.mode := BAD;
z.msg := 'incorrect header check';
z.state^.sub.marker := 5; { can't try inflateSync }
continue; { break C-switch }
end;
{$IFDEF DEBUG}
Tracev('inflate: zlib header ok');
{$ENDIF}
if ((b and PRESET_DICT) = 0) then
begin
z.state^.mode := BLOCKS;
continue; { break C-switch }
end;
z.state^.mode := DICT4;
{ falltrough }
end;
DICT4:
begin
if (z.avail_in = 0) then
begin
inflate := r;
exit;
end;
r := f;
{z.state^.sub.check.need := uLong(NEXTBYTE(z)) shl 24;}
Dec(z.avail_in);
Inc(z.total_in);
z.state^.sub.check.need := uLong(z.next_in^) shl 24;
Inc(z.next_in);
z.state^.mode := DICT3; { falltrough }
end;
DICT3:
begin
if (z.avail_in = 0) then
begin
inflate := r;
exit;
end;
r := f;
{Inc(z.state^.sub.check.need, uLong(NEXTBYTE(z)) shl 16);}
Dec(z.avail_in);
Inc(z.total_in);
Inc(z.state^.sub.check.need, uLong(z.next_in^) shl 16);
Inc(z.next_in);
z.state^.mode := DICT2; { falltrough }
end;
DICT2:
begin
if (z.avail_in = 0) then
begin
inflate := r;
exit;
end;
r := f;
{Inc(z.state^.sub.check.need, uLong(NEXTBYTE(z)) shl 8);}
Dec(z.avail_in);
Inc(z.total_in);
Inc(z.state^.sub.check.need, uLong(z.next_in^) shl 8);
Inc(z.next_in);
z.state^.mode := DICT1; { falltrough }
end;
DICT1:
begin
if (z.avail_in = 0) then
begin
inflate := r;
exit;
end;
{ r := f; --- wird niemals benutzt }
{Inc(z.state^.sub.check.need, uLong(NEXTBYTE(z)) );}
Dec(z.avail_in);
Inc(z.total_in);
Inc(z.state^.sub.check.need, uLong(z.next_in^) );
Inc(z.next_in);
z.adler := z.state^.sub.check.need;
z.state^.mode := DICT0;
inflate := Z_NEED_DICT;
exit;
end;
DICT0:
begin
z.state^.mode := BAD;
z.msg := 'need dictionary';
z.state^.sub.marker := 0; { can try inflateSync }
inflate := Z_STREAM_ERROR;
exit;
end;
BAD:
begin
inflate := Z_DATA_ERROR;
exit;
end;
else
begin
inflate := Z_STREAM_ERROR;
exit;
end;
end;
{$ifdef NEED_DUMMY_result}
result := Z_STREAM_ERROR; { Some dumb compilers complain without this }
{$endif}
end;
function inflateSetDictionary(var z : z_stream;
dictionary : pBytef; {const array of byte}
dictLength : uInt) : int;
var
length : uInt;
begin
length := dictLength;
if (z.state = Z_NULL) or (z.state^.mode <> DICT0) then
begin
inflateSetDictionary := Z_STREAM_ERROR;
exit;
end;
if (adler32(Long(1), dictionary, dictLength) <> z.adler) then
begin
inflateSetDictionary := Z_DATA_ERROR;
exit;
end;
z.adler := Long(1);
if (length >= (uInt(1) shl z.state^.wbits)) then
begin
length := (1 shl z.state^.wbits)-1;
Inc( dictionary, dictLength - length);
end;
inflate_set_dictionary(z.state^.blocks^, dictionary^, length);
z.state^.mode := BLOCKS;
inflateSetDictionary := Z_OK;
end;
function inflateSync(var z : z_stream) : int;
const
mark : packed array[0..3] of byte = (0, 0, $ff, $ff);
var
n : uInt; { number of bytes to look at }
p : pBytef; { pointer to bytes }
m : uInt; { number of marker bytes found in a row }
r, w : uLong; { temporaries to save total_in and total_out }
begin
{ set up }
if (z.state = Z_NULL) then
begin
inflateSync := Z_STREAM_ERROR;
exit;
end;
if (z.state^.mode <> BAD) then
begin
z.state^.mode := BAD;
z.state^.sub.marker := 0;
end;
n := z.avail_in;
if (n = 0) then
begin
inflateSync := Z_BUF_ERROR;
exit;
end;
p := z.next_in;
m := z.state^.sub.marker;
{ search }
while (n <> 0) and (m < 4) do
begin
if (p^ = mark[m]) then
Inc(m)
else
if (p^ <> 0) then
m := 0
else
m := 4 - m;
Inc(p);
Dec(n);
end;
{ restore }
Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in));
z.next_in := p;
z.avail_in := n;
z.state^.sub.marker := m;
{ return no joy or set up to restart on a new block }
if (m <> 4) then
begin
inflateSync := Z_DATA_ERROR;
exit;
end;
r := z.total_in;
w := z.total_out;
inflateReset(z);
z.total_in := r;
z.total_out := w;
z.state^.mode := BLOCKS;
inflateSync := Z_OK;
end;
{
returns true if inflate is currently at the end of a block generated
by Z_SYNC_FLUSH or Z_FULL_FLUSH. This function is used by one PPP
implementation to provide an additional safety check. PPP uses Z_SYNC_FLUSH
but removes the length bytes of the resulting empty stored block. When
decompressing, PPP checks that at the end of input packet, inflate is
waiting for these length bytes.
}
function inflateSyncPoint(var z : z_stream) : int;
begin
if (z.state = Z_NULL) or (z.state^.blocks = Z_NULL) then
begin
inflateSyncPoint := Z_STREAM_ERROR;
exit;
end;
inflateSyncPoint := inflate_blocks_sync_point(z.state^.blocks^);
end;
end.

191
Imaging/ZLib/imzutil.pas Normal file
View File

@@ -0,0 +1,191 @@
Unit imzutil;
{
Copyright (C) 1998 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt
}
interface
{$I imzconf.inc}
{ Type declarations }
type
{Byte = usigned char; 8 bits}
Bytef = byte;
charf = byte;
int = longint;
intf = int;
uInt = cardinal; { 16 bits or more }
uIntf = uInt;
Long = longint;
uLong = Cardinal;
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;
implementation
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}
*)
FreeMem(ptr);
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}
*)
GetMem(p, memsize);
zcalloc := p;
end;
end.

129
Imaging/ZLib/readme.txt Normal file
View File

@@ -0,0 +1,129 @@
_____________________________________________________________________________
PASZLIB 1.0 May 11th, 1998
Based on the zlib 1.1.2, a general purpose data compression library.
Copyright (C) 1998,1999,2000 by NOMSSI NZALI Jacques H. C.
[kn&n DES] See "Legal issues" for conditions of distribution and use.
_____________________________________________________________________________
Introduction
============
The 'zlib' compression library provides in-memory compression and
decompression functions, including integrity checks of the uncompressed
data. This version of the library supports only one compression method
(deflation) but other algorithms will be added later and will have the same
stream interface.
Compression can be done in a single step if the buffers are large
enough (for example if an input file is mmap'ed), or can be done by
repeated calls of the compression function. In the latter case, the
application must provide more input and/or consume the output
(providing more output space) before each call.
The default memory requirements for deflate are 256K plus a few kilobytes
for small objects. The default memory requirements for inflate are 32K
plus a few kilobytes for small objects.
Change Log
==========
March 24th 2000 - minizip code by Gilles Vollant ported to Pascal.
z_stream.msg defined as string[255] to avoid problems
with Delphi 2+ dynamic string handling.
changes to silence Delphi 5 compiler warning. If you
have Delphi 5, defines Delphi5 in zconf.inc
May 7th 1999 - Some changes for FPC
deflateCopy() has new parameters
trees.pas - record constant definition
June 17th 1998 - Applied official 1.1.2 patch.
Memcheck turned off by default.
zutil.pas patch for Delphi 1 memory allocation corrected.
dzlib.txt file added.
compress2() is now exported
June 25th 1998 - fixed a conversion bug: in inftrees.pas, ZFREE(z, v) was
missing in line 574;
File list
=========
Here is a road map to the files in the Paszlib distribution.
readme.txt Introduction, Documentation
dzlib.txt Changes to Delphi sources for Paszlib stream classes
include file
zconf.inc Configuration declarations.
Pascal source code files:
adler.pas compute the Adler-32 checksum of a data stream
crc.pas compute the CRC-32 of a data stream
gzio.pas IO on .gz files
infblock.pas interpret and process block types to last block
infcodes.pas process literals and length/distance pairs
inffast.pas process literals and length/distance pairs fast
inftrees.pas generate Huffman trees for efficient decoding
infutil.pas types and macros common to blocks and codes
strutils.pas string utilities
trees.pas output deflated data using Huffman coding
zcompres.pas compress a memory buffer
zdeflate.pas compress data using the deflation algorithm
zinflate.pas zlib interface to inflate modules
zlib.pas zlib data structures. read the comments there!
zuncompr.pas decompress a memory buffer
zutil.pas
minizip/ziputils.pas data structure and IO on .zip file
minizip/unzip.pas
minizip/zip.pas
Test applications
example.pas usage example of the zlib compression library
minigzip.pas simulate gzip using the zlib compression library
minizip/miniunz.pas simulates unzip using the zlib compression library
minizip/minizip.pas simulates zip using the zlib compression library
Legal issues
============
Copyright (C) 1998,1999,2000 by Jacques Nomssi Nzali
This software is provided 'as-is', without any express or implied
warranty. In no event will the author 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.
Archive Locations:
==================
Check the Paszlib home page with links
http://www.tu-chemnitz.de/~nomssi/paszlib.html
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).
These documents are also available in other formats from
ftp://ftp.uu.net/graphics/png/documents/zlib/zdoc-index.html.
____________________________________________________________________________
Jacques Nomssi Nzali <mailto:nomssi@physik.tu-chemnitz.de> March 24th, 2000