{$IFDEF FPC} {$DEFINE NOT_USE_KOL_ERR} {$MODE Delphi} {$ASMMODE intel} {$GOTO ON} {$ENDIF} unit MZLib; // Original copyright of the creators: // // 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://deststate.internic.net/rfc/rfc1950.txt (zlib format), rfc1951.txt (Deflate format) and rfc1952.txt (gzip format). // // patch 112 from the zlib home page is implicitly applied here // // Delphi translation: (C) 2000 by Dipl. Ing. Mike Lischke ////////////////////////////////////////////////// // Converted to KOL by Dimaxx (dimaxx@atnet.ru) // ////////////////////////////////////////////////// interface {$ALIGN OFF} {$I KOLDEF.INC} uses Windows, KOL; // 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. // // 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. //----------------- general library stuff ------------------------------------------------------------------------------ resourcestring SNeedDict = 'need dictionary'; SStreamEnd = 'stream end'; SFileError = 'file error'; SStreamError = 'stream error'; SDataError = 'data error'; SInsufficientMemory = 'insufficient memory'; SBufferError = 'buffer error'; SIncompatibleVersion = 'incompatible version'; SInvalidDistanceCode = 'invalid distance code'; SInvalidLengthCode = 'invalid literal/length code'; SOversubscribedDBLTree = 'oversubscribed dynamic bit lengths tree'; SIncompleteDBLTree = 'incomplete dynamic bit lengths tree'; SOversubscribedLLTree = 'oversubscribed literal/length tree'; SIncompleteLLTree = 'incomplete literal/length tree'; SEmptyDistanceTree = 'empty distance tree with lengths'; SInvalidBlockType = 'invalid block type'; SInvalidStoredBlockLengths = 'invalid stored block lengths'; STooManyLDSymbols = 'too many length or distance symbols'; SInvalidBitLengthRepeat = 'invalid bit length repeat'; SIncorrectDataCheck = 'incorrect data check'; SUnknownCompression = 'unknown compression method'; SInvalidWindowSize = 'invalid window size'; SIncorrectHeaderCheck = 'incorrect header check'; SNeedDictionary = 'need dictionary'; type PWord = ^Word; PInteger = ^Integer; PCardinal = ^Cardinal; type TByteArray = array[0..(MaxInt div sizeof(Byte))-1] of byte; PByteArray = ^TByteArray; TWordArray = array[0..(MaxInt div sizeof(Word))-1] of word; PWordArray = ^TWordArray; TIntegerArray = array[0..(MaxInt div sizeof(Integer))-1] of integer; PIntegerArray = ^TIntegerArray; TCardinalArray = array[0..(MaxInt div sizeof(Cardinal))-1] of cardinal; PCardinalArray = ^TCardinalArray; const // maximum value for MemLevel in DeflateInit2 MAX_MEM_LEVEL = 9; DEF_MEM_LEVEL = 8; // maximum value for WindowBits in DeflateInit2 and InflateInit2 MAX_WBITS = 15; // 32K LZ77 window // default WindowBits for decompression, MAX_WBITS is for compression only DEF_WBITS = MAX_WBITS; type PInflateHuft = ^TInflateHuft; TInflateHuft = packed record Exop, // number of extra bits or operation Bits: byte; // number of bits in this code or subcode Base: cardinal; // literal, Length base, or distance base or table offset end; THuftField = array[0..(MaxInt div sizeof(TInflateHuft))-1] of TInflateHuft; PHuftField = ^THuftField; PPInflateHuft = ^PInflateHuft; TInflateCodesMode = ( // waiting for "I:"=input, "O:"=output, "X:"=nothing icmStart, // X: set up for Len icmLen, // I: get length/literal/eob next icmLenNext, // I: getting length extra (have base) icmDistance, // I: get distance next icmDistExt, // I: getting distance extra icmCopy, // O: copying bytes in window, waiting for space icmLit, // O: got literal, waiting for output space icmWash, // O: got eob, possibly still output waiting icmZEnd, // X: got eob and all data flushed icmBadCode // X: got error ); // inflate codes private state PInflateCodesState = ^TInflateCodesState; TInflateCodesState = record Mode: TInflateCodesMode; // current inflate codes mode // mode dependent information Len: Cardinal; Sub: record // submode case Byte of 0: (Code: record // if Len or Distance, where in tree Tree: PInflateHuft; // pointer into tree need: Cardinal; // bits needed end); 1: (lit: Cardinal); // if icmLit, literal 2: (copy: record // if EXT or icmCopy, where and how much get: Cardinal; // bits to get for extra Distance: Cardinal; // distance back to copy from end); end; // mode independent information LiteralTreeBits: Byte; // LiteralTree bits decoded per branch DistanceTreeBits: Byte; // DistanceTree bits decoder per branch LiteralTree: PInflateHuft; // literal/length/eob tree DistanceTree: PInflateHuft; // distance tree end; TCheckFunction = function(Check: Cardinal; Buffer: PByte; Len: Cardinal): Cardinal; TInflateBlockMode = ( ibmZType, // get type bits (3, including end bit) ibmLens, // get lengths for stored ibmStored, // processing stored block ibmTable, // get table lengths ibmBitTree, // get bit lengths tree for a dynamic block ibmDistTree, // get length, distance trees for a dynamic block ibmCodes, // processing fixed or dynamic block ibmDry, // output remaining window bytes ibmBlockDone, // finished last block, done ibmBlockBad // got a data error -> stuck here ); // inflate blocks semi-private state PInflateBlocksState = ^TInflateBlocksState; TInflateBlocksState = record Mode: TInflateBlockMode; // current inflate block mode // mode dependent information Sub: record // submode case Byte of 0: (left: Cardinal); // if ibmStored, bytes left to copy 1: (Trees: record // if DistanceTree, decoding info for trees Table: Cardinal; // table lengths (14 Bits) Index: Cardinal; // index into blens (or BitOrder) blens: PCardinalArray; // bit lengths of codes BB: Cardinal; // bit length tree depth TB: PInflateHuft; // bit length decoding tree end); 2: (decode: record // if ibmCodes, current state TL: PInflateHuft; TD: PInflateHuft; // trees to free codes: PInflateCodesState; end); end; Last: Boolean; // True if this block is the last block // mode independent information bitk: Cardinal; // bits in bit buffer bitb: Cardinal; // bit buffer hufts: PHuftField; // single allocation for tree space window: PByte; // sliding window zend: PByte; // one byte after sliding window read: PByte; // window read pointer write: PByte; // window write pointer CheckFunction: TCheckFunction; // check function Check: Cardinal; // check on output end; TInflateMode = ( imMethod, // waiting for imMethod Byte imFlag, // waiting for flag byte imDict4, // four dictionary check bytes to go imDict3, // three dictionary check bytes to go imDict2, // two dictionary check bytes to go imDict1, // one dictionary check byte to go imDict0, // waiting for InflateSetDictionary imBlocks, // decompressing blocks imCheck4, // four check bytes to go imCheck3, // three check bytes to go imCheck2, // two check bytes to go imCheck1, // one check byte to go imDone, // finished check, done imBad // got an error -> stay here ); // inflate private state PInternalState = ^TInternalState; TInternalState = record Mode: TInflateMode; // current inflate mode // mode dependent information Sub: record // submode case Byte of 0: (imMethod: Cardinal); // if FLAGS, imMethod byte 1: (Check: record // if check, check values to compare was: Cardinal; // computed check value need: Cardinal; // stream check value end); 2: (marker: Cardinal); // if imBad, InflateSync's marker bytes count end; // mode independent information nowrap: Boolean; // flag for no wrapper wbits: Cardinal; // log2(window Size) (8..15, defaults to 15) blocks: PInflateBlocksState; // current InflateBlocks state end; // The application must update NextInput and AvailableInput when AvailableInput has dropped to zero. It must update // NextOutput and AvailableOutput when AvailableOutput has dropped to zero. All other fields are set by the // compression library and must not be updated by the application. // // The fields TotalInput and TotalOutput can be used for statistics or progress reports. After compression, TotalInput // 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). PZState = ^TZState; TZState = record NextInput: PByte; // next input byte AvailableInput: Cardinal; // number of bytes available at NextInput TotalInput: Cardinal; // total number of input bytes read so far NextOutput: PByte; // next output byte should be put there AvailableOutput: Cardinal; // remaining free space at NextOutput TotalOutput: Cardinal; // total number of bytes output so far Msg: String; // last error message, '' if no error State: PInternalState; // not visible by applications DataType: Integer; // best guess about the data type: ASCII or binary Adler: Cardinal; // Adler32 value of the uncompressed data end; const // allowed flush values, see Deflate below for details Z_NO_FLUSH = 0; Z_PARTIAL_FLUSH = 1; Z_SYNC_FLUSH = 2; Z_FULL_FLUSH = 3; Z_FINISH = 4; // Return codes for the compression/decompression functions. Negative // values are errors, positive values are used for special but normal events. 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; // compression levels Z_DEFAULT_COMPRESSION = -1; Z_NO_COMPRESSION = 0; Z_BEST_SPEED = 1; Z_BEST_COMPRESSION = 9; // compression strategy, see DeflateInit2 below for details Z_DEFAULT_STRATEGY = 0; Z_FILTERED = 1; Z_HUFFMAN_ONLY = 2; // possible values of the DataType field Z_BINARY = 0; Z_ASCII = 1; Z_UNKNOWN = 2; // the Deflate compression imMethod (the only one supported in this Version) Z_DEFLATED = 8; // three kinds of block type STORED_BLOCK = 0; STATIC_TREES = 1; DYN_TREES = 2; // minimum and maximum match lengths MIN_MATCH = 3; MAX_MATCH = 258; // preset dictionary flag in zlib header PRESET_DICT = $20; ZLIB_VERSION: String[10] = '1.1.2'; ERROR_BASE = Z_NEED_DICT; ErrorMessages: array[0..9] of String = ( SNeedDict, // Z_NEED_DICT 2 SStreamEnd, // Z_STREAM_END 1 '', // Z_OK 0 SFileError, // Z_ERRNO -1 SStreamError, // Z_STREAM_ERROR -2 SDataError, // Z_DATA_ERROR -3 SInsufficientMemory, // Z_MEM_ERROR -4 SBufferError, // Z_BUF_ERROR -5 SIncompatibleVersion, // Z_VERSION_ERROR -6 ''); function zError(Error: Integer): String; function CRC32(CRC: Cardinal; Buffer: PByte; Len: Cardinal): Cardinal; //----------------- deflation support ---------------------------------------------------------------------------------- function DeflateInit(var ZState: TZState; Level: Integer): Integer; function DeflateInit_(ZState: PZState; Level: Integer; const Version: String; StreamSize: Integer): Integer; function Deflate(var ZState: TZState; Flush: Integer): Integer; function DeflateEnd(var ZState: TZState): Integer; // The following functions are needed only in some special applications. function DeflateInit2(var ZState: TZState; Level: Integer; Method: Byte; AWindowBits: Integer; MemLevel: Integer; Strategy: Integer): Integer; function DeflateSetDictionary(var ZState: TZState; Dictionary: PByte; DictLength: Cardinal): Integer; function DeflateCopy(Dest: PZState; Source: PZState): Integer; function DeflateReset(var ZState: TZState): Integer; function DeflateParams(var ZState: TZState; Level: Integer; Strategy: Integer): Integer; const LENGTH_CODES = 29; // number of length codes, not counting the special END_BLOCK code LITERALS = 256; // number of literal bytes 0..255 L_CODES = (LITERALS+1+LENGTH_CODES); // number of literal or length codes, including the END_BLOCK code D_CODES = 30; // number of distance codes BL_CODES = 19; // number of codes used to transfer the bit lengths HEAP_SIZE = (2*L_CODES+1); // maximum heap size MAX_BITS = 15; // all codes must not exceed MAX_BITS bits // stream status INIT_STATE = 42; BUSY_STATE = 113; FINISH_STATE = 666; type // data structure describing a single value and its code string PTreeEntry = ^TTreeEntry; TTreeEntry = record fc: record case Byte of 0: (Frequency: Word); // frequency count 1: (Code: Word); // bit string end; dl: record case Byte of 0: (dad: Word); // father node in Huffman tree 1: (Len: Word); // length of bit string end; end; TLiteralTree = array[0..HEAP_SIZE - 1] of TTreeEntry; // literal and length tree TDistanceTree = array[0..2 * D_CODES] of TTreeEntry; // distance tree THuffmanTree = array[0..2 * BL_CODES] of TTreeEntry; // Huffman tree for bit lengths PTree = ^TTree; TTree = array[0..(MaxInt div SizeOf(TTreeEntry)) - 1] of TTreeEntry; // generic tree type PStaticTreeDescriptor = ^TStaticTreeDescriptor; TStaticTreeDescriptor = record StaticTree: PTree; // static tree or nil ExtraBits: PIntegerArray; // extra bits for each code or nil ExtraBase: Integer; // base index for ExtraBits Elements: Integer; // max number of elements in the tree MaxLength: Integer; // max bit length for the codes end; PTreeDescriptor = ^TTreeDescriptor; TTreeDescriptor = record DynamicTree: PTree; MaxCode: Integer; // largest code with non zero frequency StaticDescriptor: PStaticTreeDescriptor; // the corresponding static tree end; PDeflateState = ^TDeflateState; TDeflateState = record ZState: PZState; // pointer back to this zlib stream Status: Integer; // as the name implies PendingBuffer: PByteArray; // output still pending PendingBufferSize: Integer; PendingOutput: PByte; // next pending byte to output to the stream Pending: Integer; // nb of bytes in the pending buffer NoHeader: Integer; // suppress zlib header and Adler32 DataType: Byte; // UNKNOWN, BINARY or ASCII imMethod: Byte; // ibmStored (for zip only) or DEFLATED LastFlush: Integer; // Value of flush param for previous deflate call WindowSize: Cardinal; // LZ77 window size (32K by default) WindowBits: Cardinal; // log2(WindowSize) (8..16) WindowMask: Cardinal; // WindowSize - 1 // Sliding window. Input bytes are read into the second half of the window, // and move to the first half later to keep a dictionary of at least WSize // bytes. With this organization, matches are limited to a distance of // WSize - MAX_MATCH bytes, but this ensures that IO is always // performed with a length multiple of the block Size. Also, it limits // the window Size to 64K, which is quite useful on MSDOS. // To do: use the user input buffer as sliding window. Window: PByteArray; // Actual size of Window: 2 * WSize, except when the user input buffer // is directly used as sliding window. CurrentWindowSize: Integer; // Link to older string with same hash index. to limit the size of this // array to 64K, this link is maintained only for the last 32K strings. // An index in this array is thus a window index modulo 32K. Previous: PWordArray; Head: PWordArray; // heads of the hash chains or nil InsertHash: Cardinal; // hash index of string to be inserted HashSize: Cardinal; // number of elements in hash table HashBits: Cardinal; // log2(HashSize) HashMask: Cardinal; // HashSize - 1 // Number of bits by which InsertHash must be shifted at each input step. // It must be such that after MIN_MATCH steps, the oldest byte no longer // takes part in the hash key, that is: // HashShift * MIN_MATCH >= HashBits HashShift: Cardinal; // Window position at the beginning of the current output block. Gets // negative when the window is moved backwards. BlockStart: Integer; MatchLength: Cardinal; // length of best match PreviousMatch: Cardinal; // previous match MatchAvailable: Boolean; // set if previous match exists StringStart: Cardinal; // start of string to insert MatchStart: Cardinal; // start of matching string Lookahead: Cardinal; // number of valid bytes ahead in window // Length of the best match at previous step. Matches not greater than this // are discarded. This is used in the lazy match evaluation. PreviousLength: Cardinal; // To speed up deflation hash chains are never searched beyond this // Length. A higher limit improves compression ratio but degrades the speed. MaxChainLength: Cardinal; Level: Integer; // compression level (1..9) Strategy: Integer; // favor or force Huffman coding GoodMatch: Cardinal; // use a faster search when the previous match is longer than this NiceMatch: Cardinal; // stop searching when current match exceeds this LiteralTree: TLiteralTree; // literal and length tree DistanceTree: TDistanceTree; // distance tree BitLengthTree: THuffmanTree; // Huffman tree for bit lengths LiteralDescriptor: TTreeDescriptor; // Descriptor for literal tree DistanceDescriptor: TTreeDescriptor; // Descriptor for distance tree BitLengthDescriptor: TTreeDescriptor; // Descriptor for bit length tree BitLengthCounts: array[0..MAX_BITS] of Word; // number of codes at each bit length for an optimal tree Heap: array[0..2 * L_CODES] of Integer; // heap used to build the Huffman trees HeapLength: Integer; // number of elements in the heap HeapMaximum: Integer; // element of largest frequency // The sons of Heap[N] are Heap[2 * N] and Heap[2 * N + 1]. Heap[0] is not used. // The same heap array is used to build all trees. Depth: array[0..2 * L_CODES] of Byte; // depth of each subtree used as tie breaker for trees of equal frequency LiteralBuffer: PByteArray; // buffer for literals or lengths // Size of match buffer for literals/lengths. There are 4 reasons for limiting LiteralBufferSize to 64K: // - frequencies can be kept in 16 bit counters // - If compression is not successful for the first block, all input // data is still in the window so we can still emit a stored block even // when input comes from standard input. This can also be done for // all blocks if LiteralBufferSize is not greater than 32K. // - if compression is not successful for a file smaller than 64K, we can // even emit a stored file instead of a stored block (saving 5 bytes). // This is applicable only for zip (not gzip or zlib). // - creating new Huffman trees less frequently may not provide fast // adaptation to changes in the input data statistics. (Take for // example a binary file with poorly compressible code followed by // a highly compressible string table.) Smaller buffer sizes give // fast adaptation but have of course the overhead of transmitting // trees more frequently. // - I can't count above 4 LiteralBufferSize: Cardinal; LastLiteral: Cardinal; // running index in LiteralBuffer // Buffer for distances. To simplify the code, DistanceBuffer and LiteralBuffer have // the same number of elements. To use different lengths, an extra flag array would be necessary. DistanceBuffer: PWordArray; OptimalLength: Integer; // bit length of current block with optimal trees StaticLength: Integer; // bit length of current block with static trees CompressedLength: Integer; // total bit length of compressed file Matches: Cardinal; // number of string matches in current block LastEOBLength: Integer; // bit length of EOB code for last block BitsBuffer: Word; // Output buffer. Bits are inserted starting at the bottom (least significant bits). ValidBits: Integer; // Number of valid bits in BitsBuffer. All Bits above the last valid bit are always zero. case Byte of 0: // Attempt to find a better match only when the current match is strictly smaller than this value. // This mechanism is used only for compression levels >= 4. (MaxLazyMatch: Cardinal); 1: // Insert new strings in the hash table only if the match Length is not greater than this length. This saves // time but degrades compression. MaxInsertLength is used only for compression levels <= 3. (MaxInsertLength: Cardinal); end; //----------------- inflation support ---------------------------------------------------------------------------------- function InflateInit(var Z: TZState): Integer; function InflateInit_(var Z: TZState; const Version: String; StreamSize: Integer): Integer; function InflateInit2_(var Z: TZState; W: Integer; const Version: String; StreamSize: Integer): Integer; function InflateInit2(var Z: TZState; AWindowBits: Integer): Integer; function InflateEnd(var Z: TZState): Integer; function InflateReset(var Z: TZState): Integer; function Inflate(var Z: TZState; F: Integer): Integer; function InflateSetDictionary(var Z: TZState; Dictionary: PByte; DictLength: Cardinal): Integer; function InflateSync(var Z: TZState): Integer; function IsInflateSyncPoint(var Z: TZState): Integer; //---------------------------------------------------------------------------------------------------------------------- implementation const // Adler checksum Base = Cardinal(65521); // largest prime smaller than 65536 NMAX = 3854; // Code with signed 32 bit integer type LH = record L, H: Word; end; //---------------------------------------------------------------------------------------------------------------------- function zError(Error: Integer): String; begin Result:=ErrorMessages[Z_NEED_DICT - Error]; end; //---------------------------------------------------------------------------------------------------------------------- function Adler32(Adler: Cardinal; Buffer: PByte; Len: Cardinal): Cardinal; var s1, s2: Cardinal; K: Integer; begin s1:=Adler and $FFFF; s2:=(Adler shr 16) and $FFFF; if Buffer = nil then Result:=1 else begin while Len > 0 do begin if Len < NMAX then K:=Len else K:=NMAX; Dec(Len, K); while K > 0 do begin Inc(s1, Buffer^); Inc(s2, s1); Inc(Buffer); Dec(K); end; s1:=s1 mod Base; s2:=s2 mod Base; end; Result:=(s2 shl 16) or s1; end; end; //---------------------------------------------------------------------------------------------------------------------- var // used to calculate the running CRC of a bunch of bytes, // this table is dynamically created in order to save space if never needed CRCTable: array of Cardinal; procedure MakeCRCTable; // creates the CRC table when it is needed the first time var C: Cardinal; N, K : Integer; Poly: Cardinal; // polynomial exclusive-or pattern const // terms of polynomial defining this CRC (except x^32) P: array [0..13] of Byte = (0, 1, 2, 4, 5, 7, 8, 10, 11, 12, 16, 22, 23, 26); begin // make exclusive-or pattern from polynomial ($EDB88320) SetLength(CRCTable, 256); Poly:=0; for N:=0 to SizeOf(P) - 1 do Poly:=Poly or (1 shl (31 - P[N])); for N:=0 to 255 do begin C:=N; for K:=0 to 7 do begin if (C and 1)<>0 then C:=Poly xor (C shr 1) else C:=C shr 1; end; CRCTable[N]:=C; end; end; //---------------------------------------------------------------------------------------------------------------------- function CRC32(CRC: Cardinal; Buffer: PByte; Len: Cardinal): Cardinal; // Generate a table for a byte-wise 32-bit CRC calculation on the polynomial: // x^32+x^26+x^23+x^22+x^16+x^12+x^11+x^10+x^8+x^7+x^5+x^4+x^2+x+1. // // Polynomials over GF(2) are represented in binary, one bit per coefficient, // with the lowest powers in the most significant bit. Then adding polynomials // is just exclusive-or, and multiplying a polynomial by x is a right shift by // one. If we call the above polynomial p, and represent a byte as the // polynomial q, also with the lowest power in the most significant bit (so the // byte 0xb1 is the polynomial x^7+x^3+x+1), then the CRC is (q*x^32) mod p, // where a mod b means the remainder after dividing a by b. // // This calculation is done using the shift-register method of multiplying and // taking the remainder. The register is initialized to zero, and for each // incoming bit, x^32 is added mod p to the register if the bit is a one (where // x^32 mod p is p+x^32 = x^26+...+1), and the register is multiplied mod p by // x (which is shifting right by one and adding x^32 mod p if the bit shifted // out is a one). We start with the highest power (least significant bit) of // q and repeat for all eight bits of q. // // The table is simply the CRC of all possible eight bit values. This is all // the information needed to generate CRC's on data a byte at a time for all // combinations of CRC register values and incoming bytes. begin if Buffer = nil then Result:=0 else begin if CRCTable = nil then MakeCRCTable; CRC:=CRC xor $FFFFFFFF; while Len >= 8 do begin CRC:=CRCTable[Byte(CRC) xor Buffer^] xor (CRC shr 8); Inc(Buffer); CRC:=CRCTable[Byte(CRC) xor Buffer^] xor (CRC shr 8); Inc(Buffer); CRC:=CRCTable[Byte(CRC) xor Buffer^] xor (CRC shr 8); Inc(Buffer); CRC:=CRCTable[Byte(CRC) xor Buffer^] xor (CRC shr 8); Inc(Buffer); CRC:=CRCTable[Byte(CRC) xor Buffer^] xor (CRC shr 8); Inc(Buffer); CRC:=CRCTable[Byte(CRC) xor Buffer^] xor (CRC shr 8); Inc(Buffer); CRC:=CRCTable[Byte(CRC) xor Buffer^] xor (CRC shr 8); Inc(Buffer); CRC:=CRCTable[Byte(CRC) xor Buffer^] xor (CRC shr 8); Inc(Buffer); Dec(Len, 8); end; while Len > 0 do begin CRC:=CRCTable[(CRC xor Buffer^) and $FF] xor (CRC shr 8); Inc(Buffer); Dec(Len); end; Result:=CRC xor $FFFFFFFF; end; end; //----------------- Huffmann trees ------------------------------------------------------------------------------------- const DIST_CODE_LEN = 512; // see definition of array dist_code below // The static literal tree. Since the bit lengths are imposed, there is no need for the L_CODES Extra codes used // during heap construction. However the codes 286 and 287 are needed to build a canonical tree (see TreeInit below). StaticLiteralTree: array[0..L_CODES + 1] of TTreeEntry = ( (fc: (Frequency: 12); dl: (Len: 8)), (fc: (Frequency: 140); dl: (Len: 8)), (fc: (Frequency: 76); dl: (Len: 8)), (fc: (Frequency: 204); dl: (Len: 8)), (fc: (Frequency: 44); dl: (Len: 8)), (fc: (Frequency: 172); dl: (Len: 8)), (fc: (Frequency: 108); dl: (Len: 8)), (fc: (Frequency: 236); dl: (Len: 8)), (fc: (Frequency: 28); dl: (Len: 8)), (fc: (Frequency: 156); dl: (Len: 8)), (fc: (Frequency: 92); dl: (Len: 8)), (fc: (Frequency: 220); dl: (Len: 8)), (fc: (Frequency: 60); dl: (Len: 8)), (fc: (Frequency: 188); dl: (Len: 8)), (fc: (Frequency: 124); dl: (Len: 8)), (fc: (Frequency: 252); dl: (Len: 8)), (fc: (Frequency: 2); dl: (Len: 8)), (fc: (Frequency: 130); dl: (Len: 8)), (fc: (Frequency: 66); dl: (Len: 8)), (fc: (Frequency: 194); dl: (Len: 8)), (fc: (Frequency: 34); dl: (Len: 8)), (fc: (Frequency: 162); dl: (Len: 8)), (fc: (Frequency: 98); dl: (Len: 8)), (fc: (Frequency: 226); dl: (Len: 8)), (fc: (Frequency: 18); dl: (Len: 8)), (fc: (Frequency: 146); dl: (Len: 8)), (fc: (Frequency: 82); dl: (Len: 8)), (fc: (Frequency: 210); dl: (Len: 8)), (fc: (Frequency: 50); dl: (Len: 8)), (fc: (Frequency: 178); dl: (Len: 8)), (fc: (Frequency: 114); dl: (Len: 8)), (fc: (Frequency: 242); dl: (Len: 8)), (fc: (Frequency: 10); dl: (Len: 8)), (fc: (Frequency: 138); dl: (Len: 8)), (fc: (Frequency: 74); dl: (Len: 8)), (fc: (Frequency: 202); dl: (Len: 8)), (fc: (Frequency: 42); dl: (Len: 8)), (fc: (Frequency: 170); dl: (Len: 8)), (fc: (Frequency: 106); dl: (Len: 8)), (fc: (Frequency: 234); dl: (Len: 8)), (fc: (Frequency: 26); dl: (Len: 8)), (fc: (Frequency: 154); dl: (Len: 8)), (fc: (Frequency: 90); dl: (Len: 8)), (fc: (Frequency: 218); dl: (Len: 8)), (fc: (Frequency: 58); dl: (Len: 8)), (fc: (Frequency: 186); dl: (Len: 8)), (fc: (Frequency: 122); dl: (Len: 8)), (fc: (Frequency: 250); dl: (Len: 8)), (fc: (Frequency: 6); dl: (Len: 8)), (fc: (Frequency: 134); dl: (Len: 8)), (fc: (Frequency: 70); dl: (Len: 8)), (fc: (Frequency: 198); dl: (Len: 8)), (fc: (Frequency: 38); dl: (Len: 8)), (fc: (Frequency: 166); dl: (Len: 8)), (fc: (Frequency: 102); dl: (Len: 8)), (fc: (Frequency: 230); dl: (Len: 8)), (fc: (Frequency: 22); dl: (Len: 8)), (fc: (Frequency: 150); dl: (Len: 8)), (fc: (Frequency: 86); dl: (Len: 8)), (fc: (Frequency: 214); dl: (Len: 8)), (fc: (Frequency: 54); dl: (Len: 8)), (fc: (Frequency: 182); dl: (Len: 8)), (fc: (Frequency: 118); dl: (Len: 8)), (fc: (Frequency: 246); dl: (Len: 8)), (fc: (Frequency: 14); dl: (Len: 8)), (fc: (Frequency: 142); dl: (Len: 8)), (fc: (Frequency: 78); dl: (Len: 8)), (fc: (Frequency: 206); dl: (Len: 8)), (fc: (Frequency: 46); dl: (Len: 8)), (fc: (Frequency: 174); dl: (Len: 8)), (fc: (Frequency: 110); dl: (Len: 8)), (fc: (Frequency: 238); dl: (Len: 8)), (fc: (Frequency: 30); dl: (Len: 8)), (fc: (Frequency: 158); dl: (Len: 8)), (fc: (Frequency: 94); dl: (Len: 8)), (fc: (Frequency: 222); dl: (Len: 8)), (fc: (Frequency: 62); dl: (Len: 8)), (fc: (Frequency: 190); dl: (Len: 8)), (fc: (Frequency: 126); dl: (Len: 8)), (fc: (Frequency: 254); dl: (Len: 8)), (fc: (Frequency: 1); dl: (Len: 8)), (fc: (Frequency: 129); dl: (Len: 8)), (fc: (Frequency: 65); dl: (Len: 8)), (fc: (Frequency: 193); dl: (Len: 8)), (fc: (Frequency: 33); dl: (Len: 8)), (fc: (Frequency: 161); dl: (Len: 8)), (fc: (Frequency: 97); dl: (Len: 8)), (fc: (Frequency: 225); dl: (Len: 8)), (fc: (Frequency: 17); dl: (Len: 8)), (fc: (Frequency: 145); dl: (Len: 8)), (fc: (Frequency: 81); dl: (Len: 8)), (fc: (Frequency: 209); dl: (Len: 8)), (fc: (Frequency: 49); dl: (Len: 8)), (fc: (Frequency: 177); dl: (Len: 8)), (fc: (Frequency: 113); dl: (Len: 8)), (fc: (Frequency: 241); dl: (Len: 8)), (fc: (Frequency: 9); dl: (Len: 8)), (fc: (Frequency: 137); dl: (Len: 8)), (fc: (Frequency: 73); dl: (Len: 8)), (fc: (Frequency: 201); dl: (Len: 8)), (fc: (Frequency: 41); dl: (Len: 8)), (fc: (Frequency: 169); dl: (Len: 8)), (fc: (Frequency: 105); dl: (Len: 8)), (fc: (Frequency: 233); dl: (Len: 8)), (fc: (Frequency: 25); dl: (Len: 8)), (fc: (Frequency: 153); dl: (Len: 8)), (fc: (Frequency: 89); dl: (Len: 8)), (fc: (Frequency: 217); dl: (Len: 8)), (fc: (Frequency: 57); dl: (Len: 8)), (fc: (Frequency: 185); dl: (Len: 8)), (fc: (Frequency: 121); dl: (Len: 8)), (fc: (Frequency: 249); dl: (Len: 8)), (fc: (Frequency: 5); dl: (Len: 8)), (fc: (Frequency: 133); dl: (Len: 8)), (fc: (Frequency: 69); dl: (Len: 8)), (fc: (Frequency: 197); dl: (Len: 8)), (fc: (Frequency: 37); dl: (Len: 8)), (fc: (Frequency: 165); dl: (Len: 8)), (fc: (Frequency: 101); dl: (Len: 8)), (fc: (Frequency: 229); dl: (Len: 8)), (fc: (Frequency: 21); dl: (Len: 8)), (fc: (Frequency: 149); dl: (Len: 8)), (fc: (Frequency: 85); dl: (Len: 8)), (fc: (Frequency: 213); dl: (Len: 8)), (fc: (Frequency: 53); dl: (Len: 8)), (fc: (Frequency: 181); dl: (Len: 8)), (fc: (Frequency: 117); dl: (Len: 8)), (fc: (Frequency: 245); dl: (Len: 8)), (fc: (Frequency: 13); dl: (Len: 8)), (fc: (Frequency: 141); dl: (Len: 8)), (fc: (Frequency: 77); dl: (Len: 8)), (fc: (Frequency: 205); dl: (Len: 8)), (fc: (Frequency: 45); dl: (Len: 8)), (fc: (Frequency: 173); dl: (Len: 8)), (fc: (Frequency: 109); dl: (Len: 8)), (fc: (Frequency: 237); dl: (Len: 8)), (fc: (Frequency: 29); dl: (Len: 8)), (fc: (Frequency: 157); dl: (Len: 8)), (fc: (Frequency: 93); dl: (Len: 8)), (fc: (Frequency: 221); dl: (Len: 8)), (fc: (Frequency: 61); dl: (Len: 8)), (fc: (Frequency: 189); dl: (Len: 8)), (fc: (Frequency: 125); dl: (Len: 8)), (fc: (Frequency: 253); dl: (Len: 8)), (fc: (Frequency: 19); dl: (Len: 9)), (fc: (Frequency: 275); dl: (Len: 9)), (fc: (Frequency: 147); dl: (Len: 9)), (fc: (Frequency: 403); dl: (Len: 9)), (fc: (Frequency: 83); dl: (Len: 9)), (fc: (Frequency: 339); dl: (Len: 9)), (fc: (Frequency: 211); dl: (Len: 9)), (fc: (Frequency: 467); dl: (Len: 9)), (fc: (Frequency: 51); dl: (Len: 9)), (fc: (Frequency: 307); dl: (Len: 9)), (fc: (Frequency: 179); dl: (Len: 9)), (fc: (Frequency: 435); dl: (Len: 9)), (fc: (Frequency: 115); dl: (Len: 9)), (fc: (Frequency: 371); dl: (Len: 9)), (fc: (Frequency: 243); dl: (Len: 9)), (fc: (Frequency: 499); dl: (Len: 9)), (fc: (Frequency: 11); dl: (Len: 9)), (fc: (Frequency: 267); dl: (Len: 9)), (fc: (Frequency: 139); dl: (Len: 9)), (fc: (Frequency: 395); dl: (Len: 9)), (fc: (Frequency: 75); dl: (Len: 9)), (fc: (Frequency: 331); dl: (Len: 9)), (fc: (Frequency: 203); dl: (Len: 9)), (fc: (Frequency: 459); dl: (Len: 9)), (fc: (Frequency: 43); dl: (Len: 9)), (fc: (Frequency: 299); dl: (Len: 9)), (fc: (Frequency: 171); dl: (Len: 9)), (fc: (Frequency: 427); dl: (Len: 9)), (fc: (Frequency: 107); dl: (Len: 9)), (fc: (Frequency: 363); dl: (Len: 9)), (fc: (Frequency: 235); dl: (Len: 9)), (fc: (Frequency: 491); dl: (Len: 9)), (fc: (Frequency: 27); dl: (Len: 9)), (fc: (Frequency: 283); dl: (Len: 9)), (fc: (Frequency: 155); dl: (Len: 9)), (fc: (Frequency: 411); dl: (Len: 9)), (fc: (Frequency: 91); dl: (Len: 9)), (fc: (Frequency: 347); dl: (Len: 9)), (fc: (Frequency: 219); dl: (Len: 9)), (fc: (Frequency: 475); dl: (Len: 9)), (fc: (Frequency: 59); dl: (Len: 9)), (fc: (Frequency: 315); dl: (Len: 9)), (fc: (Frequency: 187); dl: (Len: 9)), (fc: (Frequency: 443); dl: (Len: 9)), (fc: (Frequency: 123); dl: (Len: 9)), (fc: (Frequency: 379); dl: (Len: 9)), (fc: (Frequency: 251); dl: (Len: 9)), (fc: (Frequency: 507); dl: (Len: 9)), (fc: (Frequency: 7); dl: (Len: 9)), (fc: (Frequency: 263); dl: (Len: 9)), (fc: (Frequency: 135); dl: (Len: 9)), (fc: (Frequency: 391); dl: (Len: 9)), (fc: (Frequency: 71); dl: (Len: 9)), (fc: (Frequency: 327); dl: (Len: 9)), (fc: (Frequency: 199); dl: (Len: 9)), (fc: (Frequency: 455); dl: (Len: 9)), (fc: (Frequency: 39); dl: (Len: 9)), (fc: (Frequency: 295); dl: (Len: 9)), (fc: (Frequency: 167); dl: (Len: 9)), (fc: (Frequency: 423); dl: (Len: 9)), (fc: (Frequency: 103); dl: (Len: 9)), (fc: (Frequency: 359); dl: (Len: 9)), (fc: (Frequency: 231); dl: (Len: 9)), (fc: (Frequency: 487); dl: (Len: 9)), (fc: (Frequency: 23); dl: (Len: 9)), (fc: (Frequency: 279); dl: (Len: 9)), (fc: (Frequency: 151); dl: (Len: 9)), (fc: (Frequency: 407); dl: (Len: 9)), (fc: (Frequency: 87); dl: (Len: 9)), (fc: (Frequency: 343); dl: (Len: 9)), (fc: (Frequency: 215); dl: (Len: 9)), (fc: (Frequency: 471); dl: (Len: 9)), (fc: (Frequency: 55); dl: (Len: 9)), (fc: (Frequency: 311); dl: (Len: 9)), (fc: (Frequency: 183); dl: (Len: 9)), (fc: (Frequency: 439); dl: (Len: 9)), (fc: (Frequency: 119); dl: (Len: 9)), (fc: (Frequency: 375); dl: (Len: 9)), (fc: (Frequency: 247); dl: (Len: 9)), (fc: (Frequency: 503); dl: (Len: 9)), (fc: (Frequency: 15); dl: (Len: 9)), (fc: (Frequency: 271); dl: (Len: 9)), (fc: (Frequency: 143); dl: (Len: 9)), (fc: (Frequency: 399); dl: (Len: 9)), (fc: (Frequency: 79); dl: (Len: 9)), (fc: (Frequency: 335); dl: (Len: 9)), (fc: (Frequency: 207); dl: (Len: 9)), (fc: (Frequency: 463); dl: (Len: 9)), (fc: (Frequency: 47); dl: (Len: 9)), (fc: (Frequency: 303); dl: (Len: 9)), (fc: (Frequency: 175); dl: (Len: 9)), (fc: (Frequency: 431); dl: (Len: 9)), (fc: (Frequency: 111); dl: (Len: 9)), (fc: (Frequency: 367); dl: (Len: 9)), (fc: (Frequency: 239); dl: (Len: 9)), (fc: (Frequency: 495); dl: (Len: 9)), (fc: (Frequency: 31); dl: (Len: 9)), (fc: (Frequency: 287); dl: (Len: 9)), (fc: (Frequency: 159); dl: (Len: 9)), (fc: (Frequency: 415); dl: (Len: 9)), (fc: (Frequency: 95); dl: (Len: 9)), (fc: (Frequency: 351); dl: (Len: 9)), (fc: (Frequency: 223); dl: (Len: 9)), (fc: (Frequency: 479); dl: (Len: 9)), (fc: (Frequency: 63); dl: (Len: 9)), (fc: (Frequency: 319); dl: (Len: 9)), (fc: (Frequency: 191); dl: (Len: 9)), (fc: (Frequency: 447); dl: (Len: 9)), (fc: (Frequency: 127); dl: (Len: 9)), (fc: (Frequency: 383); dl: (Len: 9)), (fc: (Frequency: 255); dl: (Len: 9)), (fc: (Frequency: 511); dl: (Len: 9)), (fc: (Frequency: 0); dl: (Len: 7)), (fc: (Frequency: 64); dl: (Len: 7)), (fc: (Frequency: 32); dl: (Len: 7)), (fc: (Frequency: 96); dl: (Len: 7)), (fc: (Frequency: 16); dl: (Len: 7)), (fc: (Frequency: 80); dl: (Len: 7)), (fc: (Frequency: 48); dl: (Len: 7)), (fc: (Frequency: 112); dl: (Len: 7)), (fc: (Frequency: 8); dl: (Len: 7)), (fc: (Frequency: 72); dl: (Len: 7)), (fc: (Frequency: 40); dl: (Len: 7)), (fc: (Frequency: 104); dl: (Len: 7)), (fc: (Frequency: 24); dl: (Len: 7)), (fc: (Frequency: 88); dl: (Len: 7)), (fc: (Frequency: 56); dl: (Len: 7)), (fc: (Frequency: 120); dl: (Len: 7)), (fc: (Frequency: 4); dl: (Len: 7)), (fc: (Frequency: 68); dl: (Len: 7)), (fc: (Frequency: 36); dl: (Len: 7)), (fc: (Frequency: 100); dl: (Len: 7)), (fc: (Frequency: 20); dl: (Len: 7)), (fc: (Frequency: 84); dl: (Len: 7)), (fc: (Frequency: 52); dl: (Len: 7)), (fc: (Frequency: 116); dl: (Len: 7)), (fc: (Frequency: 3); dl: (Len: 8)), (fc: (Frequency: 131); dl: (Len: 8)), (fc: (Frequency: 67); dl: (Len: 8)), (fc: (Frequency: 195); dl: (Len: 8)), (fc: (Frequency: 35); dl: (Len: 8)), (fc: (Frequency: 163); dl: (Len: 8)), (fc: (Frequency: 99); dl: (Len: 8)), (fc: (Frequency: 227); dl: (Len: 8)) ); // The static distance tree. (Actually a trivial tree since all lens use 5 Bits.) StaticDescriptorTree: array[0..D_CODES - 1] of TTreeEntry = ( (fc: (Frequency: 0); dl: (Len: 5)), (fc: (Frequency: 16); dl: (Len: 5)), (fc: (Frequency: 8); dl: (Len: 5)), (fc: (Frequency: 24); dl: (Len: 5)), (fc: (Frequency: 4); dl: (Len: 5)), (fc: (Frequency: 20); dl: (Len: 5)), (fc: (Frequency: 12); dl: (Len: 5)), (fc: (Frequency: 28); dl: (Len: 5)), (fc: (Frequency: 2); dl: (Len: 5)), (fc: (Frequency: 18); dl: (Len: 5)), (fc: (Frequency: 10); dl: (Len: 5)), (fc: (Frequency: 26); dl: (Len: 5)), (fc: (Frequency: 6); dl: (Len: 5)), (fc: (Frequency: 22); dl: (Len: 5)), (fc: (Frequency: 14); dl: (Len: 5)), (fc: (Frequency: 30); dl: (Len: 5)), (fc: (Frequency: 1); dl: (Len: 5)), (fc: (Frequency: 17); dl: (Len: 5)), (fc: (Frequency: 9); dl: (Len: 5)), (fc: (Frequency: 25); dl: (Len: 5)), (fc: (Frequency: 5); dl: (Len: 5)), (fc: (Frequency: 21); dl: (Len: 5)), (fc: (Frequency: 13); dl: (Len: 5)), (fc: (Frequency: 29); dl: (Len: 5)), (fc: (Frequency: 3); dl: (Len: 5)), (fc: (Frequency: 19); dl: (Len: 5)), (fc: (Frequency: 11); dl: (Len: 5)), (fc: (Frequency: 27); dl: (Len: 5)), (fc: (Frequency: 7); dl: (Len: 5)), (fc: (Frequency: 23); dl: (Len: 5)) ); // Distance codes. The first 256 values correspond to the distances 3 .. 258, the last 256 values correspond to the // top 8 Bits of the 15 bit distances. DistanceCode: array[0..DIST_CODE_LEN - 1] of Byte = ( 0, 1, 2, 3, 4, 4, 5, 5, 6, 6, 6, 6, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 16, 17, 18, 18, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 22, 22, 22, 22, 22, 22, 22, 22, 23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29 ); // length code for each normalized match length (0 = MIN_MATCH) LengthCode: array[0..MAX_MATCH - MIN_MATCH] of Byte = ( 0, 1, 2, 3, 4, 5, 6, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 12, 12, 13, 13, 13, 13, 14, 14, 14, 14, 15, 15, 15, 15, 16, 16, 16, 16, 16, 16, 16, 16, 17, 17, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 18, 18, 18, 18, 19, 19, 19, 19, 19, 19, 19, 19, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 28 ); // first normalized length for each code (0 = MIN_MATCH) BaseLength: array[0..LENGTH_CODES - 1] of Integer = ( 0, 1, 2, 3, 4, 5, 6, 7, 8, 10, 12, 14, 16, 20, 24, 28, 32, 40, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 0 ); // first normalized distance for each code (0 = distance of 1) BaseDistance: array[0..D_CODES - 1] of Integer = ( 0, 1, 2, 3, 4, 6, 8, 12, 16, 24, 32, 48, 64, 96, 128, 192, 256, 384, 512, 768, 1024, 1536, 2048, 3072, 4096, 6144, 8192, 12288, 16384, 24576 ); MIN_LOOKAHEAD = (MAX_MATCH + MIN_MATCH + 1); MAX_BL_BITS = 7; // bit length codes must not exceed MAX_BL_BITS bits END_BLOCK = 256; // end of block literal code REP_3_6 = 16; // repeat previous bit length 3-6 times (2 Bits of repeat count) REPZ_3_10 = 17; // repeat a zero length 3-10 times (3 Bits of repeat count) REPZ_11_138 = 18; // repeat a zero length 11-138 times (7 Bits of repeat count) // extra bits for each length code ExtraLengthBits: array[0..LENGTH_CODES - 1] of Integer = ( 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 ); // extra bits for each distance code ExtraDistanceBits: array[0..D_CODES-1] of Integer = ( 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 ); // extra bits for each bit length code ExtraBitLengthBits: array[0..BL_CODES - 1] of Integer = ( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 3, 7 ); // The lengths of the bit length codes are sent in order of decreasing probability, // to avoid transmitting the lengths for unused bit length codes. BitLengthOrder: array[0..BL_CODES - 1] of Byte = ( 16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15 ); // Number of bits used within BitsBuffer. (BitsBuffer might be implemented on more than 16 bits on some systems.) BufferSize = 16; StaticLiteralDescriptor: TStaticTreeDescriptor = ( StaticTree: @StaticLiteralTree; // pointer to array of TTreeEntry ExtraBits: @ExtraLengthBits; // pointer to array of integer ExtraBase: LITERALS + 1; Elements: L_CODES; MaxLength: MAX_BITS ); StaticDistanceDescriptor: TStaticTreeDescriptor = ( StaticTree: @StaticDescriptorTree; ExtraBits: @ExtraDistanceBits; ExtraBase: 0; Elements: D_CODES; MaxLength: MAX_BITS ); StaticBitLengthDescriptor: TStaticTreeDescriptor = ( StaticTree: nil; ExtraBits: @ExtraBitLengthBits; ExtraBase: 0; Elements: BL_CODES; MaxLength: MAX_BL_BITS ); SMALLEST = 1; // index within the heap array of least frequent node in the Huffman tree //---------------------------------------------------------------------------------------------------------------------- procedure SendBits(var S: TDeflateState; Value: Word; Length: Integer); // Value contains what is to be sent // Length is the number of bits to send begin // If there's not enough room in BitsBuffer use (valid) bits from BitsBuffer and // (16 - ValidBits) bits from Value, leaving (width - (16 - ValidBits)) unused bits in Value. {$ifopt Q+} {$Q-} {$define OverflowCheck} {$endif} {$ifopt R+} {$R-} {$define RangeCheck} {$endif} if (S.ValidBits > Integer(BufferSize) - Length) then begin S.BitsBuffer:=S.BitsBuffer or (Value shl S.ValidBits); S.PendingBuffer[S.Pending]:=S.BitsBuffer and $FF; Inc(S.Pending); S.PendingBuffer[S.Pending]:=S.BitsBuffer shr 8; Inc(S.Pending); S.BitsBuffer:=Value shr (BufferSize - S.ValidBits); Inc(S.ValidBits, Length - BufferSize); end else begin S.BitsBuffer:=S.BitsBuffer or (Value shl S.ValidBits); Inc(S.ValidBits, Length); end; {$ifdef OverflowCheck} {$Q+} {$undef OverflowCheck} {$endif} {$ifdef RangeCheck} {$R+} {$undef RangeCheck} {$endif} end; //---------------------------------------------------------------------------------------------------------------------- function BitReverse(Code: Word; Len: Integer): Word; // Reverses the first Len bits of Code, using straightforward code (a faster // imMethod would use a table) begin Result:=0; repeat Result:=Result or (Code and 1); Code:=Code shr 1; Result:=Result shl 1; Dec(Len); until Len <= 0; Result:=Result shr 1; end; //---------------------------------------------------------------------------------------------------------------------- procedure GenerateCodes(Tree: PTree; MaxCode: Integer; const BitLengthCounts: array of Word); // Generates the codes for a given tree and bit counts (which need not be optimal). // The array BitLengthCounts contains the bit length statistics for the given tree and the field Len is set for all // Tree elements. MaxCode is the largest code with non zero frequency and BitLengthCounts are the number of codes at // each bit length. // On exit the field code is set for all tree elements of non zero code length. var NextCode: array[0..MAX_BITS] of Word; // next code value for each bit length Code: Word; // running code value Bits: Integer; // bit Index N: Integer; // code Index Len: Integer; begin Code:=0; // The distribution counts are first used to generate the code values without bit reversal. for Bits:=1 to MAX_BITS do begin Code:=(Code + BitLengthCounts[Bits - 1]) shl 1; NextCode[Bits]:=Code; end; // Check that the bit counts in BitLengthCounts are consistent. The last code must be all ones. for N:=0 to MaxCode do begin Len:=Tree[N].dl.Len; if Len = 0 then Continue; Tree[N].fc.Code:=BitReverse(NextCode[Len], Len); Inc(NextCode[Len]); end; end; //---------------------------------------------------------------------------------------------------------------------- procedure InitializeBlock(var S: TDeflateState); var N: Integer; begin // initialize the trees for N:=0 to L_CODES - 1 do S.LiteralTree[N].fc.Frequency:=0; for N:=0 to D_CODES - 1 do S.DistanceTree[N].fc.Frequency:=0; for N:=0 to BL_CODES - 1 do S.BitLengthTree[N].fc.Frequency:=0; S.LiteralTree[END_BLOCK].fc.Frequency:=1; S.StaticLength:=0; S.OptimalLength:=0; S.Matches:=0; S.LastLiteral:=0; end; //---------------------------------------------------------------------------------------------------------------------- procedure TreeInit(var S: TDeflateState); // initializes the tree data structures for a new zlib stream begin S.CompressedLength:=0; S.LiteralDescriptor.DynamicTree:=@S.LiteralTree; S.LiteralDescriptor.StaticDescriptor:=@StaticLiteralDescriptor; S.DistanceDescriptor.DynamicTree:=@S.DistanceTree; S.DistanceDescriptor.StaticDescriptor:=@StaticDistanceDescriptor; S.BitLengthDescriptor.DynamicTree:=@S.BitLengthTree; S.BitLengthDescriptor.StaticDescriptor:=@StaticBitLengthDescriptor; S.BitsBuffer:=0; S.ValidBits:=0; S.LastEOBLength:=8; // enough Lookahead for Inflate // initialize the first block of the first file InitializeBlock(S); end; //---------------------------------------------------------------------------------------------------------------------- procedure RestoreHeap(var S: TDeflateState; const Tree: TTree; K: Integer); // Restores the heap property by moving down tree starting at node K, // exchanging a Node with the smallest of its two sons if necessary, stopping // when the heap property is re-established (each father smaller than its two sons). var V, J: Integer; begin V:=S.Heap[K]; J:=K shl 1; // left son of K while J <= S.HeapLength do begin // set J to the smallest of the two sons: if (J < S.HeapLength) and ((Tree[S.Heap[J + 1]].fc.Frequency < Tree[S.Heap[J]].fc.Frequency) or ((Tree[S.Heap[J + 1]].fc.Frequency = Tree[S.Heap[J]].fc.Frequency) and (S.Depth[S.Heap[J + 1]] <= S.Depth[S.Heap[J]]))) then Inc(J); // exit if V is smaller than both sons if ((Tree[V].fc.Frequency < Tree[S.Heap[J]].fc.Frequency) or ((Tree[V].fc.Frequency = Tree[S.Heap[J]].fc.Frequency) and (S.Depth[V] <= S.Depth[S.Heap[J]]))) then Break; // exchange V with the smallest son S.Heap[K]:=S.Heap[J]; K:=J; // and xontinue down the tree, setting J to the left son of K J:=J shl 1; end; S.Heap[K]:=V; end; //---------------------------------------------------------------------------------------------------------------------- procedure GenerateBitLengths(var S: TDeflateState; var Descriptor: TTreeDescriptor); // Computes the optimal bit lengths for a tree and update the total bit length for the current block. // The fields Frequency and dad are set, Heap[HeapMaximum] and above are the tree nodes sorted by increasing frequency. // // Result: The field Len is set to the optimal bit length, the array BitLengthCounts contains the frequencies for each // bit length. The length OptimalLength is updated. StaticLength is also updated if STree is not nil. var Tree: PTree; MaxCode: Integer; STree: PTree; Extra: PIntegerArray; Base: Integer; MaxLength: Integer; H: Integer; // heap Index N, M: Integer; // iterate over the tree elements Bits: Word; // bit length ExtraBits: Integer; F: Word; // frequency Overflow: Integer; // number of elements with bit length too large begin Tree:=Descriptor.DynamicTree; MaxCode:=Descriptor.MaxCode; STree:=Descriptor.StaticDescriptor.StaticTree; Extra:=Descriptor.StaticDescriptor.ExtraBits; Base:=Descriptor.StaticDescriptor.ExtraBase; MaxLength:=Descriptor.StaticDescriptor.MaxLength; Overflow:=0; FillChar(S.BitLengthCounts, SizeOf(S.BitLengthCounts), 0); // in a first pass, compute the optimal bit lengths (which may overflow in the case of the bit length tree) Tree[S.Heap[S.HeapMaximum]].dl.Len:=0; // root of the heap for H:=S.HeapMaximum + 1 to HEAP_SIZE - 1 do begin N:=S.Heap[H]; Bits:=Tree[Tree[N].dl.Dad].dl.Len + 1; if Bits > MaxLength then begin Bits:=MaxLength; Inc(Overflow); end; Tree[N].dl.Len:=Bits; // overwrite Tree[N].dl.Dad which is no longer needed if N > MaxCode then Continue; // not a leaf node Inc(S.BitLengthCounts[Bits]); ExtraBits:=0; if N >= Base then ExtraBits:=Extra[N - Base]; F:=Tree[N].fc.Frequency; Inc(S.OptimalLength, Integer(F) * (Bits + ExtraBits)); if Assigned(STree) then Inc(S.StaticLength, Integer(F) * (STree[N].dl.Len + ExtraBits)); end; // This happens for example on obj2 and pic of the Calgary corpus if Overflow = 0 then Exit; // find the first bit length which could increase repeat Bits:=MaxLength - 1; while (S.BitLengthCounts[Bits] = 0) do Dec(Bits); // move one leaf down the tree Dec(S.BitLengthCounts[Bits]); // move one overflow item as its brother Inc(S.BitLengthCounts[Bits + 1], 2); // The brother of the overflow item also moves one step up, // but this does not affect BitLengthCounts[MaxLength] Dec(S.BitLengthCounts[MaxLength]); Dec(Overflow, 2); until (Overflow <= 0); // Now recompute all bit lengths, scanning in increasing frequency. // H is still equal to HEAP_SIZE. (It is simpler to reconstruct all // lengths instead of fixing only the wrong ones. This idea is taken // from 'ar' written by Haruhiko Okumura.) H:=HEAP_SIZE; for Bits:=MaxLength downto 1 do begin N:=S.BitLengthCounts[Bits]; while (N<>0) do begin Dec(H); M:=S.Heap[H]; if M > MaxCode then Continue; if Tree[M].dl.Len<>Bits then begin Inc(S.OptimalLength, (Bits - Tree[M].dl.Len) * Tree[M].fc.Frequency); Tree[M].dl.Len:=Word(Bits); end; Dec(N); end; end; end; //---------------------------------------------------------------------------------------------------------------------- procedure BuildTree(var S: TDeflateState; var Descriptor: TTreeDescriptor); // Constructs a Huffman tree and assigns the code bit strings and lengths. // Updates the total bit length for the current block. The field Frequency must be set for all tree elements on entry. // // Result: the fields Len and Code are set to the optimal bit length and corresponding Code. The length OptimalLength // is updated; StaticLength is also updated if STree is not nil. The field MaxCode is set. var Tree: PTree; STree: PTree; Elements: Integer; N, M: Integer; // iterate over heap elements MaxCode: Integer; // largest code with non zero frequency Node: Integer; // new node being created begin Tree:=Descriptor.DynamicTree; STree:=Descriptor.StaticDescriptor.StaticTree; Elements:=Descriptor.StaticDescriptor.Elements; MaxCode:=-1; // Construct the initial Heap, with least frequent element in Heap[SMALLEST]. // The sons of Heap[N] are Heap[2 * N] and Heap[2 * N + 1]. Heap[0] is not used. S.HeapLength:=0; S.HeapMaximum:=HEAP_SIZE; for N:=0 to Elements - 1 do begin if Tree[N].fc.Frequency = 0 then Tree[N].dl.Len:=0 else begin MaxCode:=N; Inc(S.HeapLength); S.Heap[S.HeapLength]:=N; S.Depth[N]:=0; end; end; // The pkzip format requires that at least one distance code exists and that at least one bit // should be sent even if there is only one possible code. So to avoid special checks later on we force at least // two codes of non zero frequency. while S.HeapLength < 2 do begin Inc(S.HeapLength); if MaxCode < 2 then begin Inc(MaxCode); S.Heap[S.HeapLength]:=MaxCode; Node:=MaxCode; end else begin S.Heap[S.HeapLength]:=0; Node:=0; end; Tree[Node].fc.Frequency:=1; S.Depth[Node]:=0; Dec(S.OptimalLength); if (STree<>nil) then Dec(S.StaticLength, STree[Node].dl.Len); // Node is 0 or 1 so it does not have extra bits end; Descriptor.MaxCode:=MaxCode; // The elements Heap[HeapLength / 2 + 1 .. HeapLength] are leaves of the Tree, // establish sub-heaps of increasing lengths. for N:=S.HeapLength div 2 downto 1 do RestoreHeap(S, Tree^, N); // construct the Huffman tree by repeatedly combining the least two frequent nodes Node:=Elements; // next internal node of the tree repeat N:=S.Heap[SMALLEST]; S.Heap[SMALLEST]:=S.Heap[S.HeapLength]; Dec(S.HeapLength); RestoreHeap(S, Tree^, SMALLEST); // M:=node of next least frequency M:=S.Heap[SMALLEST]; Dec(S.HeapMaximum); // keep the nodes sorted by frequency S.Heap[S.HeapMaximum]:=N; Dec(S.HeapMaximum); S.Heap[S.HeapMaximum]:=M; // create a new node father of N and M Tree[Node].fc.Frequency:=Tree[N].fc.Frequency + Tree[M].fc.Frequency; // maximum if (S.Depth[N] >= S.Depth[M]) then S.Depth[Node]:=Byte (S.Depth[N] + 1) else S.Depth[Node]:=Byte (S.Depth[M] + 1); Tree[M].dl.Dad:=Word(Node); Tree[N].dl.Dad:=Word(Node); // and insert the new node in the heap S.Heap[SMALLEST]:=Node; Inc(Node); RestoreHeap(S, Tree^, SMALLEST); until S.HeapLength < 2; Dec(S.HeapMaximum); S.Heap[S.HeapMaximum]:=S.Heap[SMALLEST]; // At this point the fields Frequency and dad are set. We can now generate the bit lengths. GenerateBitLengths(S, Descriptor); // The field Len is now set, we can generate the bit codes GenerateCodes(Tree, MaxCode, S.BitLengthCounts); end; //---------------------------------------------------------------------------------------------------------------------- procedure ScanTree(var S: TDeflateState; var Tree: array of TTreeEntry; MaxCode: Integer); // Scans a given tree to determine the frequencies of the codes in the bit length tree. // MaxCode is the tree's largest code of non zero frequency. var N: Integer; // iterates over all tree elements PreviousLen: Integer; // last emitted length CurrentLen: Integer; // Length of current code NextLen: Integer; // length of next code Count: Integer; // repeat count of the current xode MaxCount: Integer; // max repeat count MinCount: Integer; // min repeat count begin PreviousLen:=-1; NextLen:=Tree[0].dl.Len; Count:=0; MaxCount:=7; MinCount:=4; if NextLen = 0 then begin MaxCount:=138; MinCount:=3; end; Tree[MaxCode + 1].dl.Len:=Word($FFFF); // guard for N:=0 to MaxCode do begin CurrentLen:=NextLen; NextLen:=Tree[N + 1].dl.Len; Inc(Count); if (Count < MaxCount) and (CurrentLen = NextLen) then Continue else if (Count < MinCount) then Inc(S.BitLengthTree[CurrentLen].fc.Frequency, Count) else if CurrentLen<>0 then begin if (CurrentLen<>PreviousLen) then Inc(S.BitLengthTree[CurrentLen].fc.Frequency); Inc(S.BitLengthTree[REP_3_6].fc.Frequency); end else if (Count <= 10) then Inc(S.BitLengthTree[REPZ_3_10].fc.Frequency) else Inc(S.BitLengthTree[REPZ_11_138].fc.Frequency); Count:=0; PreviousLen:=CurrentLen; if NextLen = 0 then begin MaxCount:=138; MinCount:=3; end else if CurrentLen = NextLen then begin MaxCount:=6; MinCount:=3; end else begin MaxCount:=7; MinCount:=4; end; end; end; //---------------------------------------------------------------------------------------------------------------------- procedure SendTree(var S: TDeflateState; const Tree: array of TTreeEntry; MaxCode: Integer); // Sends the given tree in compressed form using the codes in BitLengthTree. // MaxCode is the tree's largest code of non zero frequency. var N: Integer; // iterates over all tree elements PreviousLen: Integer; // last emitted length CurrentLen: Integer; // length of current code NextLen: Integer; // length of next code Count: Integer; // repeat count of the current code MaxCount: Integer; // max repeat count MinCount: Integer; // min repeat count begin PreviousLen:=-1; NextLen:=Tree[0].dl.Len; Count:=0; MaxCount:=7; MinCount:=4; // guard is already set if NextLen = 0 then begin MaxCount:=138; MinCount:=3; end; for N:=0 to MaxCode do begin CurrentLen:=NextLen; NextLen:=Tree[N + 1].dl.Len; Inc(Count); if (Count < MaxCount) and (CurrentLen = NextLen) then Continue else if Count < MinCount then begin repeat SendBits(S, S.BitLengthTree[CurrentLen].fc.Code, S.BitLengthTree[CurrentLen].dl.Len); Dec(Count); until (Count = 0); end else if CurrentLen<>0 then begin if CurrentLen<>PreviousLen then begin SendBits(S, S.BitLengthTree[CurrentLen].fc.Code, S.BitLengthTree[CurrentLen].dl.Len); Dec(Count); end; SendBits(S, S.BitLengthTree[REP_3_6].fc.Code, S.BitLengthTree[REP_3_6].dl.Len); SendBits(S, Count - 3, 2); end else if Count <= 10 then begin SendBits(S, S.BitLengthTree[REPZ_3_10].fc.Code, S.BitLengthTree[REPZ_3_10].dl.Len); SendBits(S, Count - 3, 3); end else begin SendBits(S, S.BitLengthTree[REPZ_11_138].fc.Code, S.BitLengthTree[REPZ_11_138].dl.Len); SendBits(S, Count - 11, 7); end; Count:=0; PreviousLen:=CurrentLen; if NextLen = 0 then begin MaxCount:=138; MinCount:=3; end else if CurrentLen = NextLen then begin MaxCount:=6; MinCount:=3; end else begin MaxCount:=7; MinCount:=4; end; end; end; //---------------------------------------------------------------------------------------------------------------------- function BuildBitLengthTree(var S: TDeflateState): Integer; // Constructs the Huffman tree for the bit lengths and returns the Index in BitLengthOrder // of the last bit length code to send. begin // determine the bit length frequencies for literal and distance trees ScanTree(S, S.LiteralTree, S.LiteralDescriptor.MaxCode); ScanTree(S, S.DistanceTree, S.DistanceDescriptor.MaxCode); // build the bit length tree BuildTree(S, S.BitLengthDescriptor); // OptimalLength now includes the length of the tree representations, except // the lengths of the bit lengths codes and the 5 + 5 + 4 (= 14) bits for the counts. // Determine the number of bit length codes to send. The pkzip format requires that at least 4 bit length codes // be sent. (appnote.txt says 3 but the actual value used is 4.) for Result:=BL_CODES - 1 downto 3 do if S.BitLengthTree[BitLengthOrder[Result]].dl.Len<>0 then Break; // update OptimalLength to include the bit length tree and counts Inc(S.OptimalLength, 3 * (Result + 1) + 14); end; //---------------------------------------------------------------------------------------------------------------------- procedure SendAllTrees(var S: TDeflateState; lcodes, dcodes, blcodes: Integer); // Sends the header for a block using dynamic Huffman trees: the counts, the // lengths of the bit length codes, the literal tree and the distance tree. // lcodes must be >= 257, dcodes >= 1 and blcodes >= 4 var Rank: Integer; begin SendBits(S, lcodes - 257, 5); // not +255 as stated in appnote.txt SendBits(S, dcodes - 1, 5); SendBits(S, blcodes - 4, 4); // not -3 as stated in appnote.txt for Rank:=0 to blcodes - 1 do SendBits(S, S.BitLengthTree[BitLengthOrder[Rank]].dl.Len, 3); SendTree(S, S.LiteralTree, lcodes-1); SendTree(S, S.DistanceTree, dcodes-1); end; //---------------------------------------------------------------------------------------------------------------------- procedure BitsWindup(var S: TDeflateState); // flushs the bit buffer and aligns the output on a byte boundary begin if S.ValidBits > 8 then begin S.PendingBuffer[S.Pending]:=Byte(S.BitsBuffer and $FF); Inc(S.Pending); S.PendingBuffer[S.Pending]:=Byte(Word(S.BitsBuffer) shr 8);; Inc(S.Pending); end else if S.ValidBits > 0 then begin S.PendingBuffer[S.Pending]:=Byte(S.BitsBuffer); Inc(S.Pending); end; S.BitsBuffer:=0; S.ValidBits:=0; end; //---------------------------------------------------------------------------------------------------------------------- procedure CopyBlock(var S: TDeflateState; Buffer: PByte; Len: Cardinal; Header: Boolean); // copies a stored block, storing first the length and its one's complement if requested // Buffer contains the input data, Len the buffer length and Header is True if the block Header must be written too. begin BitsWindup(S); // align on byte boundary S.LastEOBLength:=8; // enough lookahead for Inflate if Header then begin S.PendingBuffer[S.Pending]:=Byte(Word(Len) and $FF); Inc(S.Pending); S.PendingBuffer[S.Pending]:=Byte(Word(Len) shr 8); Inc(S.Pending); S.PendingBuffer[S.Pending]:=Byte(Word(not Len) and $FF); Inc(S.Pending); S.PendingBuffer[S.Pending]:=Byte(Word(not Len) shr 8); Inc(S.Pending); end; while Len > 0 do begin Dec(Len); S.PendingBuffer[S.Pending]:=Buffer^; Inc(Buffer); Inc(S.Pending); end; end; //---------------------------------------------------------------------------------------------------------------------- procedure TreeStroredBlock(var S: TDeflateState; Buffer: PByte; StoredLength: Integer; EOF: Boolean); // sends a stored block // Buffer contains the input data, Len the buffer length and EOF is True if this is the last block for a file. begin SendBits(S, (STORED_BLOCK shl 1) + Ord(EOF), 3); // send block type S.CompressedLength:=(S.CompressedLength + 10) and Integer(not 7); Inc(S.CompressedLength, (StoredLength + 4) shl 3); // copy with header CopyBlock(S, Buffer, Cardinal(StoredLength), True); end; //---------------------------------------------------------------------------------------------------------------------- procedure BitsFlush(var S: TDeflateState); // flushs the bit buffer, keeping at most 7 bits in it begin if S.ValidBits = 16 then begin S.PendingBuffer[S.Pending]:=Byte(S.BitsBuffer and $FFf); Inc(S.Pending); S.PendingBuffer[S.Pending]:=Byte(Word(S.BitsBuffer) shr 8); Inc(S.Pending); S.BitsBuffer:=0; S.ValidBits:=0; end else if S.ValidBits >= 8 then begin S.PendingBuffer[S.Pending]:=Byte(S.BitsBuffer); Inc(S.Pending); S.BitsBuffer:=S.BitsBuffer shr 8; Dec(S.ValidBits, 8); end; end; //---------------------------------------------------------------------------------------------------------------------- procedure TreeAlign(var S: TDeflateState); // Sends one empty static block to give enough lookahead for Inflate. This takes 10 Bits, of which 7 may remain // in the bit buffer. The current Inflate code requires 9 Bits of lookahead. if the last two codes for the previous // block (real code plus EOB) were coded on 5 Bits or less, Inflate may have only 5 + 3 Bits of lookahead to decode the // last real code. In this case we send two empty static blocks instead of one. (There are no problems if the previous // block is stored or fixed.) To simplify the code, we assume the worst case of last real code encoded on one bit only. begin SendBits(S, STATIC_TREES shl 1, 3); SendBits(S, StaticLiteralTree[END_BLOCK].fc.Code, StaticLiteralTree[END_BLOCK].dl.Len); Inc(S.CompressedLength, 10); // 3 for block type, 7 for EOB BitsFlush(S); // Of the 10 Bits for the empty block, we have already sent // (10 - ValidBits) bits. The lookahead for the last real code (before // the EOB of the previous block) was thus at least one plus the length // of the EOB plus what we have just sent of the empty static block. if (1 + S.LastEOBLength + 10 - S.ValidBits) < 9 then begin SendBits(S, STATIC_TREES shl 1, 3); SendBits(S, StaticLiteralTree[END_BLOCK].fc.Code, StaticLiteralTree[END_BLOCK].dl.Len); Inc(S.CompressedLength, 10); BitsFlush(S); end; S.LastEOBLength:=7; end; //---------------------------------------------------------------------------------------------------------------------- procedure SetDataType(var S: TDeflateState); // Sets the data type to ASCII or BINARY, using a crude approximation. Binary if more than 20% of the bytes are // <= 6 or >= 128, ASCII otherwise. The fields Frequency of LiteralTree are set and the total of all frequencies does // not exceed 64K. var N: Integer; ASCIIFrequency: Cardinal; BinaryFrequency: Cardinal; begin N:=0; ASCIIFrequency:=0; BinaryFrequency:=0; while N < 7 do begin Inc(BinaryFrequency, S.LiteralTree[N].fc.Frequency); Inc(N); end; while N < 128 do begin Inc(ASCIIFrequency, S.LiteralTree[N].fc.Frequency); Inc(N); end; while N < LITERALS do begin Inc(BinaryFrequency, S.LiteralTree[N].fc.Frequency); Inc(N); end; if BinaryFrequency > (ASCIIFrequency shr 2) then S.DataType:=Z_BINARY else S.DataType:=Z_ASCII; end; //---------------------------------------------------------------------------------------------------------------------- procedure CompressBlock(var S: TDeflateState; const LiteralTree, DistanceTree: array of TTreeEntry); // sends the block data compressed using the given Huffman trees var Distance: Cardinal; // distance of matched string lc: Integer; // match length or unmatched char (if Distance = 0) I: Cardinal; Code: Cardinal; // the code to send Extra: Integer; // number of extra bits to send begin I:=0; if S.LastLiteral<>0 then repeat Distance:=S.DistanceBuffer[I]; lc:=S.LiteralBuffer[I]; Inc(I); if Distance = 0 then begin // send a literal byte SendBits(S, LiteralTree[lc].fc.Code, LiteralTree[lc].dl.Len); end else begin // Here, lc is the match length - MIN_MATCH Code:=LengthCode[lc]; // send the length code SendBits(S, LiteralTree[Code + LITERALS + 1].fc.Code, LiteralTree[Code + LITERALS + 1].dl.Len); Extra:=ExtraLengthBits[Code]; if Extra<>0 then begin Dec(lc, BaseLength[Code]); // send the extra length bits SendBits(S, lc, Extra); end; Dec(Distance); // Distance is now the match distance - 1 if Distance < 256 then Code:=DistanceCode[Distance] else Code:=DistanceCode[256 + (Distance shr 7)]; // send the distance code SendBits(S, DistanceTree[Code].fc.Code, DistanceTree[Code].dl.Len); Extra:=ExtraDistanceBits[Code]; if Extra<>0 then begin Dec(Distance, BaseDistance[Code]); SendBits(S, Distance, Extra); // send the extra distance bits end; end; // literal or match pair? // Check that the overlay between PendingBuffer and DistanceBuffer + LiteralBuffer is ok until I >= S.LastLiteral; SendBits(S, LiteralTree[END_BLOCK].fc.Code, LiteralTree[END_BLOCK].dl.Len); S.LastEOBLength:=LiteralTree[END_BLOCK].dl.Len; end; //---------------------------------------------------------------------------------------------------------------------- function TreeFlushBlock(var S: TDeflateState; Buffer: PByte; StoredLength: Integer; EOF: Boolean): Integer; // Determines the best encoding for the current block: dynamic trees, static trees or store, and outputs the encoded // block. Buffer contains the input block (or nil if too old), StoredLength the length of this block and EOF if this // is the last block. // Returns the total compressed length so far. var OptimalByteLength, StaticByteLength: Integer; // OptimalLength and StaticLength in bytes MacBLIndex: Integer; // index of last bit length code of non zero frequency begin MacBLIndex:=0; // build the Huffman trees unless a stored block is forced if S.Level > 0 then begin // check if the file is ASCII or binary if S.DataType = Z_UNKNOWN then SetDataType(S); // construct the literal and distance trees // After this, OptimalLength and StaticLength are the total bit lengths of // the compressed block data, excluding the tree representations. BuildTree(S, S.LiteralDescriptor); BuildTree(S, S.DistanceDescriptor); // Build the bit length tree for the above two trees and get the index // in BitLengthOrder of the last bit length code to send. MacBLIndex:=BuildBitLengthTree(S); // determine the best encoding, compute first the block length in bytes OptimalByteLength:=(S.OptimalLength + 10) shr 3; StaticByteLength:=(S.StaticLength + 10) shr 3; if StaticByteLength <= OptimalByteLength then OptimalByteLength:=StaticByteLength; end else begin StaticByteLength:=StoredLength + 5; OptimalByteLength:=StaticByteLength; // force a stored block end; // if Iompression failed and this is the first and last block, // and if the .zip file can be seeked (to rewrite the local header), // the whole file is transformed into a stored file. // (4 are the two words for the lengths) if (StoredLength + 4 <= OptimalByteLength) and Assigned(Buffer) then begin // The test Buffer<>nil is only necessary if LiteralBufferSize > WSize. // Otherwise we can't have processed more than WSize input bytes since // the last block dlush, because compression would have been successful. // if LiteralBufferSize <= WSize, it is never too late to transform a block into a stored block. TreeStroredBlock(S, Buffer, StoredLength, EOF); end else if StaticByteLength >= 0 then begin // force static trees SendBits(S, (STATIC_TREES shl 1) + Ord(EOF), 3); CompressBlock(S, StaticLiteralTree, StaticDescriptorTree); Inc(S.CompressedLength, 3 + S.StaticLength); end else begin SendBits(S, (DYN_TREES shl 1) + Ord(EOF), 3); SendAllTrees(S, S.LiteralDescriptor.MaxCode + 1, S.DistanceDescriptor.MaxCode + 1, MacBLIndex + 1); CompressBlock(S, S.LiteralTree, S.DistanceTree); Inc(S.CompressedLength, 3 + S.OptimalLength); end; InitializeBlock(S); if EOF then begin BitsWindup(S); // align on byte boundary Inc(S.CompressedLength, 7); end; Result:=S.CompressedLength shr 3; end; //---------------------------------------------------------------------------------------------------------------------- function TreeTally(var S: TDeflateState; Distance: Cardinal; lc: Cardinal): Boolean; // Saves the match info and tallies the frequency counts. Returns True if the current block must be flushed. // Distance is the distance of the matched string and lc either match length minus MIN_MATCH or the unmatch character // (if Distance = 0). var Code: Word; begin S.DistanceBuffer[S.LastLiteral]:=Word(Distance); S.LiteralBuffer[S.LastLiteral]:=Byte(lc); Inc(S.LastLiteral); if (Distance = 0) then begin // lc is the unmatched char Inc(S.LiteralTree[lc].fc.Frequency); end else begin Inc(S.Matches); // here, lc is the match length - MIN_MATCH Dec(Distance); if Distance < 256 then Code:=DistanceCode[Distance] else Code:=DistanceCode[256 + (Distance shr 7)]; Inc(S.LiteralTree[LengthCode[lc] + LITERALS + 1].fc.Frequency); Inc(S.DistanceTree[Code].fc.Frequency); end; Result:=(S.LastLiteral = S.LiteralBufferSize - 1); // We avoid equality with LiteralBufferSize because stored blocks are restricted to 64K - 1 bytes. end; //----------------- deflation support ---------------------------------------------------------------------------------- type TBlockState = ( bsNeedMore, // block not completed, need more input or more output bsBlockDone, // block flush performed bsFinishStarted, // finish started, need only more output at next Deflate bsFinishDone // finish done, accept no more input or output ); type // compression function, returns the block state after the call TCompressFunction = function(var S: TDeflateState; Flush: Integer): TBlockState; function DeflateStored(var S: TDeflateState; Flush: Integer): TBlockState; forward; function DeflateFast(var S: TDeflateState; Flush: Integer): TBlockState; forward; function DeflateSlow(var S: TDeflateState; Flush: Integer): TBlockState; forward; const ZNIL = 0; // Tail of hash chains TOO_FAR = 4096; // matches of length 3 are discarded if their distance exceeds TOO_FAR type TConfig = record GoodLength: Word; // reduce lazy search above this match length MaxLazy: Word; // do not perform lazy search above this match length NiceLength: Word; // quit search above this match length MaxChain: Word; Func: TCompressFunction; end; const // Values for MaxLazyMatch, GoodMatch and MaxChainLength, depending on the desired pack Level (0..9). // The values given below have been tuned to exclude worst case performance for pathological files. // Better values may be found for specific files. ConfigurationTable: array[0..9] of TConfig = ( (GoodLength: 0; MaxLazy: 0; NiceLength: 0; MaxChain: 0; Func: DeflateStored), // store only (GoodLength: 4; MaxLazy: 4; NiceLength: 8; MaxChain: 4; Func: DeflateFast), // maximum speed (GoodLength: 4; MaxLazy: 5; NiceLength: 16; MaxChain: 8; Func: DeflateFast), (GoodLength: 4; MaxLazy: 6; NiceLength: 32; MaxChain: 32; Func: DeflateFast), (GoodLength: 4; MaxLazy: 4; NiceLength: 16; MaxChain: 16; Func: DeflateSlow), (GoodLength: 8; MaxLazy: 16; NiceLength: 32; MaxChain: 32; Func: DeflateSlow), (GoodLength: 8; MaxLazy: 16; NiceLength: 128; MaxChain: 128; Func: DeflateSlow), (GoodLength: 8; MaxLazy: 32; NiceLength: 128; MaxChain: 256; Func: DeflateSlow), (GoodLength: 32; MaxLazy: 128; NiceLength: 258; MaxChain: 1024; Func: DeflateSlow), (GoodLength: 32; MaxLazy: 258; NiceLength: 258; MaxChain: 4096; Func: DeflateSlow) // maximum compression ); // Note: The deflate code requires MaxLazy >= MIN_MATCH and MaxChain >= 4. // For DeflateFast (levels <= 3) good is ignored and lazy has a different meaning. //---------------------------------------------------------------------------------------------------------------------- procedure InsertString(var S: TDeflateState; Str: Cardinal; var MatchHead: Cardinal); // Inserts Str into the dictionary and sets MatchHead to the previous head of the hash chain (the most recent string // with same hash key). All calls to to InsertString are made with consecutive input characters and the first MIN_MATCH // bytes of Str are valid (except for the last MIN_MATCH - 1 bytes of the input file). // Returns the previous length of the hash chain. begin S.InsertHash:=((S.InsertHash shl S.HashShift) xor (S.Window[(Str) + (MIN_MATCH - 1)])) and S.HashMask; MatchHead:=S.Head[S.InsertHash]; S.Previous[(Str) and S.WindowMask]:=MatchHead; S.Head[S.InsertHash]:=Word(Str); end; //---------------------------------------------------------------------------------------------------------------------- procedure LongestMatchInit(var S: TDeflateState); // initializes the "longest match" routines for a new zlib stream begin S.CurrentWindowSize:=2 * S.WindowSize; S.Head[S.HashSize - 1]:=ZNIL; FillChar(S.Head^, (S.HashSize - 1) * SizeOf(S.Head[0]), 0); // set the default configuration parameters S.MaxLazyMatch:=ConfigurationTable[S.Level].MaxLazy; S.GoodMatch:=ConfigurationTable[S.Level].GoodLength; S.NiceMatch:=ConfigurationTable[S.Level].NiceLength; S.MaxChainLength:=ConfigurationTable[S.Level].MaxChain; S.StringStart:=0; S.BlockStart:=0; S.Lookahead:=0; S.PreviousLength:=MIN_MATCH - 1; S.MatchLength:=MIN_MATCH - 1; S.MatchAvailable:=False; S.InsertHash:=0; end; //---------------------------------------------------------------------------------------------------------------------- function DeflateInit2_(var ZState: TZState; Level: Integer; imMethod: Byte; AWindowBits: Integer; MemLevel: Integer; Strategy: Integer; const Version: String; StreamSize: Integer): Integer; // initializes the hash table (Previous[] will be initialized on the fly) var S: PDeflateState; NoHeader: Integer; Overlay: PWordArray; // We overlay PendingBuffer and DistanceBuffer + LiteralBuffer. This works since the average // output size for (length, distance) codes is <= 24 Bits. begin NoHeader:=0; if (Version = '') or (Version[1]<>ZLIB_VERSION[1]) or (StreamSize<>SizeOf(TZState)) then begin Result:=Z_VERSION_ERROR; Exit; end; ZState.Msg:=''; if Level = Z_DEFAULT_COMPRESSION then Level:=6; if AWindowBits < 0 then begin // undocumented feature: suppress zlib header NoHeader:=1; AWindowBits:=-AWindowBits; end; if (MemLevel < 1) or (MemLevel > MAX_MEM_LEVEL) or (imMethod<>Z_DEFLATED) or (AWindowBits < 8) or (AWindowBits > 15) or (Level < 0) or (Level > 9) or (Strategy < 0) or (Strategy > Z_HUFFMAN_ONLY) then begin Result:=Z_STREAM_ERROR; Exit; end; try S:=AllocMem(SizeOf(TDeflateState)); ZState.State:=PInternalState(S); S.ZState:=@ZState; S.NoHeader:=NoHeader; S.WindowBits:=AWindowBits; S.WindowSize:=1 shl S.WindowBits; S.WindowMask:=S.WindowSize - 1; S.HashBits:=MemLevel + 7; S.HashSize:=1 shl S.HashBits; S.HashMask:=S.HashSize - 1; S.HashShift:=(S.HashBits + MIN_MATCH - 1) div MIN_MATCH; S.Window:=AllocMem(S.WindowSize * 2 * SizeOf(Byte)); S.Previous:=AllocMem(S.WindowSize * SizeOf(Word)); S.Head:=AllocMem(S.HashSize * SizeOf(Word)); S.LiteralBufferSize:=1 shl (MemLevel + 6); // 16K elements by default Overlay:=AllocMem(S.LiteralBufferSize * SizeOf(Word) + 2); S.PendingBuffer:=PByteArray(Overlay); S.PendingBufferSize:=S.LiteralBufferSize * (SizeOf(Word) + 2); S.DistanceBuffer:=@Overlay[S.LiteralBufferSize div SizeOf(Word)]; S.LiteralBuffer:=@S.PendingBuffer[(1 + SizeOf(Word)) * S.LiteralBufferSize]; S.Level:=Level; S.Strategy:=Strategy; S.imMethod:=imMethod; Result:=DeflateReset(ZState); except ZState.Msg:=ErrorMessages[ERROR_BASE - Z_MEM_ERROR]; // free already allocated data on error DeflateEnd(ZState); raise; end; end; //---------------------------------------------------------------------------------------------------------------------- function DeflateInit2(var ZState: TZState; Level: Integer; Method: Byte; AWindowBits: Integer; MemLevel: Integer; Strategy: Integer): Integer; // This is another Version of DeflateInit with more compression options. The field // NextInput must be initialized before by the caller. // // The Method parameter is the compression method. It must be Z_DEFLATED in // this Version of the library. (Method 9 will allow a 64K history buffer and // partial block flushes.) // // The AWindowBits parameter is the base two logarithm of the window size // (the size of the history buffer). It should be in the range 8..15 for this // version of the library (the value 16 will be allowed for method 9). Larger // values of this parameter result in better compression at the expense of // memory usage. The default value is 15 if DeflateInit is used instead. // // The MemLevel parameter specifies how much memory should be allocated // for the internal compression State. MemLevel = 1 uses minimum memory but // is slow and reduces compression ratio; MemLevel = 9 uses maximum memory // for optimal speed. The default value is 8. // // The strategy parameter is used to tune the compression algorithm. Use the // Value Z_DEFAULT_STRATEGY for normal data, Z_FILTERED for data produced by a // filter (or predictor), or Z_HUFFMAN_ONLY to force Huffman encoding only (no // string match). Filtered data consists mostly of small values with a // somewhat random distribution. In this case, the compression algorithm is // tuned to compress them better. The effect of Z_FILTERED is to force more // Huffman coding and less string matching; it is somewhat intermediate // between Z_DEFAULT and Z_HUFFMAN_ONLY. The strategy parameter only affects // the compression ratio but not the correctness of the compressed output even // if it is not set appropriately. // // if NextInput is not nil the library will use this buffer to hold also // some history information; the buffer must either hold the entire input // data or have at least 1 shl (WindowBits + 1) bytes and be writable. If NextInput // is nil the library will allocate its own history buffer (and leave NextInput // nil). NextOutput need not be provided here but must be provided by the // application for the next call of Deflate. // // if the history buffer is provided by the application, NextInput must // must never be changed by the application since the compressor maintains // information inside this buffer from call to call; the application // must provide more input only by increasing AvailableInput. NextInput is always // reset by the library in this case. // // DeflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was // not enough memory, Z_STREAM_ERROR if a parameter is invalid (such as // an invalid method). Msg is set to '' if there is no error message. // DeflateInit2 does not perform any compression: this will be done by // Deflate. begin Result:=DeflateInit2_(ZState, Level, Method, AWindowBits, MemLevel, Strategy, ZLIB_VERSION, SizeOf(TZState)); end; //---------------------------------------------------------------------------------------------------------------------- function DeflateInit_(ZState: PZState; Level: Integer; const Version: String; StreamSize: Integer): Integer; // Initializes the internal stream state for compression. // // The compression level must be Z_DEFAULT_COMPRESSION or between 0 and 9: // 1 gives best speed, 9 gives best compression, 0 gives no compression at // all (the input data is simply copied a block at a time). // Z_DEFAULT_COMPRESSION requests a default compromise between speed and // compression (currently equivalent to Level 6). // // DeflateInit returns Z_OK if success, Z_MEM_ERROR if there was not // enough memory, Z_STREAM_ERROR if Level is not a valid compression level, // Z_VERSION_ERROR if the zlib library version (zlib_version) is incompatible // with the version assumed by the caller (ZLIB_VERSION). // Msg is set to '' if there is no error message. DeflateInit does not // perform any compression, this will be done by Deflate. begin if ZState = nil then DeflateInit_:=Z_STREAM_ERROR else DeflateInit_:=DeflateInit2_(ZState^, Level, Z_DEFLATED, MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, Version, StreamSize); end; //---------------------------------------------------------------------------------------------------------------------- function DeflateInit(var ZState: TZState; Level: Integer): Integer; begin DeflateInit:=DeflateInit2_(ZState, Level, Z_DEFLATED, MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, ZLIB_VERSION, SizeOf(TZState)); end; //---------------------------------------------------------------------------------------------------------------------- function DeflateSetDictionary(var ZState: TZState; Dictionary: PByte; DictLength: Cardinal): Integer; // Initializes the compression dictionary (history buffer) from the given // byte sequence without producing any compressed output. This function must // be called immediately after DeflateInit or DeflateInit2, before any call // of Deflate. The compressor and decompressor must use exactly the same // dictionary (see InflateSetDictionary). // // The dictionary should consist of strings (byte sequences) that are likely // to be encountered later in the data to be compressed, with the most commonly // used strings preferably put towards the end of the dictionary. Using a // dictionary is most useful when the data to be compressed is short and // can be predicted with good accuracy; the data can then be compressed better // than with the default empty dictionary. In this version of the library, // only the last 32K bytes of the dictionary are used. // // Upon return of this function ZState.Adler is set to the Adler32 value // of the dictionary. The decompressor may later use this value to determine // which dictionary has been used by the compressor. (The Adler32 value // applies to the whole dictionary even if only a subset of the dictionary is // actually used by the compressor.) // // DeflateSetDictionary returns Z_OK if success or Z_STREAM_ERROR if a // parameter is invalid (such as nil dictionary) or the stream state // is inconsistent (for example if Deflate has already been called for this // stream). DeflateSetDictionary does not perform any compression, this will // be done by Deflate. var S: PDeflateState; Length: Cardinal; N: Cardinal; HashHead: Cardinal; MaxDistance: Cardinal; begin Length:=DictLength; HashHead:=0; if (ZState.State = nil) or (Dictionary = nil) or (PDeflateState(ZState.State).Status<>INIT_STATE) then begin Result:=Z_STREAM_ERROR; Exit; end; S:=PDeflateState(ZState.State); ZState.Adler:=Adler32(ZState.Adler, Dictionary, DictLength); if Length < MIN_MATCH then begin Result:=Z_OK; Exit; end; MaxDistance:=S.WindowSize - MIN_LOOKAHEAD; if Length > MaxDistance then begin Length:=MaxDistance; // use the tail of the dictionary Inc(Dictionary, DictLength - Length); end; Move( Dictionary^ , S.Window^, Length); S.StringStart:=Length; S.BlockStart:=Integer(Length); // Insert all strings in the hash table (except for the last two bytes). // S.Lookahead stays nil, so S.InsertHash will be recomputed at the next call of FillWindow. S.InsertHash:=S.Window[0]; S.InsertHash:=((S.InsertHash shl S.HashShift) xor (S.Window[1])) and S.HashMask; for N:=0 to Length - MIN_MATCH do InsertString(S^, N, HashHead); Result:=Z_OK; end; //---------------------------------------------------------------------------------------------------------------------- function DeflateReset(var ZState: TZState): Integer; // This function is equivalent to DeflateEnd followed by DeflateInit, // but does not free and reallocate all the internal compression state. // The stream will keep the same compression level and any other attributes // that may have been set by DeflateInit2. // // DeflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source // stream state was inconsistent (such as state being nil). var S: PDeflateState; begin if ZState.State = nil then begin Result:=Z_STREAM_ERROR; Exit; end; ZState.TotalOutput:=0; ZState.TotalInput:=0; ZState.Msg:=''; ZState.DataType:=Z_UNKNOWN; S:=PDeflateState(ZState.State); S.Pending:=0; S.PendingOutput:=PByte(S.PendingBuffer); if S.NoHeader < 0 then begin // was set to -1 by Deflate(..., Z_FINISH); S.NoHeader:=0; end; if S.NoHeader<>0 then S.Status:=BUSY_STATE else S.Status:=INIT_STATE; ZState.Adler:=1; S.LastFlush:=Z_NO_FLUSH; TreeInit(S^); LongestMatchInit(S^); Result:=Z_OK; end; //---------------------------------------------------------------------------------------------------------------------- function DeflateParams(var ZState: TZState; Level: Integer; Strategy: Integer): Integer; // Dynamically update the compression level and compression strategy. // This can be used to switch between compression and straight copy of // the input data or to switch to a different kind of input data requiring // a different strategy. If the compression level is changed the input // available so far is compressed with the old Level (and may be flushed). // The new level will take effect only at the next call of Deflate. // // Before the call of DeflateParams the stream state must be set as for // a call of Deflate, since the currently available input may have to // be compressed and flushed. In particular, ZState.AvailableOutput must be non-zero. // // DeflateParams returns Z_OK if successuful, Z_STREAM_ERROR if the source // stream state was inconsistent or if a parameter was invalid, Z_BUF_ERROR // if ZState.AvailableOutput was zero. var S: PDeflateState; Func: TCompressFunction; Error: Integer; begin Error:=Z_OK; if ZState.State = nil then begin Result:=Z_STREAM_ERROR; Exit; end; S:=PDeflateState(ZState.State); if Level = Z_DEFAULT_COMPRESSION then Level:=6; if (Level < 0) or (Level > 9) or (Strategy < 0) or (Strategy > Z_HUFFMAN_ONLY) then begin Result:=Z_STREAM_ERROR; Exit; end; Func:=ConfigurationTable[S.Level].Func; if (@Func<>@ConfigurationTable[Level].Func) and (ZState.TotalInput<>0) then begin // flush the last buffer Error:=Deflate(ZState, Z_PARTIAL_FLUSH); end; if S.Level<>Level then begin S.Level:=Level; S.MaxLazyMatch:=ConfigurationTable[Level].MaxLazy; S.GoodMatch:=ConfigurationTable[Level].GoodLength; S.NiceMatch:=ConfigurationTable[Level].NiceLength; S.MaxChainLength:=ConfigurationTable[Level].MaxChain; end; S.Strategy:=Strategy; Result:=Error; end; //---------------------------------------------------------------------------------------------------------------------- procedure PutShortMSB(var S: TDeflateState; B: Cardinal); // Puts a word in the pending buffer. The 16-bit value is put in MSB order. // The stream state must be correct and there must be enough room in PendingBuffer. begin S.PendingBuffer[S.Pending]:=B shr 8; Inc(S.Pending); S.PendingBuffer[S.Pending]:=B and $FF; Inc(S.Pending); end; //---------------------------------------------------------------------------------------------------------------------- procedure FlushPending(var ZState: TZState); // Flushs as much pending output as possible. All Deflate output goes through this function so some applications may // wish to modify it to avoid allocating a large ZState.NextOutput buffer and copying into it // (see also ReadBuffer). var Len: Cardinal; S: PDeflateState; begin S:=PDeflateState(ZState.State); Len:=S.Pending; if Len > ZState.AvailableOutput then Len:=ZState.AvailableOutput; if Len > 0 then begin Move(S.PendingOutput^, ZState.NextOutput^, Len); Inc(ZState.NextOutput, Len); Inc(S.PendingOutput, Len); Inc(ZState.TotalOutput, Len); Dec(ZState.AvailableOutput, Len); Dec(S.Pending, Len); if S.Pending = 0 then S.PendingOutput:=PByte(S.PendingBuffer); end; end; //---------------------------------------------------------------------------------------------------------------------- function Deflate(var ZState: TZState; Flush: Integer): Integer; // Performs one or both of the following actions: // // - Compress more input starting at NextInput and update NextInput and AvailableInput // accordingly. If not all input can be processed (because there is not enough room in the output buffer), NextInput // and AvailableInput are updated and processing will resume at this point for the next call of Deflate. // // - Provide more output starting at NextOutput and update NextOutput and AvailableOutput accordingly. This action is // forced if the parameter Flush is non zero. Forcing Flush frequently degrades the compression ratio, so this // parameter should be set only when necessary (in interactive applications). // Some output may be provided even if Flush is not set. // // Before the call of Deflate, the application should ensure that at least one of the actions is possible, by providing // more input and/or consuming more output, and updating AvailableInput or AvailableOutput accordingly. AvailableOutput // should never be zero before the call. The application can consume the compressed output when it wants, for example // when the output buffer is full (AvailableOutput = 0), or after each call of Deflate. if Deflate returns Z_OK and with // zero AvailableOutput, it must be called again after making room in the output buffer because there might be more output pending. // // If the parameter Flush is set to Z_PARTIAL_FLUSH, the current compression block is terminated and flushed to the // output buffer so that the decompressor can get all input data available so far. For method 9 a future variant on // method 8, the current block will be flushed but not terminated. Z_SYNC_FLUSH has the same effect as partial flush // except that the compressed output is byte aligned (the compressor can clear its internal bit buffer) and the current // block is always terminated. This can be useful if the compressor has to be restarted from scratch after an // interruption (in which case the internal state of the compressor may be lost). If Flush is set to Z_FULL_FLUSH, the // compression block is terminated, a special marker is output and the compression dictionary is discarded. This // is useful to allow the decompressor to synchronize if one compressed block has been damaged (see InflateSync below). // Flushing degrades compression and so should be used only when necessary. Using Z_FULL_FLUSH too often can seriously // degrade the compression. if Deflate returns with AvailableOutput = 0, this function must be called again with the // same Value of the Flush parameter and more output space (updated AvailableOutput), until the Flush is complete // (Deflate returns with non-zero AvailableOutput). // // If the parameter Flush is set to Z_FINISH, all Pending input is processed, all pending output is flushed and Deflate // returns with Z_STREAM_END if there was enough output space. If Deflate returns with Z_OK, this function must be // called again with Z_FINISH and more output space (updated AvailableOutput) but no more input data, until it returns // with Z_STREAM_END or an error. After Deflate has returned Z_STREAM_END, the only possible operations on the // stream are DeflateReset or DeflateEnd. // // Z_FINISH can be used immediately after DeflateInit if all the compression is to be done in a single step. In this // case, AvailableOutput must be at least 0.1% larger than AvailableInput plus 12 bytes. If Deflate does not return // Z_STREAM_END then it must be called again as described above. // // Deflate may update DataType if it can make a good guess about the input data type (Z_ASCII or Z_BINARY). In doubt, // the data is considered binary. This field is only for information purposes and does not affect the compression // algorithm in any manner. // // Deflate returns Z_OK if some progress has been made (mnore input processed or more output produced), Z_STREAM_END if // all input has been consumed and all output has been produced (only when Flush is set to Z_FINISH), Z_STREAM_ERROR if // the stream State was inconsistent (for example if NextInput or NextOutput was nil), Z_BUF_ERROR if no progress is possible. var OldFlush: Integer; // value of Flush param for previous Deflate call S: PDeflateState; Header: Cardinal; LevelFlags: Cardinal; BlockState: TBlockState; begin if (ZState.State = nil) or (Flush > Z_FINISH) or (Flush < 0) then begin Result:=Z_STREAM_ERROR; Exit; end; S:=PDeflateState(ZState.State); if (ZState.NextOutput = nil) or ((ZState.NextInput = nil) and (ZState.AvailableInput<>0)) or ((S.Status = FINISH_STATE) and (Flush<>Z_FINISH)) then begin ZState.Msg:=ErrorMessages[ERROR_BASE - Z_STREAM_ERROR]; Result:=Z_STREAM_ERROR; Exit; end; if ZState.AvailableOutput = 0 then begin ZState.Msg:=ErrorMessages[ERROR_BASE - Z_BUF_ERROR]; Result:=Z_BUF_ERROR; Exit; end; // just in case S.ZState:=@ZState; OldFlush:=S.LastFlush; S.LastFlush:=Flush; // write the zlib header if S.Status = INIT_STATE then begin Header:=(Z_DEFLATED + ((S.WindowBits - 8) shl 4)) shl 8; LevelFlags:=(S.Level - 1) shr 1; if LevelFlags > 3 then LevelFlags:=3; Header:=Header or (LevelFlags shl 6); if (S.StringStart<>0) then Header:=Header or PRESET_DICT; Inc(Header, 31 - (Header mod 31)); S.Status:=BUSY_STATE; PutShortMSB(S^, Header); // save the Adler32 of the preset dictionary if S.StringStart<>0 then begin PutShortMSB(S^, Cardinal(ZState.Adler shr 16)); PutShortMSB(S^, Cardinal(ZState.Adler and $FFFF)); end; ZState.Adler:=1; end; // flush as much pending output as possible if S.Pending<>0 then begin FlushPending(ZState); if ZState.AvailableOutput = 0 then begin // Since AvailableOutput is 0, Deflate will be called again with // more output space, but possibly with both Pending and // AvailableInput equal to zero. There won't be anything to do, // but this is not an error situation so make sure we // return OK instead of BUF_ERROR at next call of Deflate. S.LastFlush:=-1; Result:=Z_OK; Exit; end; // Make sure there is something to do and avoid duplicate consecutive // flushes. For repeated and useless calls with Z_FINISH, we keep // returning Z_STREAM_END instead of Z_BUFF_ERROR. end else if (ZState.AvailableInput = 0) and (Flush <= OldFlush) and (Flush<>Z_FINISH) then begin ZState.Msg:=ErrorMessages[ERROR_BASE - Z_BUF_ERROR]; Result:=Z_BUF_ERROR; Exit; end; // user must not provide more input after the first FINISH if (S.Status = FINISH_STATE) and (ZState.AvailableInput<>0) then begin ZState.Msg:=ErrorMessages[ERROR_BASE - Z_BUF_ERROR]; Result:=Z_BUF_ERROR; Exit; end; // start a new block or continue the current one if (ZState.AvailableInput<>0) or (S.Lookahead<>0) or ((Flush<>Z_NO_FLUSH) and (S.Status<>FINISH_STATE)) then begin BlockState:=ConfigurationTable[S.Level].Func(S^, Flush); if (BlockState = bsFinishStarted) or (BlockState = bsFinishDone) then S.Status:=FINISH_STATE; if (BlockState = bsNeedMore) or (BlockState = bsFinishStarted) then begin // avoid BUF_ERROR next call, see above if (ZState.AvailableOutput = 0) then S.LastFlush:=-1; Result:=Z_OK; Exit; // If Flush<>Z_NO_FLUSH and AvailableOutput = 0, the next call // of Deflate should use the same Flush parameter to make sure // that the Flush is complete. So we don't have to output an // empty block here, this will be done at next call. This also // ensures that for a very small output buffer we emit at most // one empty block. end; if BlockState = bsBlockDone then begin if Flush = Z_PARTIAL_FLUSH then TreeAlign(S^) else begin // FULL_FLUSH or SYNC_FLUSH TreeStroredBlock(S^, nil, 0, False); // for a full Flush, this empty block will be recognized as a special marker if Flush = Z_FULL_FLUSH then begin // forget history S.Head[S.HashSize - 1]:=ZNIL; FillChar(S.Head^, (S.HashSize - 1) * SizeOf(S.Head[0]), 0); end; end; FlushPending(ZState); if ZState.AvailableOutput = 0 then begin // avoid BUF_ERROR at next call, see above S.LastFlush:=-1; Result:=Z_OK; Exit; end; end; end; if Flush<>Z_FINISH then begin Result:=Z_OK; Exit; end; if S.NoHeader<>0 then begin Result:=Z_STREAM_END; Exit; end; // write the zlib trailer (Adler32) PutShortMSB(S^, Cardinal(ZState.Adler shr 16)); PutShortMSB(S^, Cardinal(ZState.Adler and $FFFF)); FlushPending(ZState); // If AvailableOutput is zero the application will call Deflate again to Flush the rest // write the trailer only once! S.NoHeader:=-1; if S.Pending<>0 then Result:=Z_OK else Result:=Z_STREAM_END; end; //---------------------------------------------------------------------------------------------------------------------- function DeflateEnd(var ZState: TZState): Integer; // All dynamically allocated data structures for this stream are freed. // This function discards any unprocessed input and does not Flush any // pending output. // // DeflateEnd returns Z_OK if success, Z_STREAM_ERROR if the // stream State was inconsistent, Z_DATA_ERROR if the stream was freed // prematurely (some input or output was discarded). var Status: Integer; S: PDeflateState; begin if ZState.State = nil then begin Result:=Z_STREAM_ERROR; Exit; end; S:=PDeflateState(ZState.State); Status:=S.Status; if (Status<>INIT_STATE) and (Status<>BUSY_STATE) and (Status<>FINISH_STATE) then begin Result:=Z_STREAM_ERROR; Exit; end; FreeMem(S.PendingBuffer); FreeMem(S.Head); FreeMem(S.Previous); FreeMem(S.Window); FreeMem(S); ZState.State:=nil; if Status = BUSY_STATE then Result:=Z_DATA_ERROR else Result:=Z_OK; end; //---------------------------------------------------------------------------------------------------------------------- function DeflateCopy(Dest, Source: PZState): Integer; // Copies the source state to the destination state. // // Sets the destination stream as a complete copy of the source stream. If the source stream is using an application- // supplied history buffer, a new buffer is allocated for the destination stream. The compressed output buffer is always // application-supplied. It's the responsibility of the application to provide the correct values of NextOutput and // AvailableOutput for the next call of Deflate. // // This function can be useful when several compression strategies will be tried, for example when there are several // ways of pre-processing the input data with a filter. The streams that will be discarded should then be freed by // calling DeflateEnd. Note that DeflateCopy duplicates the internal compression state which can be quite large, so this // strategy is slow and can consume lots of memory. // // DeflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not enough memory, Z_STREAM_ERROR if the source stream // state was inconsistent (such as zalloc being nil). Msg is left unchanged in both source and destination. var DestState: PDeflateState; SourceState: PDeflateState; Overlay: PWordArray; begin if (Source = nil) or (Dest = nil) or (Source.State = nil) then begin Result:=Z_STREAM_ERROR; Exit; end; SourceState:=PDeflateState(Source.State); Dest^:=Source^; try DestState:=AllocMem(SizeOf(TDeflateState)); Dest.State:=PInternalState(DestState); DestState^:=SourceState^; DestState.ZState:=Dest; DestState.Window:=AllocMem(2 * DestState.WindowSize); DestState.Previous:=AllocMem(DestState.WindowSize * SizeOf(Word)); DestState.Head:=AllocMem(DestState.HashSize * SizeOf(Word)); Overlay:=AllocMem(DestState.LiteralBufferSize * SizeOf(Word) + 2); DestState.PendingBuffer:=PByteArray (Overlay); Move(SourceState.Window^, DestState.Window^, 2 * DestState.WindowSize); Move(SourceState.Previous^, DestState.Previous^, DestState.WindowSize * SizeOf(Word)); Move(SourceState.Head^, DestState.Head^, DestState.HashSize * SizeOf(Word)); Move(SourceState.PendingBuffer^, DestState.PendingBuffer^, DestState.PendingBufferSize); DestState.PendingOutput:=@DestState.PendingBuffer[Cardinal(SourceState.PendingOutput) - Cardinal(SourceState.PendingBuffer)]; DestState.DistanceBuffer:=@Overlay[DestState.LiteralBufferSize div SizeOf(Word)]; DestState.LiteralBuffer:=@DestState.PendingBuffer[(1 + SizeOf(Word)) * DestState.LiteralBufferSize]; DestState.LiteralDescriptor.DynamicTree:=@DestState.LiteralTree; DestState.DistanceDescriptor.DynamicTree:=@DestState.DistanceTree; DestState.BitLengthDescriptor.DynamicTree:=@DestState.BitLengthTree; Result:=Z_OK; except DeflateEnd(Dest^); raise; end; end; //---------------------------------------------------------------------------------------------------------------------- function ReadBuffer(ZState: PZState; Buffer: PByte; Size: Cardinal): Integer; // Reads a new buffer from the current input stream, updates the Adler32 and total number of bytes read. All Deflate // input goes through this function so some applications may wish to modify it to avoid allocating a large // ZState.NextInput buffer and copying from it (see also FlushPending). var Len: Cardinal; begin Len:=ZState.AvailableInput; if Len > Size then Len:=Size; if Len = 0 then begin Result:=0; Exit; end; Dec(ZState.AvailableInput, Len); if PDeflateState(ZState.State).NoHeader = 0 then ZState.Adler:=Adler32(ZState.Adler, ZState.NextInput, Len); Move(ZState.NextInput^, Buffer^, Len); Inc(ZState.NextInput, Len); Inc(ZState.TotalInput, Len); Result:=Len; end; //---------------------------------------------------------------------------------------------------------------------- function LongestMatch(var S: TDeflateState; CurrentMatch: Cardinal): Cardinal; // Sets MatchStart to the longest match starting at the given string and returns its length. Matches shorter or equal to // PreviousLength are discarded, in which case the result is equal to PreviousLength and MatchStart is garbage. // CurrentMatch is the head of the hash chain for the current string (StringStart) and its distance is <= MaxDistance, // and PreviousLength >= 1. // The match length will not be greater than S.Lookahead. var ChainLength: Cardinal; // max hash chain length Scan: PByte; // current string Match: PByte; // matched string Len: Cardinal; // length of current match BestLen: Cardinal; // best match length so far NiceMatch: Cardinal; Limit: Cardinal; Previous: PWordArray; WMask: Cardinal; StrEnd: PByte; ScanEnd1: Byte; ScanEnd: Byte; MaxDistance: Cardinal; begin ChainLength:=S.MaxChainLength; Scan:=@S.Window[S.StringStart]; BestLen:=S.PreviousLength; NiceMatch:=S.NiceMatch; MaxDistance:=S.WindowSize - MIN_LOOKAHEAD; // In order to simplify the code, match distances are limited to MaxDistance instead of WSize. if S.StringStart > MaxDistance then Limit:=S.StringStart - MaxDistance else Limit:=ZNIL; // Stop when CurrentMatch becomes <= Limit. To simplify the Code we prevent matches with the string of window index 0. Previous:=S.Previous; WMask:=S.WindowMask; StrEnd:=@S.Window[S.StringStart + MAX_MATCH]; {$ifopt R+} {$R-} {$define RangeCheck} {$endif} ScanEnd1:=PByteArray(Scan)[BestLen - 1]; ScanEnd:=PByteArray(Scan)[BestLen]; {$ifdef RangeCheck} {$R+} {$undef RangeCheck} {$endif} // The code is optimized for HashBits >= 8 and MAX_MATCH - 2 multiple of 16. // It is easy to get rid of this optimization if necessary. // Do not waste too much time if we already have a good Match. if S.PreviousLength >= S.GoodMatch then ChainLength:=ChainLength shr 2; // Do not look for matches beyond the end of the input. This is necessary to make Deflate deterministic. if NiceMatch > S.Lookahead then NiceMatch:=S.Lookahead; repeat Match:=@S.Window[CurrentMatch]; // Skip to next match if the match length cannot increase or if the match length is less than 2. {$ifopt R+} {$R-} {$define RangeCheck} {$endif} if (PByteArray(Match)[BestLen] = ScanEnd) and (PByteArray(Match)[BestLen - 1] = ScanEnd1) and (Match^ = Scan^) then {$ifdef RangeCheck} {$R+} {$undef RangeCheck} {$endif} begin Inc(Match); if Match^<>PByteArray(Scan)[1] then begin // The Check at BestLen - 1 can be removed because it will be made again later (this heuristic is not always a win). // It is not necessary to compare Scan[2] and Match[2] since they are always equal when the other bytes match, // given that the hash keys are equal and that HashBits >= 8. Inc(Scan, 2); Inc(Match); // We check for insufficient lookahead only every 8th comparison, the 256th check will be made at StringStart + 258. repeat Inc(Scan); Inc(Match); if (Scan^<>Match^) then Break; Inc(Scan); Inc(Match); if (Scan^<>Match^) then Break; Inc(Scan); Inc(Match); if (Scan^<>Match^) then Break; Inc(Scan); Inc(Match); if (Scan^<>Match^) then Break; Inc(Scan); Inc(Match); if (Scan^<>Match^) then Break; Inc(Scan); Inc(Match); if (Scan^<>Match^) then Break; Inc(Scan); Inc(Match); if (Scan^<>Match^) then Break; Inc(Scan); Inc(Match); if (Scan^<>Match^) then Break; until (Cardinal(Scan) >= Cardinal(StrEnd)); Len:=MAX_MATCH - Integer(Cardinal(StrEnd) - Cardinal(Scan)); Scan:=StrEnd; Dec(Scan, MAX_MATCH); if Len > BestLen then begin S.MatchStart:=CurrentMatch; BestLen:=Len; if Len >= NiceMatch then Break; {$ifopt R+} {$R-} {$define RangeCheck} {$endif} ScanEnd1:=PByteArray(Scan)[BestLen - 1]; ScanEnd:=PByteArray(Scan)[BestLen]; {$ifdef RangeCheck} {$R+} {$undef RangeCheck} {$endif} end; end; end; CurrentMatch:=Previous[CurrentMatch and WMask]; Dec(ChainLength); until (CurrentMatch <= Limit) or (ChainLength = 0); if BestLen <= S.Lookahead then Result:=BestLen else Result:=S.Lookahead; end; //---------------------------------------------------------------------------------------------------------------------- procedure FillWindow(var S: TDeflateState); // Fills the window when the lookahead becomes insufficient, updates StringStart and Lookahead. // Lookahead must be less than MIN_LOOKAHEAD. // StringStart will be <= CurrentWindowSize - MIN_LOOKAHEAD on exit. // On exit at least one byte has been read, or AvailableInput = 0. Reads are performed for at least two bytes (required // for the zip translate_eol option -> not supported here). var N, M: Cardinal; P: PWord; More: Cardinal; // amount of free space at the end of the window WSize: Cardinal; begin WSize:=S.WindowSize; repeat More:=S.CurrentWindowSize - Integer(S.Lookahead) - Integer(S.StringStart); if (More = 0) and (S.StringStart = 0) and (S.Lookahead = 0) then More:=WSize else if More = Cardinal(-1) then begin // Very unlikely, but sometimes possible if StringStart = 0 and Lookahead = 1 (input done one byte at time) Dec(More); // If the Window is almost full and there is insufficient lookahead, // move the upper half to the lower one to make room in the upper half. end else if S.StringStart >= WSize + (WSize - MIN_LOOKAHEAD) then begin Move(S.Window[WSize], S.Window^, WSize); Dec(S.MatchStart, WSize); Dec(S.StringStart, WSize); // we now have StringStart >= MaxDistance Dec(S.BlockStart, Integer(WSize)); // Slide the hash table (could be avoided with 32 bit values at the expense of memory usage). We slide even when // Level = 0 to keep the hash table consistent if we switch back to Level > 0 later. (Using Level 0 permanently // is not an optimal usage of zlib, so we don't care about this pathological case.) N:=S.HashSize; P:=@S.Head[N]; repeat Dec(P); M:=P^; if M >= WSize then P^:=M - WSize else P^:=ZNIL; Dec(N); until N = 0; N:=WSize; P:=@S.Previous[N]; repeat Dec(P); M:=P^; if M >= WSize then P^:=M - WSize else P^:=ZNIL; // if N is not on any hash chain Previous[N] is garbage but its value will never be used Dec(N); until N = 0; Inc(More, WSize); end; if S.ZState.AvailableInput = 0 then Exit; // If there was no sliding: // StringStart <= WSize + MaxDistance - 1 and Lookahead <= MIN_LOOKAHEAD - 1 and // More = CurrentWindowSize - Lookahead - StringStart // => More >= CurrentWindowSize - (MIN_LOOKAHEAD - 1 + WSize + MaxDistance - 1) // => More >= CurrentWindowSize - 2 * WSize + 2 // In the BIG_MEM or MMAP case (not yet supported), // CurrentWindowSize = input_size + MIN_LOOKAHEAD and // StringStart + S.Lookahead <= input_size => More >= MIN_LOOKAHEAD. // Otherwise, CurrentWindowSize = 2 * WSize so More >= 2. // If there was sliding More >= WSize. So in all cases More >= 2. N:=ReadBuffer(S.ZState, @S.Window[S.StringStart + S.Lookahead], More); Inc(S.Lookahead, N); // Initialize the hash Value now that we have some input: if S.Lookahead >= MIN_MATCH then begin S.InsertHash:=S.Window[S.StringStart]; S.InsertHash:=((S.InsertHash shl S.HashShift) xor S.Window[S.StringStart + 1]) and S.HashMask; end; // If the whole input has less than MIN_MATCH bytes, InsertHash is garbage, // but this is not important since only literal bytes will be emitted. until (S.Lookahead >= MIN_LOOKAHEAD) or (S.ZState.AvailableInput = 0); end; //---------------------------------------------------------------------------------------------------------------------- procedure FlushBlockOnly(var S: TDeflateState; EOF: Boolean); // Flushs the current block with given end-of-file flag. // StringStart must be set to the end of the current match. begin if S.BlockStart >= 0 then TreeFlushBlock(S, @S.Window[Cardinal(S.BlockStart)], Integer(S.StringStart) - S.BlockStart, EOF) else TreeFlushBlock(S, nil, Integer(S.StringStart) - S.BlockStart, EOF); S.BlockStart:=S.StringStart; FlushPending(S.ZState^); end; //---------------------------------------------------------------------------------------------------------------------- function DeflateStored(var S: TDeflateState; Flush: Integer): TBlockState; // Copies without compression as much as possible from the input stream and returns the current block state. // This function does not insert new strings in the dictionary since uncompressible data is probably not useful. // This function is used only for the Level = 0 compression option. // NOTE: This function should be optimized to avoid extra copying from Window to PendingBuffer. // // Stored blocks are limited to $FFFF bytes, PendingBuffer is limited to PendingBufferSize // and each stored block has a 5 Byte header. var MaxBlockSize: Integer; MaxStart: Cardinal; begin MaxBlockSize:=$FFFF; if MaxBlockSize > S.PendingBufferSize - 5 then MaxBlockSize:=S.PendingBufferSize - 5; // copy as much as possible from input to output while True do begin // fill the window as much as possible if S.Lookahead <= 1 then begin FillWindow(S); if (S.Lookahead = 0) and (Flush = Z_NO_FLUSH) then begin Result:=bsNeedMore; Exit; end; // flush the current block if S.Lookahead = 0 then Break; end; Inc(S.StringStart, S.Lookahead); S.Lookahead:=0; // emit a stored block if PendingBuffer will be full MaxStart:=S.BlockStart + MaxBlockSize; if (S.StringStart = 0) or (S.StringStart >= MaxStart) then begin // StringStart = 0 is possible when wrap around on 16-bit machine S.Lookahead:=S.StringStart - MaxStart; S.StringStart:=MaxStart; FlushBlockOnly(S, False); if S.ZState.AvailableOutput = 0 then begin Result:=bsNeedMore; Exit; end; end; // Flush if we may have to slide, otherwise BlockStart may become negative and the data will be gone. if S.StringStart - Cardinal(S.BlockStart) >= S.WindowSize - MIN_LOOKAHEAD then begin FlushBlockOnly(S, False); if S.ZState.AvailableOutput = 0 then begin Result:=bsNeedMore; Exit; end; end; end; FlushBlockOnly(S, Flush = Z_FINISH); if S.ZState.AvailableOutput = 0 then begin if Flush = Z_FINISH then Result:=bsFinishStarted else DeflateStored:=bsNeedMore; Exit; end; if Flush = Z_FINISH then Result:=bsFinishDone else Result:=bsBlockDone; end; //---------------------------------------------------------------------------------------------------------------------- function DeflateFast(var S: TDeflateState; Flush: Integer): TBlockState; // Compresses as much as possible from the input stream and returns the current block state. // This function does not perform lazy evaluation of matches and inserts new strings in the Dictionary only for // unmatched strings or for short matches. It is used only for the fast compression options. var HashHead: Cardinal; // head of the hash chain BlockFlush: Boolean; // set if current block must be flushed begin HashHead:=ZNIL; while True do begin // Make sure that we always have enough lookahead, except at the end of the input file. We need MAX_MATCH bytes // for the next match plus MIN_MATCH bytes to insert the string following the next match. if S.Lookahead < MIN_LOOKAHEAD then begin FillWindow(S); if (S.Lookahead < MIN_LOOKAHEAD) and (Flush = Z_NO_FLUSH) then begin Result:=bsNeedMore; Exit; end; // flush the current block if S.Lookahead = 0 then Break; end; // Insert the string Window[StringStart .. StringStart + 2] in the // dictionary and set HashHead to the head of the hash chain. if S.Lookahead >= MIN_MATCH then InsertString(S, S.StringStart, HashHead); // Find the longest match, discarding those <= PreviousLength. // At this point we have always MatchLength < MIN_MATCH. if (HashHead<>ZNIL) and (S.StringStart - HashHead <= (S.WindowSize - MIN_LOOKAHEAD)) then begin // To simplify the code, we prevent matches with the string of window index 0 (in particular we have to // avoid a match of the string with itself at the start of the input file). if S.Strategy<>Z_HUFFMAN_ONLY then S.MatchLength:=LongestMatch(S, HashHead); end; if S.MatchLength >= MIN_MATCH then begin BlockFlush:=TreeTally(S, S.StringStart - S.MatchStart, S.MatchLength - MIN_MATCH); Dec(S.Lookahead, S.MatchLength); // Insert new strings in the hash table only if the match length // is not too large. This saves time but degrades compression. if (S.MatchLength <= S.MaxInsertLength) and (S.Lookahead >= MIN_MATCH) then begin // string at StringStart already in hash table Dec(S.MatchLength); repeat Inc(S.StringStart); InsertString(S, S.StringStart, HashHead); // StringStart never exceeds WSize - MAX_MATCH, so there are always MIN_MATCH bytes ahead. Dec(S.MatchLength); until S.MatchLength = 0; Inc(S.StringStart); end else begin Inc(S.StringStart, S.MatchLength); S.MatchLength:=0; S.InsertHash:=S.Window[S.StringStart]; S.InsertHash:=((S.InsertHash shl S.HashShift) xor S.Window[S.StringStart + 1]) and S.HashMask; // if Lookahead < MIN_MATCH, InsertHash is garbage, but it does not // matter since it will be recomputed at next Deflate call. end; end else begin // no match, output a literal byte BlockFlush:=TreeTally(S, 0, S.Window[S.StringStart]); Dec(S.Lookahead); Inc(S.StringStart); end; if BlockFlush then begin FlushBlockOnly(S, False); if S.ZState.AvailableOutput = 0 then begin Result:=bsNeedMore; Exit; end; end; end; FlushBlockOnly(S, Flush = Z_FINISH); if S.ZState.AvailableOutput = 0 then begin if Flush = Z_FINISH then Result:=bsFinishStarted else Result:=bsNeedMore; end else if Flush = Z_FINISH then Result:=bsFinishDone else Result:=bsBlockDone; end; //---------------------------------------------------------------------------------------------------------------------- function DeflateSlow(var S: TDeflateState; Flush: Integer): TBlockState; // Same as above, but achieves better compression. We use a lazy evaluation for matches. A match is finally adopted // only if there is no better match at the next window position. var HashHead: Cardinal; // head of hash chain BlockFlush: Boolean; // set if current block must be flushed MaxInsert: Cardinal; begin HashHead:=ZNIL; while True do begin // Make sure that we always have enough lookahead, except at the end of the input file. We need MAX_MATCH bytes // for the next match, plus MIN_MATCH bytes to insert the string following the next match. if S.Lookahead < MIN_LOOKAHEAD then begin FillWindow(S); if (S.Lookahead < MIN_LOOKAHEAD) and (Flush = Z_NO_FLUSH) then begin Result:=bsNeedMore; Exit; end; // flush the current block if S.Lookahead = 0 then Break; end; // Insert the string Window[StringStart .. StringStart + 2] in the // dictionary and set HashHead to the head of the hash chain. if S.Lookahead >= MIN_MATCH then InsertString(S, S.StringStart, HashHead); // find the longest match, discarding those <= PreviousLength S.PreviousLength:=S.MatchLength; S.PreviousMatch:=S.MatchStart; S.MatchLength:=MIN_MATCH - 1; if (HashHead<>ZNIL) and (S.PreviousLength < S.MaxLazyMatch) and (S.StringStart - HashHead <= (S.WindowSize - MIN_LOOKAHEAD)) then begin // To simplify the code we prevent matches with the string of window Index 0 (in particular we have // to avoid a match of the string with itself at the start of the input file). if S.Strategy<>Z_HUFFMAN_ONLY then S.MatchLength:=LongestMatch(S, HashHead); if (S.MatchLength <= 5) and ((S.Strategy = Z_FILTERED) or ((S.MatchLength = MIN_MATCH) and (S.StringStart - S.MatchStart > TOO_FAR))) then begin // If PreviousMatch is also MIN_MATCH MatchStart is garbage but we will ignore the current match anyway. S.MatchLength:=MIN_MATCH - 1; end; end; // If there was a match at the previous step and the current match is not better output the previous match. if (S.PreviousLength >= MIN_MATCH) and (S.MatchLength <= S.PreviousLength) then begin MaxInsert:=S.StringStart + S.Lookahead - MIN_MATCH; // Do not insert strings in hash table beyond this. BlockFlush:=TreeTally(S, S.StringStart - 1 - S.PreviousMatch, S.PreviousLength - MIN_MATCH); // Insert in hash table all strings up to the end of the match. StringStart - 1 and StringStart are already inserted. // If there is not enough lookahead the last two strings are not inserted in the hash table. Dec(S.Lookahead, S.PreviousLength - 1); Dec(S.PreviousLength, 2); repeat Inc(S.StringStart); if S.StringStart <= MaxInsert then InsertString(S, S.StringStart, HashHead); Dec(S.PreviousLength); until S.PreviousLength = 0; S.MatchAvailable:=False; S.MatchLength:=MIN_MATCH - 1; Inc(S.StringStart); if BlockFlush then begin FlushBlockOnly(S, False); if S.ZState.AvailableOutput = 0 then begin Result:=bsNeedMore; Exit; end; end; end else if S.MatchAvailable then begin // If there was no match at the previous position output a single literal. // If there was a match but the current match is longer truncate the previous match to a single literal. BlockFlush:=TreeTally (S, 0, S.Window[S.StringStart - 1]); if BlockFlush then FlushBlockOnly(S, False); Inc(S.StringStart); Dec(S.Lookahead); if S.ZState.AvailableOutput = 0 then begin Result:=bsNeedMore; Exit; end; end else begin // There is no previous match to compare with wait for the next step to decide. S.MatchAvailable:=True; Inc(S.StringStart); Dec(S.Lookahead); end; end; if S.MatchAvailable then begin TreeTally (S, 0, S.Window[S.StringStart - 1]); S.MatchAvailable:=False; end; FlushBlockOnly(S, Flush = Z_FINISH); if S.ZState.AvailableOutput = 0 then begin if Flush = Z_FINISH then Result:=bsFinishStarted else Result:=bsNeedMore; end else if Flush = Z_FINISH then Result:=bsFinishDone else Result:=bsBlockDone; end; //----------------- Inflate support ------------------------------------------------------------------------------------ const InflateMask: array[0..16] of Cardinal = ( $0000, $0001, $0003, $0007, $000F, $001F, $003F, $007F, $00FF, $01FF, $03FF, $07FF, $0FFF, $1FFF, $3FFF, $7FFF, $FFFF ); function InflateFlush(var S: TInflateBlocksState; var Z: TZState; R: Integer): Integer; // copies as much as possible from the sliding window to the output area var N: Cardinal; P: PByte; Q: PByte; begin // local copies of source and destination pointers P:=Z.NextOutput; Q:=S.Read; // compute number of bytes to copy as far as end of window if Cardinal(Q) <= Cardinal(S.Write) then N:=Cardinal(S.Write) - Cardinal(Q) else N:=Cardinal(S.zend) - Cardinal(Q); if N > Z.AvailableOutput then N:=Z.AvailableOutput; if (N<>0) and (R = Z_BUF_ERROR) then R:=Z_OK; // update counters Dec(Z.AvailableOutput, N); Inc(Z.TotalOutput, N); // update check information if Assigned(S.CheckFunction) then begin S.Check:=S.CheckFunction(S.Check, Q, N); Z.Adler:=S.Check; end; // copy as far as end of Window Move(Q^, P^, 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:=Cardinal(S.write) - Cardinal(Q); if N > Z.AvailableOutput then N:=Z.AvailableOutput; if (N<>0) and (R = Z_BUF_ERROR) then R:=Z_OK; // update counters Dec(Z.AvailableOutput, N); Inc(Z.TotalOutput, N); // update check information if Assigned(S.CheckFunction) then begin S.Check:=S.CheckFunction(S.Check, Q, N); Z.Adler:=S.Check; end; // copy Move(Q^, P^, N); Inc(P, N); Inc(Q, N); end; // update pointers Z.NextOutput:=P; S.Read:=Q; Result:=R; end; //---------------------------------------------------------------------------------------------------------------------- function InflateFast(LiteralBits, DistanceBits: Cardinal; TL, TD: PInflateHuft; var S: TInflateBlocksState; var Z: TZState): Integer; // 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. var Temp: PInflateHuft; Extra: Cardinal; // extra bits or operation BitsBuffer: Cardinal; K: Cardinal; // bits in bit buffer P: PByte; // input data pointer N: Cardinal; // bytes available there Q: PByte; // output window write pointer M: Cardinal; // bytes to end of window or read pointer ml: Cardinal; // mask for literal/length tree md: Cardinal; // mask for distance tree C: Cardinal; // bytes to copy D: Cardinal; // distance back to copy from R: PByte; // copy source pointer begin // load input, output, bit values P:=Z.NextInput; N:=Z.AvailableInput; BitsBuffer:=S.bitb; K:=S.bitk; Q:=S.write; if Cardinal(Q) < Cardinal(S.Read) then M:=Cardinal(S.read) - Cardinal(Q) - 1 else M:=Cardinal(S.zend)-Cardinal(Q); // initialize masks ml:=InflateMask[LiteralBits]; md:=InflateMask[DistanceBits]; // do until not enough input or output space for fast loop, // assume called with (M >= 258) and (N >= 10) repeat // get literal/length Code while K < 20 do begin Dec(N); BitsBuffer:=BitsBuffer or (Cardinal(P^) shl K); Inc(P); Inc(K, 8); end; Temp:=@PHuftField(TL)[BitsBuffer and ml]; Extra:=Temp.exop; if Extra = 0 then begin BitsBuffer:=BitsBuffer shr Temp.Bits; Dec(K, Temp.Bits); Q^:=Temp.Base; Inc(Q); Dec(M); Continue; end; repeat BitsBuffer:=BitsBuffer shr Temp.Bits; Dec(K, Temp.Bits); if (Extra and 16)<>0 then begin // get extra bits for length Extra:=Extra and 15; C:=Temp.Base + (BitsBuffer and InflateMask[Extra]); BitsBuffer:=BitsBuffer shr Extra; Dec(K, Extra); // decode distance base of block to copy while K < 15 do begin Dec(N); BitsBuffer:=BitsBuffer or (Cardinal(P^) shl K); Inc(P); Inc(K, 8); end; Temp:=@PHuftField(TD)[BitsBuffer and md]; Extra:=Temp.exop; repeat BitsBuffer:=BitsBuffer shr Temp.Bits; Dec(K, Temp.Bits); if (Extra and 16)<>0 then begin // get extra bits to add to distance base Extra:=Extra and 15; while K < Extra do begin Dec(N); BitsBuffer:=BitsBuffer or (Cardinal(P^) shl K); Inc(P); Inc(K, 8); end; D:=Temp.Base + (BitsBuffer and InflateMask[Extra]); BitsBuffer:=BitsBuffer shr Extra; Dec(K, Extra); // do the copy Dec(M, C); // offset before Dest if (Cardinal(Q) - Cardinal(S.Window)) >= D then 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 begin // offset after destination, // bytes from offset to end Extra:=D - (Cardinal(Q) - Cardinal(S.Window)); R:=S.zend; // pointer to offset Dec(R, Extra); if C > Extra then begin // copy to end of window Dec(C, Extra); repeat Q^:=R^; Inc(Q); Inc(R); Dec(Extra); until Extra = 0; // copy rest from start of window R:=S.Window; end; end; // copy all or what's left repeat Q^:=R^; Inc(Q); Inc(R); Dec(C); until C = 0; Break; end else if (Extra and 64) = 0 then begin Inc(Temp, Temp.Base + (BitsBuffer and InflateMask[Extra])); Extra:=Temp.exop; end else begin Z.Msg:=SInvalidDistanceCode; C:=Z.AvailableInput - N; if (K shr 3) < C then C:=K shr 3; Inc(N, C); Dec(P, C); Dec(K, C shl 3); S.bitb:=BitsBuffer; S.bitk:=K; Z.AvailableInput:=N; Inc(Z.TotalInput, Cardinal(P) - Cardinal(Z.NextInput)); Z.NextInput:=P; S.write:=Q; Result:=Z_DATA_ERROR; Exit; end; until False; Break; end; if (Extra and 64) = 0 then begin Inc(Temp, Temp.Base + (BitsBuffer and InflateMask[Extra])); Extra:=Temp.exop; if Extra = 0 then begin BitsBuffer:=BitsBuffer shr Temp.Bits; Dec(K, Temp.Bits); Q^:=Temp.Base; Inc(Q); Dec(M); Break; end; end else if (Extra and 32)<>0 then begin C:=Z.AvailableInput - N; if (K shr 3) < C then C:=K shr 3; Inc(N, C); Dec(P, C); Dec(K, C shl 3); S.bitb:=BitsBuffer; S.bitk:=K; Z.AvailableInput:=N; Inc(Z.TotalInput, Cardinal(P) - Cardinal(Z.NextInput)); Z.NextInput:=P; S.write:=Q; Result:=Z_STREAM_END; Exit; end else begin Z.Msg:=SInvalidLengthCode; C:=Z.AvailableInput - N; if (K shr 3) < C then C:=K shr 3; Inc(N, C); Dec(P, C); Dec(K, C shl 3); S.bitb:=BitsBuffer; S.bitk:=K; Z.AvailableInput:=N; Inc(Z.TotalInput, Cardinal(P) - Cardinal(Z.NextInput)); Z.NextInput:=P; S.write:=Q; Result:=Z_DATA_ERROR; Exit; end; until False; until (M < 258) or (N < 10); // not enough input or output -> restore pointers and return C:=Z.AvailableInput - N; if (K shr 3) < C then C:=K shr 3; Inc(N, C); Dec(P, C); Dec(K, C shl 3); S.bitb:=BitsBuffer; S.bitk:=K; Z.AvailableInput:=N; Inc(Z.TotalInput, Cardinal(P) - Cardinal(Z.NextInput)); Z.NextInput:=P; S.write:=Q; Result:=Z_OK; end; //---------------------------------------------------------------------------------------------------------------------- function InflateCodesNew(LiteralBits: Cardinal; DistanceBits: Cardinal; TL, TD: PInflateHuft; var Z: TZState): PInflateCodesState; begin Result:=AllocMem(SizeOf(TInflateCodesState)); Result.Mode:=icmStart; Result.LiteralTreeBits:=LiteralBits; Result.DistanceTreeBits:=DistanceBits; Result.LiteralTree:=TL; Result.DistanceTree:=TD; end; //---------------------------------------------------------------------------------------------------------------------- function InflateCodes(var S: TInflateBlocksState; var Z: TZState; R: Integer): Integer; var J: Cardinal; // temporary storage Temp: PInflateHuft; Extra: Cardinal; // extra bits or operation BitsBuffer: Cardinal; K: Cardinal; // bits in bit buffer P: PByte; // input data pointer N: Cardinal; // bytes available there Q: PByte; // output window write pointer M: Cardinal; // bytes to end of window or read pointer F: PByte; // pointer to copy strings from C: PInflateCodesState; begin C:=S.sub.decode.codes; // codes state // copy input/output information to locals P:=Z.NextInput; N:=Z.AvailableInput; BitsBuffer:=S.bitb; K:=S.bitk; Q:=S.write; if Cardinal(Q) < Cardinal(S.read) then M:=Cardinal(S.read) - Cardinal(Q) - 1 else M:=Cardinal(S.zend)-Cardinal(Q); // process input and output based on current state while True do begin case C.Mode of icmStart: begin if (M >= 258) and (N >= 10) then begin S.bitb:=BitsBuffer; S.bitk:=K; Z.AvailableInput:=N; Inc(Z.TotalInput, Cardinal(P) - Cardinal(Z.NextInput)); Z.NextInput:=P; S.write:=Q; R:=InflateFast(C.LiteralTreeBits, C.DistanceTreeBits, C.LiteralTree, C.DistanceTree, S, Z); P:=Z.NextInput; N:=Z.AvailableInput; BitsBuffer:=S.bitb; K:=S.bitk; Q:=S.write; if Cardinal(Q) < Cardinal(S.read) then M:=Cardinal(S.read) - Cardinal(Q) - 1 else M:=Cardinal(S.zend) - Cardinal(Q); if R<>Z_OK then begin if R = Z_STREAM_END then C.mode:=icmWash else C.mode:=icmBadCode; Continue; end; end; C.sub.Code.need:=C.LiteralTreeBits; C.sub.Code.Tree:=C.LiteralTree; C.mode:=icmLen; end; icmLen: // I: get length/literal/eob next begin J:=C.sub.Code.need; while K < J do begin if N<>0 then R:=Z_OK else begin S.bitb:=BitsBuffer; S.bitk:=K; Z.AvailableInput:=N; Inc(Z.TotalInput, Cardinal(P) - Cardinal(Z.NextInput)); Z.NextInput:=P; S.write:=Q; Result:=InflateFlush(S, Z, R); Exit; end; Dec(N); BitsBuffer:=BitsBuffer or (Cardinal(P^) shl K); Inc(P); Inc(K, 8); end; Temp:=C.sub.Code.Tree; Inc(Temp, Cardinal(BitsBuffer) and InflateMask[J]); BitsBuffer:=BitsBuffer shr Temp.Bits; Dec(K, Temp.Bits); Extra:=Temp.exop; // literal if Extra = 0 then begin C.sub.lit:=Temp.Base; C.mode:=icmLit; Continue; end; // length if (Extra and 16)<>0 then begin C.sub.copy.get:=Extra and 15; C.Len:=Temp.Base; C.mode:=icmLenNext; Continue; end; // next table if (Extra and 64) = 0 then begin C.sub.Code.need:=Extra; C.sub.Code.Tree:=@PHuftField(Temp)[Temp.Base]; Continue; end; // end of block if (Extra and 32)<>0 then begin C.mode:=icmWash; Continue; end; // invalid code C.mode:=icmBadCode; Z.Msg:=SInvalidLengthCode; R:=Z_DATA_ERROR; S.bitb:=BitsBuffer; S.bitk:=K; Z.AvailableInput:=N; Inc(Z.TotalInput, Cardinal(P) - Cardinal(Z.NextInput)); Z.NextInput:=P; S.write:=Q; Result:=InflateFlush(S, Z, R); Exit; end; icmLenNext: // I: getting length extra (have base) begin J:=C.sub.copy.get; while K < J do begin if N<>0 then R:=Z_OK else begin S.bitb:=BitsBuffer; S.bitk:=K; Z.AvailableInput:=N; Inc(Z.TotalInput, Cardinal(P) - Cardinal(Z.NextInput)); Z.NextInput:=P; S.write:=Q; Result:=InflateFlush(S, Z, R); Exit; end; Dec(N); BitsBuffer:=BitsBuffer or (Cardinal(P^) shl K); Inc(P); Inc(K, 8); end; Inc(C.Len, Cardinal(BitsBuffer and InflateMask[J])); BitsBuffer:=BitsBuffer shr J; Dec(K, J); C.sub.Code.need:=C.DistanceTreeBits; C.sub.Code.Tree:=C.DistanceTree; C.mode:=icmDistance; end; icmDistance: // I: get distance next begin J:=C.sub.Code.need; while K < J do begin if N<>0 then R:=Z_OK else begin S.bitb:=BitsBuffer; S.bitk:=K; Z.AvailableInput:=N; Inc(Z.TotalInput, Cardinal(P) - Cardinal(Z.NextInput)); Z.NextInput:=P; S.write:=Q; Result:=InflateFlush(S, Z, R); Exit; end; Dec(N); BitsBuffer:=BitsBuffer or (Cardinal(P^) shl K); Inc(P); Inc(K, 8); end; Temp:=@PHuftField(C.sub.Code.Tree)[BitsBuffer and InflateMask[J]]; BitsBuffer:=BitsBuffer shr Temp.Bits; Dec(K, Temp.Bits); Extra:=Temp.exop; // distance if (Extra and 16)<>0 then begin C.sub.copy.get:=Extra and 15; C.sub.copy.Distance:=Temp.Base; C.mode:=icmDistExt; Continue; end; // next table if (Extra and 64) = 0 then begin C.sub.Code.need:=Extra; C.sub.Code.Tree:=@PHuftField(Temp)[Temp.Base]; Continue; end; // invalid code C.mode:=icmBadCode; Z.Msg:=SInvalidDistanceCode; R:=Z_DATA_ERROR; S.bitb:=BitsBuffer; S.bitk:=K; Z.AvailableInput:=N; Inc(Z.TotalInput, Cardinal(P) - Cardinal(Z.NextInput)); Z.NextInput:=P; S.write:=Q; Result:=InflateFlush(S, Z, R); Exit; end; icmDistExt: // I: getting distance extra begin J:=C.sub.copy.get; while K < J do begin if N<>0 then R:=Z_OK else begin S.bitb:=BitsBuffer; S.bitk:=K; Z.AvailableInput:=N; Inc(Z.TotalInput, Cardinal(P) - Cardinal(Z.NextInput)); Z.NextInput:=P; S.write:=Q; Result:=InflateFlush(S, Z, R); Exit; end; Dec(N); BitsBuffer:=BitsBuffer or (Cardinal(P^) shl K); Inc(P); Inc(K, 8); end; Inc(C.sub.copy.Distance, Cardinal(BitsBuffer) and InflateMask[J]); BitsBuffer:=BitsBuffer shr J; Dec(K, J); C.mode:=icmCopy; end; icmCopy: // O: copying bytes in window, waiting for space begin F:=Q; Dec(F, C.sub.copy.Distance); if (Cardinal(Q) - Cardinal(S.Window)) < C.sub.copy.Distance then begin F:=S.zend; Dec(F, C.sub.copy.Distance - (Cardinal(Q) - Cardinal(S.Window))); end; while C.Len<>0 do begin if M = 0 then begin if (Q = S.zend) and (S.read<>S.Window) then begin Q:=S.Window; if Cardinal(Q) < Cardinal(S.read) then M:=Cardinal(S.read) - Cardinal(Q) - 1 else M:=Cardinal(S.zend)-Cardinal(Q); end; if M = 0 then begin S.write:=Q; R:=InflateFlush(S, Z, R); Q:=S.write; if Cardinal(Q) < Cardinal(S.read) then M:=Cardinal(S.read) - Cardinal(Q) - 1 else M:=Cardinal(S.zend) - Cardinal(Q); if (Q = S.zend) and (S.read<>S.Window) then begin Q:=S.Window; if Cardinal(Q) < Cardinal(S.read) then M:=Cardinal(S.read) - Cardinal(Q) - 1 else M:=Cardinal(S.zend) - Cardinal(Q); end; if M = 0 then begin S.bitb:=BitsBuffer; S.bitk:=K; Z.AvailableInput:=N; Inc(Z.TotalInput, Cardinal(P) - Cardinal(Z.NextInput)); Z.NextInput:=P; S.write:=Q; Result:=InflateFlush(S, Z, R); Exit; end; end; end; R:=Z_OK; Q^:=F^; Inc(Q); Inc(F); Dec(M); if (F = S.zend) then F:=S.Window; Dec(C.Len); end; C.mode:=icmStart; end; icmLit: // O: got literal, waiting for output space begin if M = 0 then begin if (Q = S.zend) and (S.read<>S.Window) then begin Q:=S.Window; if Cardinal(Q) < Cardinal(S.read) then M:=Cardinal(S.read) - Cardinal(Q) - 1 else M:=Cardinal(S.zend) - Cardinal(Q); end; if M = 0 then begin S.write:=Q; R:=InflateFlush(S, Z, R); Q:=S.write; if Cardinal(Q) < Cardinal(S.read) then M:=Cardinal(S.read) - Cardinal(Q) - 1 else M:=Cardinal(S.zend) - Cardinal(Q); if (Q = S.zend) and (S.read<>S.Window) then begin Q:=S.Window; if Cardinal(Q) < Cardinal(S.read) then M:=Cardinal(S.read) - Cardinal(Q) - 1 else M:=Cardinal(S.zend) - Cardinal(Q); end; if M = 0 then begin S.bitb:=BitsBuffer; S.bitk:=K; Z.AvailableInput:=N; Inc(Z.TotalInput, Cardinal(P) - Cardinal(Z.NextInput)); Z.NextInput:=P; S.write:=Q; Result:=InflateFlush(S, Z, R); Exit; end; end; end; R:=Z_OK; Q^:=C.sub.lit; Inc(Q); Dec(M); C.mode:=icmStart; end; icmWash: // O: got eob, possibly More output begin // return unused byte, if any if K > 7 then begin Dec(K, 8); Inc(N); Dec(P); // can always return one end; S.write:=Q; R:=InflateFlush(S, Z, R); Q:=S.write; if Cardinal(Q) < Cardinal(S.read) then M:=Cardinal(S.read) - Cardinal(Q) - 1 else M:=Cardinal(S.zend) - Cardinal(Q); if S.read<>S.write then begin S.bitb:=BitsBuffer; S.bitk:=K; Z.AvailableInput:=N; Inc(Z.TotalInput, Cardinal(P) - Cardinal(Z.NextInput)); Z.NextInput:=P; S.write:=Q; Result:=InflateFlush(S, Z, R); Exit; end; C.mode:=icmZEnd; end; icmZEnd: begin R:=Z_STREAM_END; S.bitb:=BitsBuffer; S.bitk:=K; Z.AvailableInput:=N; Inc(Z.TotalInput, Cardinal(P) - Cardinal(Z.NextInput)); Z.NextInput:=P; S.write:=Q; Result:=InflateFlush(S, Z, R); Exit; end; icmBadCode: // X: got error begin R:=Z_DATA_ERROR; S.bitb:=BitsBuffer; S.bitk:=K; Z.AvailableInput:=N; Inc(Z.TotalInput, Cardinal(P) - Cardinal(Z.NextInput)); Z.NextInput:=P; S.write:=Q; Result:=InflateFlush(S, Z, R); Exit; end; else begin R:=Z_STREAM_ERROR; S.bitb:=BitsBuffer; S.bitk:=K; Z.AvailableInput:=N; Inc(Z.TotalInput, Cardinal(P) - Cardinal(Z.NextInput)); Z.NextInput:=P; S.write:=Q; Result:=InflateFlush(S, Z, R); Exit; end; end; end; Result:=Z_STREAM_ERROR; end; //---------------------------------------------------------------------------------------------------------------------- const // Maximum Size of dynamic tree. The maximum found in an integer 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. MANY = 1440; // Tables for deflate from PKZIP'S appnote.txt // copy lengths for literal codes 257..285 (actually lengths - 2; also see note #13 above about 258) CopyLengths: array [0..30] of Cardinal = ( 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 ); INVALID_CODE = 112; // extra bits for literal codes 257..285 CopyLiteralExtra: array [0..30] of Cardinal = ( 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 ); // copy offsets for distance codes 0..29 CopyOffsets: array [0..29] of Cardinal = ( 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 ); // extra bits for distance codes CopyExtra: array [0..29] of Cardinal = ( 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. // 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 integer. 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 LiteralTreeBits and DistanceTreeBits // below. LiteralTreeBits is the number of bits the first level table for literal/ // length codes can decode in one step, and DistanceTreeBits 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 LiteralTreeBits is 8 + 1 and DistanceTreeBits is 5 + 1. // The optimum values may differ though from machine to machine, and possibly even between compilers. const // maximum bit length of any code, // If BMAX needs to be larger than 16, then H and X[] should be Cardinal. BMAX = 15; //---------------------------------------------------------------------------------------------------------------------- function BuildHuffmanTables(const B: array of Cardinal; N,S: Cardinal; const D, Extra: array of Cardinal; Temp: PPInflateHuft; var M: Cardinal; var HP: array of TInflateHuft; var HN: Cardinal; var V: array of Cardinal): Integer; // Given a list of code lengths and a maximum table size, make a set of tables to decode that set of codes. Returns 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. // // Input pareters: // B contains the code lenths in bits (all assumed <= BMAX) // N is the number of codes (<= NMAX) // S is the number of simple valued codes (0..S - 1) // D contains a list of base values for non-simple codes // Extra carries a list of extra bits for non-simple codes // // Output parameters: // Temp points to the starting table // M receives the maxium lookup bits (actual space for trees) // HP receives the Huffman tables // while HN decribes how many of HP is actually used // finally V is a working area which receives values in order of bit length var A: Cardinal; // counter for codes of length K C: array[0..BMAX] of Cardinal; // bit length count table F: Cardinal; // I repeats in table every F entries G: Integer; // maximum code Length H: Integer; // table Level I: Cardinal; // counter, current code J: Cardinal; // counter K: Integer; // number of bits in current code L: Integer; // bits per table (returned in M) Mask: Cardinal; // (1 shl W) - 1, to avoid cc - O bug on HP P: PCardinal; // pointer into C[], B[], or V[] Q: PInflateHuft; // points to current table R: TInflateHuft; // table entry for structure assignment U: array[0..pred(BMAX)] of PInflateHuft; // table stack W: Integer; // bits before this table = (L * H) X: array[0..BMAX] of Cardinal; // bit offsets, then code stack XP: PCardinal; // pointer into X Y: Integer; // number of dummy codes added Z: Cardinal; // number of entries in current table begin // generate counts for each bit length FillChar(C,sizeof(C),0); // assume all entries <= BMAX for I:=0 to pred(N) do Inc(C[B[I]]); // nil input -> all zero length codes if C[0]=N then Begin Temp^:=nil; M:=0 ; Result:=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; // minimum code Length K:=J; if Cardinal(L)0 then Break; // maximum code length G:=I; if Cardinal(L)>I then L:=I; M:=L; // adjust last length count to fill out codes if needed Y:=1 shl J; while J0) do begin Inc(J,P^); XP^:=J; Inc(P); Inc(XP); Dec(I); end; // make a table of values in order of bit lengths for I:=0 to pred(N) do begin J:=B[I]; if J<>0 then begin V[X[J]]:=I; Inc(X[J]); end; end; // set N to Length of V N:=X[G]; // generate the Huffman codes and for each make the table entries I:=0; // first Huffman code is zero X[0]:=0; // grab values in bit order P:=@V; // no tables yet -> Level - 1 H:=-1; // bits decoded = (L * H) W:=-L; U[0]:=nil; Q:=nil; Z:=0; // 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); // add bits already decoded, previous table always L Bits Inc(W,L); // compute minimum size table less than or equal to L bits Z:=G-W; if Z>Cardinal(L) then Z:=L; // try a K-W bit table J:=K-W; F:=1 shl J; // too few codes for K - W bit table if F>A+1 then begin // deduct codes from patterns left Dec(F,A+1); XP:=@C[K]; if JMANY then begin Result:=Z_MEM_ERROR; Exit; end; Q:=@HP[HN]; U[H]:=Q; Inc(HN,Z); // connect to last table, if there is one if H<>0 then begin // save pattern for backing up X[H]:=I; // bits to dump before this table R.Bits:=L; // bits in this table R.exop:=J; J:=I shr (W-L); R.Base:=(Cardinal(Q)-Cardinal(U[H-1]) ) div sizeof(Q^)-J; // connect to last table PHuftField(U[H-1])[J]:=R; end else // first table is returned result Temp^:=Q; end; // set up table entry in R R.Bits:=Byte(K-W); // out of values -> invalid code if Cardinal(P)>=Cardinal(@V[N]) then R.exop:=128+64 else if P^ look up in lists R.exop:=Byte(Extra[P^-S]+16+64); R.Base:=D[P^-S]; Inc(P); end; // fill xode-like entries with R F:=1 shl (K-W); J:=I shr W; while J0 do begin I:=I xor J; J:=J shr 1 end; I:=I xor J; // backup over finished tables // needed on HP, cc -O bug Mask:=(1 shl W)-1; while (I and Mask)<>X[H] do begin // don't need to update Q Dec(H); 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 Result:=Z_BUF_ERROR else Result:=Z_OK; end; //---------------------------------------------------------------------------------------------------------------------- function InflateTreesBits(var C: array of Cardinal; var BB: Cardinal; var TB: PInflateHuft; var HP: array of TInflateHuft; var Z: TZState): Integer; // C holds 19 code lengths // BB - bits tree desired/actual depth // TB - bits tree result // HP - space for trees // Z - for messages var R: Integer; HN: Cardinal; // hufts used in space V: PCardinalArray; // work area for BuildHuffmanTables begin HN:=0; V:=AllocMem(19*sizeof(Cardinal)); try R:=BuildHuffmanTables(C,19,19,CopyLengths,CopyLiteralExtra,@TB,BB,HP,HN,V^); if R=Z_DATA_ERROR then Z.Msg:=SOversubscribedDBLTree else if (R=Z_BUF_ERROR) or (BB=0) then begin Z.Msg:=SIncompleteDBLTree; R:=Z_DATA_ERROR; end; Result:=R; finally FreeMem(V); end; end; //---------------------------------------------------------------------------------------------------------------------- function InflateTreesDynamic(NL: Cardinal; ND: Cardinal; var C: array of Cardinal; var LiteralBits: Cardinal; var DistanceBits: Cardinal; var TL: PInflateHuft; var TD: PInflateHuft; var HP: array of TInflateHuft; var Z: TZState): Integer; // NL - number of literal/length codes // ND - number of distance codes // C - code lengths // LiteralBits - literal desired/actual bit depth // DistanceBits - distance desired/actual bit depth // TL - literal/length tree result // TD - distance tree result // HP - space for trees // Z - for messages var R: Integer; HN: Cardinal; // hufts used in space V: PCardinalArray; // work area for BuildHuffmanTables begin HN:=0; // allocate work area V:=AllocMem(288*sizeof(Cardinal)); try Result:=Z_OK; // build literal/length tree R:=BuildHuffmanTables(C,NL,257,CopyLengths,CopyLiteralExtra,@TL,LiteralBits,HP,HN,V^); if (R<>Z_OK) or (LiteralBits=0) then begin if R=Z_DATA_ERROR then Z.Msg:=SOversubscribedLLTree else if R<>Z_MEM_ERROR then begin Z.Msg:=SIncompleteLLTree; R:=Z_DATA_ERROR; end; FreeMem(V); Result:=R; Exit; end; // build distance tree R:=BuildHuffmanTables(PCardinalArray(@C[NL])^,ND,0,CopyOffsets,CopyExtra,@TD,DistanceBits,HP,HN,V^); if (R<>Z_OK) or ((DistanceBits=0) and (NL>257)) then begin if R=Z_DATA_ERROR then Z.Msg:=SOversubscribedLLTree else if R=Z_BUF_ERROR then begin Z.Msg:=SIncompleteLLTree; R:=Z_DATA_ERROR; end else if R<>Z_MEM_ERROR then begin Z.Msg:=SEmptyDistanceTree; R:=Z_DATA_ERROR; end; FreeMem(V); Result:=R; end; finally FreeMem(V); end; end; //---------------------------------------------------------------------------------------------------------------------- const // number of hufts used by fixed tables FIXEDH = 544; var // build fixed tables only once -> keep them here FixedBuild: Boolean = False; FixedTablesMemory: array[0..pred(FIXEDH)] of TInflateHuft; FixedLiteralBits: Cardinal; FixedDistanceBits: Cardinal; FixedLiteralTable: PInflateHuft; FixedDistanceTable: PInflateHuft; //---------------------------------------------------------------------------------------------------------------------- function InflateTreesFixed(var LiteralBits: Cardinal; var DistanceBits: Cardinal; var TL,TD: PInflateHuft; var Z: TZState): Integer; type PFixedTable = ^TFixedTable; TFixedTable = array[0..287] of Cardinal; var K: Integer; // temporary variable C: PFixedTable; // length list for BuildHuffmanTables V: PCardinalArray; // work area for BuildHuffmanTables F: Cardinal; // number of hufts used in FixedTablesMemory begin // build fixed tables if not already (multiple overlapped executions ok) if not FixedBuild then begin F:=0; C:=nil; V:=nil; try C:=AllocMem(288*sizeof(Cardinal)); V:=AllocMem(288*sizeof(Cardinal)); // literal table for K:=0 to 143 do C[K]:=8; for K:=144 to 255 do C[K]:=9; for K:=256 to 279 do C[K]:=7; for K:=280 to 287 do C[K]:=8; FixedLiteralBits:=9; BuildHuffmanTables(C^,288,257,CopyLengths,CopyLiteralExtra,@FixedLiteralTable,FixedLiteralBits,FixedTablesMemory,F,V^); // distance table for K:=0 to 29 do C[K]:=5; FixedDistanceBits:=5; BuildHuffmanTables(C^,30,0,CopyOffsets,CopyExtra,@FixedDistanceTable,FixedDistanceBits,FixedTablesMemory,F,V^); FixedBuild:=True; finally if Assigned(V) then FreeMem(V); if Assigned(C) then FreeMem(C); end; end; LiteralBits:=FixedLiteralBits; DistanceBits:=FixedDistanceBits; TL:=FixedLiteralTable; TD:=FixedDistanceTable; Result:=Z_OK; end; //---------------------------------------------------------------------------------------------------------------------- // tables for Deflate from PKZIP'S appnote.txt. const // order of the bit length code lengths BitOrder: array [0..18] of word = (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 defines 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 InflateBlockReset(var S: TInflateBlocksState; var Z: TZState; C: PCardinal); begin if Assigned(C) then C^:=S.Check; if (S.mode=ibmBitTree) or (S.mode=ibmDistTree) then FreeMem(S.sub.trees.blens); if S.mode=ibmCodes then FreeMem(S.sub.decode.codes); S.mode:=ibmZType; S.bitk:=0; S.bitb:=0; S.write:=S.Window; S.read:=S.Window; if Assigned(S.CheckFunction) then begin S.Check:=S.CheckFunction(0,nil,0); Z.Adler:=S.Check; end; end; //---------------------------------------------------------------------------------------------------------------------- function InflateBlocksNew(var Z: TZState; C: TCheckFunction; W: Cardinal): PInflateBlocksState; // W is the window size var S: PInflateBlocksState; begin S:=AllocMem(sizeof(TInflateBlocksState)); if S = nil then Result:=S else try S.hufts:=AllocMem(sizeof(TInflateHuft)*MANY); S.Window:=AllocMem(W); S.zend:=S.Window; Inc(S.zend,W); S.CheckFunction:=C; S.mode:=ibmZType; InflateBlockReset(S^,Z,nil); Result:=S; except if Assigned(S.Window) then FreeMem(S.Window); if Assigned(S.hufts) then FreeMem(S.hufts); FreeMem(S); raise; end; end; //---------------------------------------------------------------------------------------------------------------------- function InflateBlocks(var S: TInflateBlocksState; var Z: TZState; R: Integer): Integer; // R contains the initial return code var Temp: Cardinal; B: Cardinal; // bit buffer K: Cardinal; // bits in bit buffer P: PByte; // input data pointer N: Cardinal; // bytes available there Q: PByte; // output Window write pointer M: Cardinal; // bytes to end of window or read pointer // fixed code blocks LiteralBits, DistanceBits: Cardinal; TL, TD: PInflateHuft; H: PInflateHuft; I,J,C: Cardinal; CodeState: PInflateCodesState; //--------------- local functions ------------------------------------------- function UpdatePointers: Integer; begin S.bitb:=B; S.bitk:=K; Z.AvailableInput:=N; Inc(Z.TotalInput,Cardinal(P)-Cardinal(Z.NextInput)); Z.NextInput:=P; S.write:=Q; Result:=InflateFlush(S,Z,R); end; //--------------- end local functions --------------------------------------- begin // copy input/output information to locals P:=Z.NextInput; N:=Z.AvailableInput; B:=S.bitb; K:=S.bitk; Q:=S.write; if Cardinal(Q)0 then R:=Z_OK else begin Result:=UpdatePointers; Exit; end; Dec(N); B:=B or (Cardinal(P^) shl K); Inc(P); Inc(K,8); end; Temp:=B and 7; S.last:=Boolean(Temp and 1); case Temp shr 1 of 0: // stored begin B:=B shr 3; Dec(K,3); // go to byte boundary Temp:=K and 7; B:=B shr Temp; Dec(K,Temp); // get length of stored block S.mode:=ibmLens; end; 1: // fixed begin InflateTreesFixed(LiteralBits,DistanceBits,TL,TD,Z); S.sub.decode.codes:=InflateCodesNew(LiteralBits,DistanceBits,TL,TD,Z); if S.sub.decode.codes=nil then begin R:=Z_MEM_ERROR; Result:=UpdatePointers; Exit; end; B:=B shr 3; Dec(K,3); S.mode:=ibmCodes; end; 2: // dynamic begin B:=B shr 3; Dec(K,3); S.mode:=ibmTable; end; 3: // illegal begin B:=B shr 3; Dec(K,3); S.mode:=ibmBlockBad; Z.Msg:=SInvalidBlockType; R:=Z_DATA_ERROR; Result:=UpdatePointers; Exit; end; end; end; ibmLens: begin while K<32 do begin if N<>0 then R:=Z_OK else begin Result:=UpdatePointers; Exit; end; Dec(N); B:=B or (Cardinal(P^) shl K); Inc(P); Inc(K,8); end; if (((not B) shr 16) and $FFFF)<>(B and $FFFF) then begin S.mode:=ibmBlockBad; Z.Msg:=SInvalidStoredBlockLengths; R:=Z_DATA_ERROR; Result:=UpdatePointers; Exit; end; S.sub.left:=B and $FFFF; K:=0; B:=0; if S.sub.left<>0 then S.mode:=ibmStored else if S.last then S.mode:=ibmDry else S.mode:=ibmZType; end; ibmStored: begin if N=0 then begin Result:=UpdatePointers; Exit; end; if M=0 then begin if (Q=S.zend) and (S.read<>S.Window) then begin Q:=S.Window; if Cardinal(Q)S.Window) then begin Q:=S.Window; if Cardinal(Q)N then Temp:=N; if Temp>M then Temp:=M; Move(P^,Q^,Temp); Inc(P,Temp); Dec(N,Temp); Inc(Q,Temp); Dec(M,Temp); Dec(S.sub.left,Temp); if S.sub.left=0 then begin if S.last then S.mode:=ibmDry else S.mode:=ibmZType; end; end; ibmTable: begin while K<14 do begin if N<>0 then R:=Z_OK else begin Result:=UpdatePointers; Exit; end; Dec(N); B:=B or (Cardinal(P^) shl K); Inc(P); Inc(K,8); end; Temp:=B and $3FFF; S.sub.trees.table:=Temp; if ((Temp and $1F)>29) or (((Temp shr 5) and $1F)>29) then begin S.mode:=ibmBlockBad; Z.Msg:=STooManyLDSymbols; R:=Z_DATA_ERROR; Result:=UpdatePointers; Exit; end; Temp:=258+(Temp and $1F)+((Temp shr 5) and $1F); try S.sub.trees.blens:=AllocMem(Temp*sizeof(Cardinal)); except R:=Z_MEM_ERROR; UpdatePointers; raise; end; B:=B shr 14; Dec(K,14); S.sub.trees.Index:=0; S.mode:=ibmBitTree; end; ibmBitTree: begin while (S.sub.trees.Index<4+(S.sub.trees.table shr 10)) do begin while K<3 do begin if N<>0 then R:=Z_OK else begin Result:=UpdatePointers; Exit; end; Dec(N); B:=B or (Cardinal(P^) shl K); Inc(P); Inc(K, 8); end; S.sub.trees.blens[BitOrder[S.sub.trees.Index]]:=B and 7; Inc(S.sub.trees.Index); B:=B shr 3; Dec(K,3); end; while S.sub.trees.Index<19 do begin S.sub.trees.blens[BitOrder[S.sub.trees.Index]]:=0; Inc(S.sub.trees.Index); end; S.sub.trees.BB:=7; Temp:=InflateTreesBits(S.sub.trees.blens^,S.sub.trees.BB,S.sub.trees.TB,S.hufts^,Z); if Temp<>Z_OK then begin FreeMem(S.sub.trees.blens); R:=Temp; if R=Z_DATA_ERROR then S.mode:=ibmBlockBad; Result:=UpdatePointers; Exit; end; S.sub.trees.Index:=0; S.mode:=ibmDistTree; end; ibmDistTree: begin while True do begin Temp:=S.sub.trees.table; if not (S.sub.trees.Index<258+(Temp and $1F)+((Temp shr 5) and $1F)) then Break; Temp:=S.sub.trees.BB; while K0 then R:=Z_OK else begin Result:=UpdatePointers; Exit; end; Dec(N); B:=B or (Cardinal(P^) shl K); Inc(P); Inc(K, 8); end; H:=S.sub.trees.TB; Inc(H,B and InflateMask[Temp]); Temp:=H^.Bits; C:=H^.Base; if C<16 then begin B:=B shr Temp; Dec(K,Temp); S.sub.trees.blens^[S.sub.trees.Index]:=C; Inc(S.sub.trees.Index); end else begin // C=16..18 if C=18 then begin I:=7; J:=11; end else begin I:=C-14; J:=3; end; while K0 then R:=Z_OK else begin Result:=UpdatePointers; Exit; end; Dec(N); B:=B or (Cardinal(P^) shl K); Inc(P); Inc(K, 8); end; B:=B shr Temp; Dec(K, Temp); Inc(J, Cardinal(B) and InflateMask[I]); B:=B shr I; Dec(K,I); I:=S.sub.trees.Index; Temp:=S.sub.trees.table; if (I+J>258+(Temp and $1F)+((Temp shr 5) and $1F)) or ((C=16) and (I<1)) then begin FreeMem(S.sub.trees.blens); S.mode:=ibmBlockBad; Z.Msg:=SInvalidBitLengthRepeat; R:=Z_DATA_ERROR; Result:=UpdatePointers; 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:=nil; begin LiteralBits:=9; DistanceBits:=6; Temp:=S.sub.trees.table; Temp:=InflateTreesDynamic(257+(Temp and $1F),1+((Temp shr 5) and $1F), S.sub.trees.blens^,LiteralBits,DistanceBits,TL,TD,S.hufts^,Z); FreeMem(S.sub.trees.blens); if Temp<>Z_OK then begin if Integer(Temp)=Z_DATA_ERROR then S.mode:=ibmBlockBad; R:=Temp; Result:=UpdatePointers; Exit; end; CodeState:=InflateCodesNew(LiteralBits,DistanceBits,TL,TD,Z); if CodeState=nil then begin R:=Z_MEM_ERROR; Result:=UpdatePointers; Exit; end; S.sub.decode.codes:=CodeState; end; S.mode:=ibmCodes; end; ibmCodes: begin // update pointers S.bitb:=B; S.bitk:=K; Z.AvailableInput:=N; Inc(Z.TotalInput,Cardinal(P)-Cardinal(Z.NextInput)); Z.NextInput:=P; S.write:=Q; R:=InflateCodes(S,Z,R); // very strange, I have no clue why the local function does not work here... // R:=UpdatePointers; if R<>Z_STREAM_END then begin Result:=InflateFlush(S,Z,R); Exit; end; R:=Z_OK; Freemem(S.sub.decode.codes); // load local pointers P:=Z.NextInput; N:=Z.AvailableInput; B:=S.bitb; K:=S.bitk; Q:=S.write; if Cardinal(Q)S.write then begin Result:=UpdatePointers; Exit; end; S.mode:=ibmBlockDone; end; ibmBlockDone: begin R:=Z_STREAM_END; Result:=UpdatePointers; Exit; end; ibmBlockBad: begin R:=Z_DATA_ERROR; Result:=UpdatePointers; Exit; end; else R:=Z_STREAM_ERROR; Result:=UpdatePointers; Exit; end; // case S.mode of end; end; //---------------------------------------------------------------------------------------------------------------------- function InflateBlocksFree(S: PInflateBlocksState; var Z: TZState): Integer; begin InflateBlockReset(S^,Z,nil); FreeMem(S.Window); FreeMem(S.hufts); FreeMem(S); Result:=Z_OK; end; //---------------------------------------------------------------------------------------------------------------------- function IsInflateBlocksSynchPoint(var S: TInflateBlocksState): Boolean; // returns True if Inflate is currently at the end of a block generated by Z_SYNC_FLUSH or Z_FULL_FLUSH begin Result:=(S.mode=ibmLens); end; //---------------------------------------------------------------------------------------------------------------------- function InflateReset(var Z: TZState): Integer; // 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 State being nil). begin if Z.State = nil then Result:= Z_STREAM_ERROR else begin Z.TotalOutput:=0; Z.TotalInput:=0; Z.Msg:=''; if Z.State.nowrap then Z.State.mode:=imBlocks else Z.State.mode:=imMethod; InflateBlockReset(Z.State.blocks^,Z,nil); Result:=Z_OK; end; end; //---------------------------------------------------------------------------------------------------------------------- function InflateEnd(var Z: TZState): Integer; // 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 on success, Z_STREAM_ERROR if the stream state was inconsistent. begin if Z.State=nil then Result:= Z_STREAM_ERROR else begin if Assigned(Z.State.blocks) then InflateBlocksFree(Z.State.blocks,Z); FreeMem(Z.State); Z.State:=nil; Result:=Z_OK; end; end; //---------------------------------------------------------------------------------------------------------------------- function InflateInit2_(var Z: TZState; W: Integer; const Version: String; StreamSize: Integer): Integer; begin if (Version='') or (Version[1]<>ZLIB_VERSION[1]) or (StreamSize<>SizeOf(TZState)) then Result:=Z_VERSION_ERROR else begin // initialize state Z.Msg:=''; Z.State:=AllocMem(SizeOf(TInternalState)); // handle undocumented nowrap option (no zlib header or check) 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); Result:=Z_STREAM_ERROR; Exit; end; Z.State.wbits:=W; // create InflateBlocks state if Z.State.nowrap then Z.State.blocks:=InflateBlocksNew(Z, nil, 1 shl W) else Z.State.blocks:=InflateBlocksNew(Z, Adler32, 1 shl W); if Z.State.blocks = nil then begin InflateEnd(Z); Result:=Z_MEM_ERROR; Exit; end; // reset state InflateReset(Z); Result:=Z_OK; end; end; //---------------------------------------------------------------------------------------------------------------------- function InflateInit2(var Z: TZState; AWindowBits: Integer): Integer; // This is another Version of InflateInit with an extra parameter. The fields NextInput and AvailableInput 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 reset 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 NextInput and // AvailableInput may be modified, but NextOutput and AvailableOutput are unchanged.) begin Result:=InflateInit2_(Z, AWindowBits, ZLIB_VERSION, SizeOf(TZState)); end; //---------------------------------------------------------------------------------------------------------------------- function InflateInit(var Z: TZState): Integer; // Initializes the internal stream state for decompression. // // 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 reset if there is no // error message. InflateInit does not perform any decompression: this will be done by Inflate. begin Result:=InflateInit2_(Z, DEF_WBITS, ZLIB_VERSION, SizeOf(TZState)); end; //---------------------------------------------------------------------------------------------------------------------- function InflateInit_(var Z: TZState; const Version: String; StreamSize: Integer): Integer; begin Result:=InflateInit2_(Z, DEF_WBITS, Version, StreamSize); end; //---------------------------------------------------------------------------------------------------------------------- function Inflate(var Z: TZState; F: Integer): Integer; // 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 NextInput and update NextInput and AvailableInput accordingly. if not all input // can be processed (because there is not enough room in the output buffer), NextInput is updated and processing will // resume at this point for the next call of Inflate. // // - Provide more output starting at NextOutput and update NextOutput and AvailableOutput 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 (AvailableOutput = 0), or // after each call of Inflate. If Inflate returns Z_OK and with zero AvailableOutput, 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; AvailableOutput 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 ZState.Adler to the // Adler32 checksum of the dictionary chosen by the compressor and returns Z_NEED_DICT. Otherwise it sets ZState.Adler // to the Adler32 checksum of all output produced so far (that is, TotalOutput 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 NextInput or NextOutput was nil), 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. var R: Integer; B: Cardinal; begin if (Z.State = nil) or (Z.NextInput = nil) then Result:=Z_STREAM_ERROR else begin if F = Z_FINISH then F:=Z_BUF_ERROR else F:=Z_OK; R:=Z_BUF_ERROR; while True do begin case Z.State.mode of imBlocks: begin R:=InflateBlocks(Z.State.blocks^,Z,R); if R=Z_DATA_ERROR then begin Z.State.mode:=imBad; // can try InflateSync Z.State.sub.marker:=0; Continue; end; if R=Z_OK then R:=F; if R<>Z_STREAM_END then begin Result:=R; Exit; end; R:=F; InflateBlockReset(Z.State.blocks^,Z,@Z.State.sub.Check.was); if Z.State.nowrap then begin Z.State.mode:=imDone; Continue; end; Z.State.mode:=imCheck4; end; imCheck4: begin if (Z.AvailableInput=0) then begin Result:=R; Exit; end; R:=F; Dec(Z.AvailableInput); Inc(Z.TotalInput); Z.State.sub.Check.need:=Cardinal(Z.NextInput^) shl 24; Inc(Z.NextInput); Z.State.mode:=imCheck3; end; imCheck3: begin if Z.AvailableInput=0 then begin Result:=R; Exit; end; R:=F; Dec(Z.AvailableInput); Inc(Z.TotalInput); Inc(Z.State.sub.Check.need,Cardinal(Z.NextInput^) shl 16); Inc(Z.NextInput); Z.State.mode:=imCheck2; end; imCheck2: begin if Z.AvailableInput=0 then begin Result:=R; Exit; end; R:=F; Dec(Z.AvailableInput); Inc(Z.TotalInput); Inc(Z.State.sub.Check.need,Cardinal(Z.NextInput^) shl 8); Inc(Z.NextInput); Z.State.mode:=imCheck1; end; imCheck1: begin if Z.AvailableInput=0 then begin Result:=R; Exit; end; R:=F; Dec(Z.AvailableInput); Inc(Z.TotalInput); Inc(Z.State.sub.Check.need,Cardinal(Z.NextInput^)); Inc(Z.NextInput); if Z.State.sub.Check.was<>Z.State.sub.Check.need then begin Z.State.mode:=imBad; Z.Msg:=SIncorrectDataCheck; // can't try InflateSync Z.State.sub.marker:=5; Continue; end; Z.State.mode:=imDone; end; imDone: begin Result:=Z_STREAM_END; Exit; end; imMethod: begin if Z.AvailableInput=0 then begin Result:=R; Exit; end; R:=F; Dec(Z.AvailableInput); Inc(Z.TotalInput); Z.State.sub.imMethod:=Z.NextInput^; Inc(Z.NextInput); if (Z.State.sub.imMethod and $0F)<>Z_DEFLATED then begin Z.State.mode:=imBad; Z.Msg:=SUnknownCompression; // can't try InflateSync Z.State.sub.marker:=5; Continue; end; if (Z.State.sub.imMethod shr 4)+8>Z.State.wbits then begin Z.State.mode:=imBad; Z.Msg:=SInvalidWindowSize; // can't try InflateSync Z.State.sub.marker:=5; Continue; end; Z.State.mode:=imFlag; end; imFlag: begin if Z.AvailableInput=0 then begin Result:=R; Exit; end; R:=F; Dec(Z.AvailableInput); Inc(Z.TotalInput); B:=Z.NextInput^; Inc(Z.NextInput); if (((Z.State.sub.imMethod shl 8)+B) mod 31)<>0 then begin Z.State.mode:=imBad; Z.Msg:=SIncorrectHeaderCheck; // can't try InflateSync Z.State.sub.marker:=5; Continue; end; if (B and PRESET_DICT)=0 then begin Z.State.mode:=imBlocks; Continue; end; Z.State.mode:=imDict4; end; imDict4: begin if Z.AvailableInput=0 then begin Result:=R; Exit; end; R:=F; Dec(Z.AvailableInput); Inc(Z.TotalInput); Z.State.sub.Check.need:=Cardinal(Z.NextInput^) shl 24; Inc(Z.NextInput); Z.State.mode:=imDict3; end; imDict3: begin if Z.AvailableInput=0 then begin Result:=R; Exit; end; R:=F; Dec(Z.AvailableInput); Inc(Z.TotalInput); Inc(Z.State.sub.Check.need,Cardinal(Z.NextInput^) shl 16); Inc(Z.NextInput); Z.State.mode:=imDict2; end; imDict2: begin if Z.AvailableInput=0 then begin Result:=R; Exit; end; R:=F; Dec(Z.AvailableInput); Inc(Z.TotalInput); Inc(Z.State.sub.Check.need,Cardinal(Z.NextInput^) shl 8); Inc(Z.NextInput); Z.State.mode:=imDict1; end; imDict1: begin if Z.AvailableInput=0 then begin Result:=R; Exit; end; Dec(Z.AvailableInput); Inc(Z.TotalInput); Inc(Z.State.sub.Check.need,Cardinal(Z.NextInput^)); Inc(Z.NextInput); Z.Adler:=Z.State.sub.Check.need; Z.State.mode:=imDict0; Inflate:=Z_NEED_DICT; Exit; end; imDict0: begin Z.State.mode:=imBad; Z.Msg:=SNeedDictionary; // can try InflateSync Z.State.sub.marker:=0; Inflate:=Z_STREAM_ERROR; Exit; end; imBad: begin Result:=Z_DATA_ERROR; Exit; end; else begin Result:=Z_STREAM_ERROR; Exit; end; end; end; end; end; //---------------------------------------------------------------------------------------------------------------------- function InflateSetDictionary(var Z: TZState; Dictionary: PByte; DictLength: Cardinal): Integer; // 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 nil 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. var Length: Cardinal; begin Length:=DictLength; if (Z.State=nil) or (Z.State.mode<>imDict0) then begin Result:=Z_STREAM_ERROR; Exit; end; if Adler32(1,Dictionary,DictLength)<>Z.Adler then begin Result:=Z_DATA_ERROR; Exit; end; Z.Adler:=1; if Length>=(1 shl Z.State.wbits) then begin Length:=(1 shl Z.State.wbits)-1; Inc(Dictionary,DictLength-Length); end; with Z.State.blocks^ do begin Move(Dictionary^,Window^,Length); write:=Window; Inc(write, Length); read:=write; end; Z.State.mode:=imBlocks; Result:=Z_OK; end; //---------------------------------------------------------------------------------------------------------------------- function InflateSync(var Z: TZState): Integer; // 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 TotalInput 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. const Mark: packed array[0..3] of Byte = (0,0,$FF,$FF); var N: Cardinal; // number of bytes to look at P: PByte; // pointer to bytes M: Cardinal; // number of marker bytes found in a row R,W: Cardinal; // temporaries to save TotalInput and TotalOutput begin if Z.State=nil then begin Result:=Z_STREAM_ERROR; Exit; end; if Z.State.mode<>imBad then begin Z.State.mode:=imBad; Z.State.sub.marker:=0; end; N:=Z.AvailableInput; if N=0 then begin Result:=Z_BUF_ERROR; Exit; end; P:=Z.NextInput; 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.TotalInput,Cardinal(P)-Cardinal(Z.NextInput)); Z.NextInput:=P; Z.AvailableInput:=N; Z.State.sub.marker:=M; // return no joy or set up to restart on a new block if M<>4 then begin Result:=Z_DATA_ERROR; Exit; end; R:=Z.TotalInput; W:=Z.TotalOutput; InflateReset(Z); Z.TotalInput:=R; Z.TotalOutput:=W; Z.State.mode:=imBlocks; Result:=Z_OK; end; //---------------------------------------------------------------------------------------------------------------------- function IsInflateSyncPoint(var Z: TZState): Integer; // Returns 1 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. begin if (Z.State=nil) or (Z.State.blocks=nil) then Result:=Z_STREAM_ERROR else Result:=Ord(IsInflateBlocksSynchPoint(Z.State.blocks^)); end; //---------------------------------------------------------------------------------------------------------------------- end.