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 interface 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 ------------------------------------------------------------------------------ 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 = 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; StreamSize: Integer): Integer; function InflateInit2_(var Z: TZState; W: Integer; 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 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; //---------------------------------------------------------------------------------------------------------------------- const // 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 [0..255] of Cardinal = ($00000000, $77073096, $EE0E612C, $990951BA, $076DC419, $706AF48F, $E963A535, $9E6495A3, $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988, $09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91, $1DB71064, $6AB020F2, $F3B97148, $84BE41DE, $1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7, $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC, $14015C4F, $63066CD9, $FA0F3D63, $8D080DF5, $3B6E20C8, $4C69105E, $D56041E4, $A2677172, $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B, $35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940, $32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59, $26D930AC, $51DE003A, $C8D75180, $BFD06116, $21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F, $2802B89E, $5F058808, $C60CD9B2, $B10BE924, $2F6F7C87, $58684C11, $C1611DAB, $B6662D3D, $76DC4190, $01DB7106, $98D220BC, $EFD5102A, $71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433, $7807C9A2, $0F00F934, $9609A88E, $E10E9818, $7F6A0DBB, $086D3D2D, $91646C97, $E6635C01, $6B6B51F4, $1C6C6162, $856530D8, $F262004E, $6C0695ED, $1B01A57B, $8208F4C1, $F50FC457, $65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C, $62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65, $4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2, $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB, $4369E96A, $346ED9FC, $AD678846, $DA60B8D0, $44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9, $5005713C, $270241AA, $BE0B1010, $C90C2086, $5768B525, $206F85B3, $B966D409, $CE61E49F, $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4, $59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD, $EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A, $EAD54739, $9DD277AF, $04DB2615, $73DC1683, $E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8, $E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1, $F00F9344, $8708A3D2, $1E01F268, $6906C2FE, $F762575D, $806567CB, $196C3671, $6E6B06E7, $FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC, $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5, $D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252, $D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B, $D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60, $DF60EFC3, $A867DF55, $316E8EEF, $4669BE79, $CB61B38C, $BC66831A, $256FD2A0, $5268E236, $CC0C7795, $BB0B4703, $220216B9, $5505262F, $C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04, $C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D, $9B64C2B0, $EC63F226, $756AA39C, $026D930A, $9C0906A9, $EB0E363F, $72076785, $05005713, $95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38, $92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21, $86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E, $81BE16CD, $F6B9265B, $6FB077E1, $18B74777, $88085AE6, $FF0F6A70, $66063BCA, $11010B5C, $8F659EFF, $F862AE69, $616BFFD3, $166CCF45, $A00AE278, $D70DD2EE, $4E048354, $3903B3C2, $A7672661, $D06016F7, $4969474D, $3E6E77DB, $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0, $A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9, $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6, $BAD03605, $CDD70693, $54DE5729, $23D967BF, $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94, $B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D); //---------------------------------------------------------------------------------------------------------------------- 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 begin Result := 0; exit; end; CRC := CRC xor $FFFFFFFF; while Len > 0 do begin CRC := CRCTable[Byte(CRC) xor Buffer^] xor (CRC shr 8); Inc(Buffer); Dec(Len); end; Result := CRC xor $FFFFFFFF; 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; begin Result := 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 Result := 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; 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..BMAX - 1] 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 N - 1 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) < J then L := J; for I := BMAX downto 1 do if C[I] <> 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 J < I do begin Dec(Y, C[J]); if Y < 0 then begin // bad input: more codes than bits Result := Z_DATA_ERROR; Exit; end ; Inc(J); Y := Y shl 1; end; Dec (Y, C[I]); if Y < 0 then begin // bad input: more codes than bits Result := Z_DATA_ERROR; Exit; end; Inc(C[I], Y); // generate starting offsets into the value table for each length X[1] := 0; J := 0; P := @C[1]; XP := @X[2]; // note that I = G from above Dec(I); while (I > 0) 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 N - 1 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 J < Z then begin Inc(J); while J < Z do begin // try smaller tables up to Z bits F := F shl 1; Inc(XP); // enough codes to use up J Bits if F <= XP^ then Break; // else deduct codes from patterns Dec(F, XP^); Inc(J); end; end; end; // table entries for J-bit table Z := 1 shl J; // allocate new table (note: doesn't matter for fixed) if HN + Z > MANY 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^ < S then begin // 256 is end-of-block code if P^ < 256 then R.exop := 0 else R.exop := 32 + 64; // simple code is just the value R.Base := P^; Inc(P); end else begin // non-simple -> 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 J < Z do begin PHuftField(Q)[J] := R; Inc(J, F); end; // backwards increment the K-bit code I J := 1 shl (K - 1) ; while (I and J) <> 0 do begin I := I xor J; 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 not 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; //---------------------------------------------------------------------------------------------------------------------- var // build fixed tables only once -> keep them here FixedBuild: Boolean = False; const // number of hufts used by fixed tables FIXEDH = 544; var FixedTablesMemory: array[0..FIXEDH - 1] 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) < Cardinal(S.read) then M := Cardinal(S.read) - Cardinal(Q) - 1 else M := Cardinal(S.zend) - Cardinal(Q); // decompress an inflated block // process input based on current state while True do begin case S.mode of ibmZType: 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; 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) < 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 Result := UpdatePointers; Exit; end; end; end; R := Z_OK; Temp := S.sub.left; if Temp > 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 K < Temp 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; 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 K < Temp + I 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; 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) < Cardinal(S.read) then M := Cardinal(S.read) - Cardinal(Q) - 1 else M := Cardinal(S.zend) - Cardinal(Q); if not S.last then begin S.mode := ibmZType; Continue; end; S.mode := ibmDry; end; ibmDry: begin S.write := Q; R := InflateFlush(S, Z, R); Q := S.write; if S.read <> 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; StreamSize: Integer): Integer; begin 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; //---------------------------------------------------------------------------------------------------------------------- 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, 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, SizeOf(TZState)); end; //---------------------------------------------------------------------------------------------------------------------- function InflateInit_(var Z: TZState; StreamSize: Integer): Integer; begin Result := InflateInit2_(Z, DEF_WBITS, 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.