{
zlib – библиотека сжатия данных общего назначения. Версия 1.1.0
Это изменённая объектно-ориентированная версия библиотеки, полностью
совместимая с оригинальной библиотекой.
Copyright © 1995–2005 Jean-loup Gailly и Mark Adler
Copyright © 2000–2011 ymnk, JCraft, Inc.
Copyright © 2016, 2019, 2022–2023, 2026 Малик Разработчик
Эта библиотека поставляется «как есть», без каких-либо явных или
подразумеваемых гарантий. Ни при каких обстоятельствах авторы не
несут какой-либо ответственности в случае потери данных вследствие
использования данной библиотеки.
Разрешается всем использовать эту библиотеку для любых целей, в том
числе и для коммерческих приложений, а также изменять её и
распространять свободно при соблюдении следующих условий:
1. Оригинал библиотеки не должен быть искажён; вы не должны
заявлять, что именно вы написали оригинальную библиотеку. Если вы
используете эту библиотеку в своём программном продукте, то ссылка
на авторов библиотеки была бы желательна, но это не является
обязательным требованием.
2. Изменённые версии исходных текстов должны быть отчётливо
маркированы и не должны выдаваться за оригинал библиотеки.
3. Эти замечания не могут быть удалены либо изменены при
каком-либо варианте распространения исходных текстов.
}
unit platform.independent.streamformat.compression.zlib;
{$MODE DELPHI}
interface
{%region} uses
pascalx.lang,
pascalx.io,
pascalx.io.bytearray,
pascalx.io.extension;
{%enregion}
{$WARN 3018 OFF} { позволить конструкторы с любой видимостью }
{$TYPEINFO ON}
{$CALLING REGISTER}
const UNIT_NAME = 'platform.independent.streamformat.compression.zlib';
{%region} type
Checksum32 = class;
Adler32 = class;
CRC32 = class;
ZLib = class;
ZStream = class;
GZIPHeader = class;
GZIPException = class;
Checksum32 = class abstract(&Object)
protected
fldValue: int;
constructor create(); overload;
constructor create(value: int); overload;
public
procedure update(const src: byte_Array1d; offset, length: int); virtual; abstract;
procedure reset(); virtual; overload;
procedure reset(value: int); virtual; overload;
function copy(): Checksum32; virtual; abstract;
function getValue(): int; virtual;
end;
Adler32 = class(Checksum32)
private const
NMAX = int(5552);
BASE = long(65521);
public
constructor create(); overload;
constructor create(value: int); overload;
procedure reset(); override; overload;
procedure update(const src: byte_Array1d; offset, length: int); override;
function copy(): Checksum32; override;
end;
CRC32 = class(Checksum32)
private
class var table: int_Array1d;
class procedure initialize(); static;
class procedure finalize(); static;
public
constructor create(); overload;
constructor create(value: int); overload;
procedure update(const src: byte_Array1d; offset, length: int); override;
function copy(): Checksum32; override;
end;
ZLib = class(&Object)
public const
{ wbits }
MIN_WBITS = int(9);
MAX_WBITS = int(15);
DEFAULT_WBITS = MAX_WBITS;
USE_CRC = int(16);
{ уровни сжатия }
DEFAULT_COMPRESSION = int(-1);
NO_COMPRESSION = int(0);
BEST_SPEED = int(1);
OPTIMAL_SPEED_COMPRESSION = int(7);
BEST_COMPRESSION = int(9);
{ стратегии сжатия }
FILTERED = int(1);
HUFFMAN_ONLY = int(2);
DEFAULT_STRATEGY = int(0);
{ режимы ввода-вывода }
NO_FLUSH = int(0);
PARTIAL_FLUSH = int(1);
SYNC_FLUSH = int(2);
FULL_FLUSH = int(3);
FINISH = int(4);
{ возвращаемые значения }
OK = int(0);
STREAM_END = int(1);
NEED_DICT = int(2);
ERRNO = int(-1);
STREAM_ERROR = int(-2);
DATA_ERROR = int(-3);
MEM_ERROR = int(-4);
BUF_ERROR = int(-5);
public
class function getVersion(): AnsiString; static;
class function compress(const src: byte_Array1d; offset, length: int; wbits: int = DEFAULT_WBITS; level: int = DEFAULT_COMPRESSION; strategy: int = DEFAULT_STRATEGY): byte_Array1d; static;
class function decompress(const src: byte_Array1d; offset, length: int; wbits: int = DEFAULT_WBITS): byte_Array1d; static;
end;
ZStream = class sealed(ZLib)
private
fldDataType: int;
fldNextInIndex: int;
fldAvailableIn: int;
fldNextOutIndex: int;
fldAvailableOut: int;
fldTotalIn: long;
fldTotalOut: long;
fldMessage: AnsiString;
fldNextInArray: byte_Array1d;
fldNextOutArray: byte_Array1d;
fldDeflateState: ZLib; { DefState }
fldInflateState: ZLib; { InfState }
fldChecksum: Checksum32;
procedure flushPending();
function readBuf(const dst: byte_Array1d; offset, length: int): int;
public
constructor create();
destructor destroy; override;
procedure setAvailableIn(availableIn: int);
procedure setAvailableOut(availableOut: int);
procedure setNextInIndex(nextInIndex: int);
procedure setNextInArray(const nextInArray: byte_Array1d);
procedure setNextOutIndex(nextOutIndex: int);
procedure setNextOutArray(const nextOutArray: byte_Array1d);
procedure setInput(const data: byte_Array1d); overload;
procedure setInput(const data: byte_Array1d; append: boolean); overload;
procedure setInput(const data: byte_Array1d; offset, length: int); overload;
procedure setInput(const data: byte_Array1d; offset, length: int; append: boolean); overload;
procedure setOutput(const data: byte_Array1d); overload;
procedure setOutput(const data: byte_Array1d; offset, length: int); overload;
function inflateFinished(): boolean;
function inflateBegin(): int; overload;
function inflateBegin(wbits: int): int; overload;
function inflateBegin(nowrap: boolean): int; overload;
function inflateBegin(wbits: int; nowrap: boolean): int; overload;
function inflateSetDictionary(const dictionary: byte_Array1d; length: int): int;
function inflateSync(): int;
function inflateSyncPoint(): int;
function inflate(flush: int): int;
function inflateEnd(): int;
function deflateBegin(level: int): int; overload;
function deflateBegin(level: int; nowrap: boolean): int; overload;
function deflateBegin(level, wbits: int): int; overload;
function deflateBegin(level, wbits, memLevel: int): int; overload;
function deflateBegin(level, wbits: int; nowrap: boolean): int; overload;
function deflateSetDictionary(const dictionary: byte_Array1d; length: int): int;
function deflateParameters(level, strategy: int): int;
function deflate(flush: int): int;
function deflateEnd(): int;
function getChecksum(): int;
function getAvailableIn(): int;
function getAvailableOut(): int;
function getNextInIndex(): int;
function getNextOutIndex(): int;
function getTotalIn(): long;
function getTotalOut(): long;
function getMessage(): AnsiString;
function getNextInArray(): byte_Array1d;
function getNextOutArray(): byte_Array1d;
end;
GZIPHeader = class sealed(ZLib)
strict private
fldModifiedTime: int;
private
{ fldXFlags: int; }
fldOS: int;
{ fldHCRC: int; }
{ fldTime: int; }
fldCRC: int;
fldExtra: byte_Array1d;
fldName: byte_Array1d;
fldComment: byte_Array1d;
procedure put(deflateState: ZLib { DefState });
public
constructor create();
procedure setOS(os: int);
procedure setCRC(crc: int);
procedure setModifiedTime(modifiedTime: int);
procedure setName(const name: AnsiString);
procedure setComment(const comment: AnsiString);
function getOS(): int;
function getCRC(): int;
function getModifiedTime(): int;
function getName(): AnsiString;
function getComment(): AnsiString;
end;
GZIPException = class(IOException);
{%endregion}
implementation
{$TYPEINFO OFF}
{$CALLING REGISTER}
{%region} type
Config = class;
DefState = class;
InfState = class;
InfBlocks = class;
InfCodes = class;
InfTree = class;
StaticTree = class;
Tree = class;
Config_Array1d = packed array of Config;
Config = class(ZLib)
private
fldGoodLength: int;
fldMaxLazy: int;
fldNiceLength: int;
fldMaxChain: int;
fldFunc: int;
public
constructor create(goodLength, maxLazy, niceLength, maxChain, func: int);
property goodLength: int read fldGoodLength;
property niceLength: int read fldNiceLength;
property maxChain: int read fldMaxChain;
property maxLazy: int read fldMaxLazy;
property func: int read fldFunc;
end;
DefState = class(ZLib)
strict private const
NEED_MORE = int(0);
BLOCK_DONE = int(1);
FINISH_STARTED = int(2);
FINISH_DONE = int(3);
PRESET_DICT = int($20);
INIT_STATE = int(42);
BUSY_STATE = int(113);
FINISH_STATE = int(666);
Z_DEFLATED = int(8);
STORED_BLOCK = int(0);
STATIC_TREES = int(1);
DYN_TREES = int(2);
Z_BINARY = int(0);
Z_ASCII = int(1);
Z_UNKNOWN = int(2);
BUF_SIZE = int(8 * 2);
REP_3_6 = int(16);
REPZ_3_10 = int(17);
REPZ_11_138 = int(18);
MIN_MATCH = int(3);
MAX_MATCH = int(258);
MIN_LOOKAHEAD = int(MAX_MATCH + MIN_MATCH + 1);
MAX_BITS = int(15);
D_CODES = int(30);
BL_CODES = int(19);
LENGTH_CODES = int(29);
LITERALS = int(256);
L_CODES = int(LITERALS + LENGTH_CODES + 1);
HEAP_SIZE = int(2 * L_CODES + 1);
END_BLOCK = int(256);
MIN_MEM_LEVEL = int(1);
MAX_MEM_LEVEL = int(9);
DEF_MEM_LEVEL = int(8);
STORED = int(0);
FAST = int(1);
SLOW = int(2);
strict private
class var distCode: byte_Array1d;
class var blOrder: byte_Array1d;
class var lengthCode: byte_Array1d;
class var baseLength: int_Array1d;
class var baseDist: int_Array1d;
class var errorMessages: AnsiString_Array1d;
class var configTable: Config_Array1d;
private
class procedure initialize(); static;
class procedure finalize(); static;
class function smaller(const tree: int_Array1d; n, m: int; const depth: byte_Array1d): boolean; static;
class function dcode(dist: int): int; static;
strict private
fldStatus: int;
fldPendingSize: int;
fldDataType: int;
fldLastFlush: int;
fldWSize: int;
fldWBits: int;
fldWMask: int;
fldWindowSize: int;
fldInsh: int;
fldHashSize: int;
fldHashBits: int;
fldHashMask: int;
fldHashShift: int;
fldBlockStart: int;
fldMatchLength: int;
fldPrevMatch: int;
fldMatchAvailable: int;
fldStrStart: int;
fldMatchStart: int;
fldLookahead: int;
fldPrevLength: int;
fldMaxChainLength: int;
fldMaxLazyMatch: int;
fldStrategy: int;
fldGoodMatch: int;
fldNiceMatch: int;
fldLitBufSize: int;
fldLastLit: int;
fldMatches: int;
fldLastEobLen: int;
fldLBuf: int;
fldDBuf: int;
fldBiBuf: int;
fldBiValid: int;
fldWindowBuf: byte_Array1d;
fldPrevBuf: int_Array1d;
fldHeadBuf: int_Array1d;
fldDynamicLTree: int_Array1d;
fldDynamicDTree: int_Array1d;
fldBlTree: int_Array1d;
fldLDesc: Tree;
fldDDesc: Tree;
fldBlDesc: Tree;
fldGHeader: GZIPHeader;
fldStream: ZStream;
procedure lmInit();
procedure trInit();
procedure initBlock();
procedure scanTree(const tree: int_Array1d; maxCode: int);
procedure sendAllTrees(lCodes, dCodes, blCodes: int);
procedure sendTree(const tree: int_Array1d; maxCode: int);
procedure putShortMSB(b: int);
procedure sendCode(c: int; const tree: int_Array1d);
procedure sendBits(val, len: int);
procedure trAlign();
procedure compressBlock(const lTree, dTree: int_Array1d);
procedure setDataType();
procedure biFlush();
procedure biWindup();
procedure copyBlock(buf, len: int; header: boolean);
procedure flushBlockOnly(eof: boolean);
procedure trStoredBlock(buf, storedLen: int; eof: boolean);
procedure trFlushBlock(buf, storedLen: int; eof: boolean);
procedure fillWindow();
function trTally(dist, lc: int): boolean;
function buildBlTree(): int;
function deflateStored(flush: int): int;
function deflateFast(flush: int): int;
function deflateSlow(flush: int): int;
function deflateReset(): int;
function deflateBegin(comLevel, method, windowBits, memLevel, strategy: int): int; overload;
function longestMatch(curMatch: int): int;
function getGZIPHeader(): GZIPHeader;
private
fldPendingOut: int;
fldPendingPos: int;
fldWrap: int;
fldLevel: int;
fldHeapLen: int;
fldHeapMax: int;
fldOptLen: int;
fldStaticLen: int;
fldPendingBuf: byte_Array1d;
fldDepth: byte_Array1d;
fldBlCount: int_Array1d;
fldHeapBuf: int_Array1d;
procedure pqDownHeap(const tree: int_Array1d; k: int);
procedure putBytes(const data: byte_Array1d; offset, length: int);
procedure putByte(c: int);
procedure putShort(w: int);
function deflateBegin(level, wbits, memLevel: int): int; overload;
function deflateBegin(level, wbits: int): int; overload;
function deflateBegin(level: int): int; overload;
function deflateEnd(): int;
function deflateParameters(level, strategy: int): int;
function deflateSetDictionary(const dictionary: byte_Array1d; length: int): int;
function deflate(flush: int): int;
public
constructor create(stream: ZStream);
destructor destroy; override;
end;
InfState = class(ZLib)
strict private const
PRESET_DICT = int($20);
Z_DEFLATED = int(8);
DICT4 = int(2);
DICT3 = int(3);
DICT2 = int(4);
DICT1 = int(5);
DICT0 = int(6);
BLOCKS = int(7);
CHECK4 = int(8);
CHECK3 = int(9);
CHECK2 = int(10);
CHECK1 = int(11);
DONE = int(12);
BAD = int(13);
HEAD = int(14);
LENGTH = int(15);
TIME = int(16);
OS = int(17);
EXLEN = int(18);
EXTRA = int(19);
NAME = int(20);
COMMENT = int(21);
HCRC = int(22);
FLAGS = int(23);
strict private
class var mark: byte_Array1d;
private
class procedure initialize(); static;
class procedure finalize(); static;
strict private
fldReadReturn: boolean;
fldMethod: int;
fldMarker: int;
fldFlags: int;
fldWBits: int;
fldWas: int;
fldNeedCheck: int;
fldNeedBytes: int;
fldCRCBuf: byte_Array1d;
fldTmpString: ByteArrayOutputStream;
fldBlocks: InfBlocks;
fldGHeader: GZIPHeader;
fldStream: ZStream;
procedure checksum(n, v: int);
function inflateReset(): int;
function readBytes(n, r, f: int): int; overload;
function readBytes(r, f: int): int; overload;
function readString(r, f: int): int;
private
fldMode: int;
fldWrap: int;
function inflateEnd(): int;
function inflateBegin(wbits: int): int;
function inflate(f: int): int;
function inflateSetDictionary(const dictionary: byte_Array1d; length: int): int;
function inflateSync(): int;
function inflateSyncPoint(): int;
public
constructor create(stream: ZStream);
destructor destroy; override;
end;
InfBlocks = class(ZLib)
strict private const
MANY = int(1440);
&TYPE = int(0);
LENS = int(1);
STORED = int(2);
TABLE = int(3);
BTREE = int(4);
DTREE = int(5);
CODES = int(6);
DRY = int(7);
DONE = int(8);
BAD = int(9);
strict private
class var inflateMask: int_Array1d;
class var border: int_Array1d;
private
class procedure initialize(); static;
class procedure finalize(); static;
strict private
fldCheck: boolean;
fldMode: int;
fldLeft: int;
fldTable: int;
fldIndex: int;
fldLast: int;
fldBlens: int_Array1d;
fldBB: int_Array1d;
fldTB: int_Array1d;
fldHufts: int_Array1d;
fldCodes: InfCodes;
fldTree: InfTree;
procedure proc1();
private
fldBitK: int;
fldBitB: int;
fldEnd: int;
fldRead: int;
fldWrite: int;
fldWindow: byte_Array1d;
procedure reset(stream: ZStream);
procedure setDictionary(const d: byte_Array1d; start, n: int);
procedure update(stream: ZStream; b, k, n, p, q: int);
function syncPoint(): boolean;
function proc(stream: ZStream; r: int): int;
function inflateFlush(stream: ZStream; r: int): int;
public
constructor create(stream: ZStream; w: int);
destructor destroy; override;
end;
InfCodes = class(ZLib)
strict private const
START = int(0);
LEN = int(1);
LENEXT = int(2);
DIST = int(3);
DISTEXT = int(4);
COPY = int(5);
LIT = int(6);
WASH = int(7);
&END = int(8);
BADCODE = int(9);
strict private
class var inflateMask: int_Array1d;
private
class procedure initialize(); static;
class procedure finalize(); static;
strict private
fldLBits: int;
fldDBits: int;
fldMode: int;
fldLen: int;
fldNeed: int;
fldLit: int;
fldGet: int;
fldDist: int;
fldTreeIndex: int;
fldLTreeIndex: int;
fldDTreeIndex: int;
fldTreeArray: int_Array1d;
fldLTreeArray: int_Array1d;
fldDTreeArray: int_Array1d;
function inflateFast(bl, bd: int; const tlArray: int_Array1d; tlIndex: int; const tdArray: int_Array1d; tdIndex: int; blocks: InfBlocks; stream: ZStream): int;
private
procedure init(bl, bd: int; const tlArray: int_Array1d; tlIndex: int; const tdArray: int_Array1d; tdIndex: int);
function proc(blocks: InfBlocks; stream: ZStream; r: int): int;
end;
InfTree = class(ZLib)
strict private const
MANY = int(1440);
BMAX = int(15);
FIXED_BL = int(9);
FIXED_BD = int(5);
strict private
class var fixedTL: int_Array1d;
class var fixedTD: int_Array1d;
class var cpLens: int_Array1d;
class var cpLext: int_Array1d;
class var cpDist: int_Array1d;
class var cpDext: int_Array1d;
private
class procedure initialize(); static;
class procedure finalize(); static;
class procedure inflateTreesFixed(const bl, bd: int_Array1d; const tl, td: int_Array2d); static;
strict private
fldHN: int_Array1d;
fldV: int_Array1d;
fldC: int_Array1d;
fldR: int_Array1d;
fldU: int_Array1d;
fldX: int_Array1d;
procedure initWorkArea(vsize: int);
function huftBuild(const bArray: int_Array1d; bIndex, n, s: int; const d, e, t, m, hp, hn, v: int_Array1d): int;
private
function inflateTreesBits(const c, bb, tb, hp: int_Array1d; stream: ZStream): int;
function inflateTreesDynamic(nl, nd: int; const c, bl, bd, tl, td, hp: int_Array1d; stream: ZStream): int;
end;
StaticTree = class(ZLib)
strict private const
MAX_BITS = int(15);
BL_CODES = int(19);
D_CODES = int(30);
LITERALS = int(256);
LENGTH_CODES = int(29);
L_CODES = int(LITERALS + LENGTH_CODES + 1);
private const
MAX_BL_BITS = int(7);
private
class var staticLTree: int_Array1d;
class var staticDTree: int_Array1d;
class var extraLBits: int_Array1d;
class var extraDBits: int_Array1d;
class var extraBLBits: int_Array1d;
class var staticLDesc: StaticTree;
class var staticDDesc: StaticTree;
class var staticBLDesc: StaticTree;
class procedure initialize(); static;
class procedure finalize(); static;
private
fldExtraBase: int;
fldElements: int;
fldMaxLength: int;
fldStaticTree: int_Array1d;
fldExtraBits: int_Array1d;
public
constructor create(const staticTree, extraBits: int_Array1d; extraBase, elements, maxLength: int);
end;
Tree = class(ZLib)
strict private const
MAX_BITS = int(15);
LITERALS = int(256);
LENGTH_CODES = int(29);
L_CODES = int(LITERALS + LENGTH_CODES + 1);
HEAP_SIZE = int(2 * L_CODES + 1);
strict private
class procedure genCodes(const tree: int_Array1d; maxCode: int; const blCount: int_Array1d);
class function biReverse(code, len: int): int;
strict private
procedure genBitlen(dState: DefState);
private
fldMaxCode: int;
fldDynamicTree: int_Array1d;
fldStaticDesc: StaticTree;
public
procedure buildTree(dState: DefState);
end;
{%endregion}
{%region Checksum32 }
constructor Checksum32.create();
begin
inherited create();
end;
constructor Checksum32.create(value: int);
begin
inherited create();
fldValue := value;
end;
procedure Checksum32.reset();
begin
fldValue := 0;
end;
procedure Checksum32.reset(value: int);
begin
fldValue := value;
end;
function Checksum32.getValue(): int;
begin
result := fldValue;
end;
{%endregion}
{%region Adler32 }
constructor Adler32.create();
begin
inherited create(1);
end;
constructor Adler32.create(value: int);
begin
inherited create(value);
end;
procedure Adler32.reset();
begin
fldValue := 1;
end;
procedure Adler32.update(const src: byte_Array1d; offset, length: int);
var
len: int;
adler: int;
word0: long;
word1: long;
begin
&Array.checkBounds(src, offset, length);
adler := fldValue;
word0 := long(adler and $ffff);
word1 := long((adler shr 16) and $ffff);
while length > 0 do begin
len := CoInt.min(length, NMAX);
dec(length, len);
while len > 0 do begin
dec(len);
inc(word0, src[offset] and $ff);
inc(word1, word0);
inc(offset);
end;
word0 := word0 mod BASE;
word1 := word1 mod BASE;
end;
fldValue := int((word1 shl 16) or word0);
end;
function Adler32.copy(): Checksum32;
begin
result := Adler32.create(fldValue);
end;
{%endregion}
{%region CRC32 }
class procedure CRC32.initialize();
var
idx: int;
bit: int;
crc: int;
begin
table := &Array.newInt1d(256);
for idx := 0 to 255 do begin
crc := idx;
for bit := 7 downto 0 do begin
if (crc and 1) <> 0 then begin
crc := int($edb88320) xor (crc shr 1);
end else begin
crc := crc shr 1;
end;
end;
table[idx] := crc;
end;
end;
class procedure CRC32.finalize();
begin
table := nil;
end;
constructor CRC32.create();
begin
inherited create();
end;
constructor CRC32.create(value: int);
begin
inherited create(value);
end;
procedure CRC32.update(const src: byte_Array1d; offset, length: int);
var
crc: int;
begin
&Array.checkBounds(src, offset, length);
crc := not fldValue;
while length > 0 do begin
dec(length);
crc := table[int(crc xor src[offset]) and $ff] xor (crc shr 8);
inc(offset);
end;
fldValue := not crc;
end;
function CRC32.copy(): Checksum32;
begin
result := CRC32.create(fldValue);
end;
{%endregion}
{%region ZLib }
class function ZLib.getVersion(): AnsiString;
begin
result := '1.1.0';
end;
class function ZLib.compress(const src: byte_Array1d; offset, length: int; wbits, level, strategy: int): byte_Array1d;
var
zlibResult: int;
currTotalOut: long;
prevTotalOut: long;
buffer: byte_Array1d;
compressor: ZStream;
tempStream: ByteArrayOutputStream;
begin
&Array.checkBounds(src, offset, length);
if (wbits < -MAX_WBITS) or (wbits > -MIN_WBITS) and (wbits < MIN_WBITS) or (wbits > MAX_WBITS) and (wbits < MIN_WBITS + USE_CRC) or (wbits > MAX_WBITS + USE_CRC) then begin
raise IllegalArgumentException.create(AnsiString.format(AResource.readUnitResourceAsAnsiString(pascalx.lang.UNIT_NAME, 'illegal-argument'), [ CoAnsiString.create('wbits') ]));
end;
if (level < DEFAULT_COMPRESSION) or (level > BEST_COMPRESSION) then begin
raise IllegalArgumentException.create(AnsiString.format(AResource.readUnitResourceAsAnsiString(pascalx.lang.UNIT_NAME, 'illegal-argument'), [ CoAnsiString.create('level') ]));
end;
if (strategy < DEFAULT_STRATEGY) or (strategy > HUFFMAN_ONLY) then begin
raise IllegalArgumentException.create(AnsiString.format(AResource.readUnitResourceAsAnsiString(pascalx.lang.UNIT_NAME, 'illegal-argument'), [ CoAnsiString.create('strategy') ]));
end;
compressor := nil;
tempStream := nil;
try
prevTotalOut := 0;
buffer := &Array.newByte1d($10000);
compressor := ZStream.create();
tempStream := ByteArrayOutputStream.create();
compressor.deflateBegin(level, wbits);
if strategy > DEFAULT_STRATEGY then compressor.deflateParameters(level, strategy);
compressor.setInput(src, offset, length, false);
repeat
compressor.setOutput(buffer);
zlibResult := compressor.deflate(FINISH);
currTotalOut := compressor.getTotalOut();
tempStream.write(buffer, 0, int(currTotalOut - prevTotalOut));
if zlibResult = STREAM_END then begin
compressor.deflateEnd();
break;
end;
prevTotalOut := currTotalOut;
until false;
result := tempStream.toByteArray();
finally
compressor.free();
tempStream.free();
end;
end;
class function ZLib.decompress(const src: byte_Array1d; offset, length: int; wbits: int): byte_Array1d;
var
zlibResult: int;
currTotalOut: long;
prevTotalOut: long;
buffer: byte_Array1d;
compressor: ZStream;
tempStream: ByteArrayOutputStream;
begin
&Array.checkBounds(src, offset, length);
if (wbits < -MAX_WBITS) or (wbits > -MIN_WBITS) and (wbits < MIN_WBITS) or (wbits > MAX_WBITS) and (wbits < MIN_WBITS + USE_CRC) or (wbits > MAX_WBITS + USE_CRC) then begin
raise IllegalArgumentException.create(AnsiString.format(AResource.readUnitResourceAsAnsiString(pascalx.lang.UNIT_NAME, 'illegal-argument'), [ CoAnsiString.create('wbits') ]));
end;
compressor := nil;
tempStream := nil;
try
prevTotalOut := 0;
buffer := &Array.newByte1d($10000);
compressor := ZStream.create();
tempStream := ByteArrayOutputStream.create();
compressor.inflateBegin(wbits);
compressor.setInput(src, offset, length, false);
repeat
compressor.setOutput(buffer);
zlibResult := compressor.inflate(NO_FLUSH);
currTotalOut := compressor.getTotalOut();
tempStream.write(buffer, 0, int(currTotalOut - prevTotalOut));
if (zlibResult = STREAM_END) or (zlibResult < 0) then begin
compressor.inflateEnd();
break;
end;
prevTotalOut := currTotalOut;
until false;
result := tempStream.toByteArray();
finally
compressor.free();
tempStream.free();
end;
end;
{%endregion}
{%region ZStream }
procedure ZStream.flushPending();
var
length: int;
dState: DefState;
begin
dState := DefState(fldDeflateState);
length := dState.fldPendingPos;
if length > fldAvailableOut then length := fldAvailableOut;
if length <> 0 then begin
&Array.copyPrimitives(dState.fldPendingBuf, dState.fldPendingOut, fldNextOutArray, fldNextOutIndex, length);
inc(fldNextOutIndex, length);
inc(dState.fldPendingOut, length);
inc(fldTotalOut, long(length));
dec(fldAvailableOut, length);
dec(dState.fldPendingPos, length);
if dState.fldPendingPos = 0 then dState.fldPendingOut := 0;
end;
end;
function ZStream.readBuf(const dst: byte_Array1d; offset, length: int): int;
var
count: int;
begin
count := fldAvailableIn;
if count > length then count := length;
if count = 0 then begin
result := 0;
exit;
end;
dec(fldAvailableIn, count);
if DefState(fldDeflateState).fldWrap <> 0 then fldChecksum.update(fldNextInArray, fldNextInIndex, count);
&Array.copyPrimitives(fldNextInArray, fldNextInIndex, dst, offset, count);
inc(fldNextInIndex, count);
inc(fldTotalIn, long(count));
result := count;
end;
constructor ZStream.create();
begin
inherited create();
fldChecksum := Adler32.create();
end;
destructor ZStream.destroy;
begin
fldDeflateState.free();
fldInflateState.free();
fldChecksum.free();
inherited destroy;
end;
procedure ZStream.setAvailableIn(availableIn: int);
begin
fldAvailableIn := availableIn;
end;
procedure ZStream.setAvailableOut(availableOut: int);
begin
fldAvailableOut := availableOut;
end;
procedure ZStream.setNextInIndex(nextInIndex: int);
begin
fldNextInIndex := nextInIndex;
end;
procedure ZStream.setNextInArray(const nextInArray: byte_Array1d);
begin
fldNextInArray := nextInArray;
end;
procedure ZStream.setNextOutIndex(nextOutIndex: int);
begin
fldNextOutIndex := nextOutIndex;
end;
procedure ZStream.setNextOutArray(const nextOutArray: byte_Array1d);
begin
fldNextOutArray := nextOutArray;
end;
procedure ZStream.setInput(const data: byte_Array1d);
begin
setInput(data, 0, system.length(data), false);
end;
procedure ZStream.setInput(const data: byte_Array1d; append: boolean);
begin
setInput(data, 0, system.length(data), append);
end;
procedure ZStream.setInput(const data: byte_Array1d; offset, length: int);
begin
setInput(data, offset, length, false);
end;
procedure ZStream.setInput(const data: byte_Array1d; offset, length: int; append: boolean);
var
tmp: byte_Array1d;
begin
&Array.checkBounds(data, offset, length);
if (length > 0) or not append or (fldNextInArray = nil) then begin
if (fldAvailableIn > 0) and append then begin
tmp := &Array.newByte1d(fldAvailableIn + length);
&Array.copyPrimitives(fldNextInArray, fldNextInIndex, tmp, 0, fldAvailableIn);
&Array.copyPrimitives(data, offset, tmp, fldAvailableIn, length);
fldNextInArray := tmp;
fldNextInIndex := 0;
inc(fldAvailableIn, length);
end else begin
fldNextInArray := data;
fldNextInIndex := offset;
fldAvailableIn := length;
end;
end;
end;
procedure ZStream.setOutput(const data: byte_Array1d);
begin
setOutput(data, 0, system.length(data));
end;
procedure ZStream.setOutput(const data: byte_Array1d; offset, length: int);
begin
&Array.checkBounds(data, offset, length);
fldNextOutArray := data;
fldNextOutIndex := offset;
fldAvailableOut := length;
end;
function ZStream.inflateFinished(): boolean;
var
iState: InfState;
begin
iState := InfState(fldInflateState);
result := (iState <> nil) and (iState.fldMode = 12);
end;
function ZStream.inflateBegin(): int;
begin
result := inflateBegin(DEFAULT_WBITS, false);
end;
function ZStream.inflateBegin(wbits: int): int;
begin
result := inflateBegin(wbits, false);
end;
function ZStream.inflateBegin(nowrap: boolean): int;
begin
result := inflateBegin(DEFAULT_WBITS, nowrap);
end;
function ZStream.inflateBegin(wbits: int; nowrap: boolean): int;
begin
fldInflateState.free();
fldInflateState := InfState.create(self);
if nowrap then begin
result := InfState(fldInflateState).inflateBegin(-wbits);
exit;
end;
result := InfState(fldInflateState).inflateBegin(wbits);
end;
function ZStream.inflateSetDictionary(const dictionary: byte_Array1d; length: int): int;
var
iState: InfState;
begin
iState := InfState(fldInflateState);
if iState = nil then begin
result := STREAM_ERROR;
exit;
end;
result := iState.inflateSetDictionary(dictionary, length);
end;
function ZStream.inflateSync(): int;
var
iState: InfState;
begin
iState := InfState(fldInflateState);
if iState = nil then begin
result := STREAM_ERROR;
exit;
end;
result := iState.inflateSync();
end;
function ZStream.inflateSyncPoint(): int;
var
iState: InfState;
begin
iState := InfState(fldInflateState);
if iState = nil then begin
result := STREAM_ERROR;
exit;
end;
result := iState.inflateSyncPoint();
end;
function ZStream.inflate(flush: int): int;
var
iState: InfState;
begin
iState := InfState(fldInflateState);
if iState = nil then begin
result := STREAM_ERROR;
exit;
end;
result := iState.inflate(flush);
end;
function ZStream.inflateEnd(): int;
var
iState: InfState;
begin
iState := InfState(fldInflateState);
if iState = nil then begin
result := STREAM_ERROR;
exit;
end;
result := iState.inflateEnd();
fldInflateState := nil;
iState.free();
end;
function ZStream.deflateBegin(level: int): int;
begin
result := deflateBegin(level, DEFAULT_WBITS, false);
end;
function ZStream.deflateBegin(level: int; nowrap: boolean): int;
begin
result := deflateBegin(level, DEFAULT_WBITS, nowrap);
end;
function ZStream.deflateBegin(level, wbits: int): int;
begin
result := deflateBegin(level, wbits, false);
end;
function ZStream.deflateBegin(level, wbits, memLevel: int): int;
begin
fldDeflateState.free();
fldDeflateState := DefState.create(self);
result := DefState(fldDeflateState).deflateBegin(level, wbits, memLevel);
end;
function ZStream.deflateBegin(level, wbits: int; nowrap: boolean): int;
begin
fldDeflateState.free();
fldDeflateState := DefState.create(self);
if nowrap then begin
result := DefState(fldDeflateState).deflateBegin(level, -wbits);
exit;
end;
result := DefState(fldDeflateState).deflateBegin(level, wbits);
end;
function ZStream.deflateSetDictionary(const dictionary: byte_Array1d; length: int): int;
var
dState: DefState;
begin
dState := DefState(fldDeflateState);
if dState = nil then begin
result := STREAM_ERROR;
exit;
end;
result := dState.deflateSetDictionary(dictionary, length);
end;
function ZStream.deflateParameters(level, strategy: int): int;
var
dState: DefState;
begin
dState := DefState(fldDeflateState);
if dState = nil then begin
result := STREAM_ERROR;
exit;
end;
result := dState.deflateParameters(level, strategy);
end;
function ZStream.deflate(flush: int): int;
var
dState: DefState;
begin
dState := DefState(fldDeflateState);
if dState = nil then begin
result := STREAM_ERROR;
exit;
end;
result := dState.deflate(flush);
end;
function ZStream.deflateEnd(): int;
var
dState: DefState;
begin
dState := DefState(fldDeflateState);
if dState = nil then begin
result := STREAM_ERROR;
exit;
end;
result := dState.deflateEnd();
fldDeflateState := nil;
dState.free();
end;
function ZStream.getChecksum(): int;
begin
result := fldChecksum.getValue();
end;
function ZStream.getAvailableIn(): int;
begin
result := fldAvailableIn;
end;
function ZStream.getAvailableOut(): int;
begin
result := fldAvailableOut;
end;
function ZStream.getNextInIndex(): int;
begin
result := fldNextInIndex;
end;
function ZStream.getNextOutIndex(): int;
begin
result := fldNextOutIndex;
end;
function ZStream.getTotalIn(): long;
begin
result := fldTotalIn;
end;
function ZStream.getTotalOut(): long;
begin
result := fldTotalOut;
end;
function ZStream.getMessage(): AnsiString;
begin
result := fldMessage;
end;
function ZStream.getNextInArray(): byte_Array1d;
begin
result := fldNextInArray;
end;
function ZStream.getNextOutArray(): byte_Array1d;
begin
result := fldNextOutArray;
end;
{%endregion}
{%region GZIPHeader }
procedure GZIPHeader.put(deflateState: ZLib);
var
xfl: int;
flags: int;
extra: byte_Array1d;
name: byte_Array1d;
comment: byte_Array1d;
dState: DefState absolute deflateState;
begin
flags := 0;
extra := fldExtra;
name := fldName;
comment := fldComment;
if extra <> nil then flags := flags or $04;
if name <> nil then flags := flags or $08;
if comment <> nil then flags := flags or $10;
case dState.fldLevel of
BEST_SPEED:
xfl := 4;
BEST_COMPRESSION:
xfl := 2;
else
xfl := 0;
end;
dState.putShort($8b1f);
dState.putByte(8);
dState.putByte(flags);
dState.putByte(fldModifiedTime);
dState.putByte(fldModifiedTime shr 8);
dState.putByte(fldModifiedTime shr 16);
dState.putByte(fldModifiedTime shr 24);
dState.putByte(xfl);
dState.putByte(fldOS);
if extra <> nil then begin
flags := system.length(extra);
dState.putByte(flags);
dState.putByte(flags shr 8);
dState.putBytes(extra, 0, flags);
end;
if name <> nil then begin
dState.putBytes(name, 0, system.length(name));
dState.putByte(0);
end;
if comment <> nil then begin
dState.putBytes(comment, 0, system.length(comment));
dState.putByte(0);
end;
end;
constructor GZIPHeader.create();
begin
inherited create();
fldOS := 255;
end;
procedure GZIPHeader.setOS(os: int);
begin
if ((os < 0) or (os > 13)) and (os <> 255) then begin
raise IllegalArgumentException.create(AnsiString.format(AResource.readUnitResourceAsAnsiString(pascalx.lang.UNIT_NAME, 'illegal-argument'), [ CoAnsiString.create('os') ]));
end;
fldOS := os;
end;
procedure GZIPHeader.setCRC(crc: int);
begin
fldCRC := crc;
end;
procedure GZIPHeader.setModifiedTime(modifiedTime: int);
begin
fldModifiedTime := modifiedTime;
end;
procedure GZIPHeader.setName(const name: AnsiString);
begin
fldName := name.toByteArray();
end;
procedure GZIPHeader.setComment(const comment: AnsiString);
begin
fldComment := comment.toByteArray();
end;
function GZIPHeader.getOS(): int;
begin
result := fldOS;
end;
function GZIPHeader.getCRC(): int;
begin
result := fldCRC;
end;
function GZIPHeader.getModifiedTime(): int;
begin
result := fldModifiedTime;
end;
function GZIPHeader.getName(): AnsiString;
begin
result := AnsiString.create(fldName);
end;
function GZIPHeader.getComment(): AnsiString;
begin
result := AnsiString.create(fldComment);
end;
{%endregion}
{%region Config }
constructor Config.create(goodLength, maxLazy, niceLength, maxChain, func: int);
begin
inherited create();
fldGoodLength := goodLength;
fldMaxLazy := maxLazy;
fldNiceLength := niceLength;
fldMaxChain := maxChain;
fldFunc := func;
end;
{%endregion}
{%region DefState }
class procedure DefState.initialize();
begin
distCode := [
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
];
blOrder := [
16, 17, 18, 0, 8, 7, 9, 6, 10, 5,
11, 4, 12, 3, 13, 2, 14, 1, 15
];
lengthCode := [
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
];
baseLength := [
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
];
baseDist := [
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
];
errorMessages := [
'need dictionary',
'stream end',
'',
'file error',
'stream error',
'data error',
'insufficient memory',
'buffer error',
'incompatible version',
''
];
configTable := [
Config.create(0, 0, 0, 0, STORED),
Config.create(4, 4, 8, 4, FAST),
Config.create(4, 5, 16, 8, FAST),
Config.create(4, 6, 32, 32, FAST),
Config.create(4, 4, 16, 16, SLOW),
Config.create(8, 16, 32, 32, SLOW),
Config.create(8, 16, 128, 128, SLOW),
Config.create(8, 32, 128, 256, SLOW),
Config.create(32, 128, 258, 1024, SLOW),
Config.create(32, 258, 258, 4096, SLOW)
];
end;
class procedure DefState.finalize();
var
index: int;
begin
for index := system.length(configTable) - 1 downto 0 do begin
configTable[index].free();
end;
configTable := nil;
errorMessages := nil;
baseDist := nil;
baseLength := nil;
lengthCode := nil;
blOrder := nil;
distCode := nil;
end;
class function DefState.smaller(const tree: int_Array1d; n, m: int; const depth: byte_Array1d): boolean;
var
tn2: int;
tm2: int;
begin
tn2 := tree[n * 2];
tm2 := tree[m * 2];
result := (tn2 < tm2) or ((tn2 = tm2) and (depth[n] <= depth[m]));
end;
class function DefState.dcode(dist: int): int;
begin
if dist < 256 then begin
result := distCode[dist];
exit;
end;
result := distCode[256 + (dist shr 7)];
end;
procedure DefState.lmInit();
var
cfg: Config;
begin
fldWindowSize := 2 * fldWSize;
&Array.fillPrimitives(fldHeadBuf, 0, fldHashSize, 0);
cfg := configTable[fldLevel];
fldMaxLazyMatch := cfg.maxLazy;
fldGoodMatch := cfg.goodLength;
fldNiceMatch := cfg.niceLength;
fldMaxChainLength := cfg.maxChain;
fldStrStart := 0;
fldBlockStart := 0;
fldLookahead := 0;
fldMatchLength := MIN_MATCH - 1;
fldPrevLength := MIN_MATCH - 1;
fldMatchAvailable := 0;
fldInsh := 0;
end;
procedure DefState.trInit();
var
desc: Tree;
begin
desc := fldLDesc;
desc.fldDynamicTree := fldDynamicLTree;
desc.fldStaticDesc := StaticTree.staticLDesc;
desc := fldDDesc;
desc.fldDynamicTree := fldDynamicDTree;
desc.fldStaticDesc := StaticTree.staticDDesc;
desc := fldBlDesc;
desc.fldDynamicTree := fldBlTree;
desc.fldStaticDesc := StaticTree.staticBLDesc;
fldBiBuf := 0;
fldBiValid := 0;
fldLastEobLen := 8;
initBlock();
end;
procedure DefState.initBlock();
var
index: int;
tree: int_Array1d;
begin
tree := fldBlTree;
for index := 0 to BL_CODES - 1 do begin
tree[index * 2] := 0;
end;
tree := fldDynamicDTree;
for index := 0 to D_CODES - 1 do begin
tree[index * 2] := 0;
end;
tree := fldDynamicLTree;
for index := 0 to L_CODES - 1 do begin
tree[index * 2] := 0;
end;
tree[END_BLOCK * 2] := 1;
fldOptLen := 0;
fldStaticLen := 0;
fldLastLit := 0;
fldMatches := 0;
end;
procedure DefState.scanTree(const tree: int_Array1d; maxCode: int);
var
index: int;
count: int;
prevLen: int;
currLen: int;
nextLen: int;
maxCount: int;
minCount: int;
blTree: int_Array1d;
begin
prevLen := -1;
nextLen := tree[1];
count := 0;
maxCount := 7;
minCount := 4;
if nextLen = 0 then begin
maxCount := 138;
minCount := 3;
end;
tree[(maxCode + 1) * 2 + 1] := -1;
blTree := fldBlTree;
for index := 0 to maxCode do begin
currLen := nextLen;
nextLen := tree[index * 2 + 3];
inc(count);
if (count < maxCount) and (currLen = nextLen) then continue;
if count < minCount then begin
inc(blTree[currLen * 2], count);
end else
if currLen <> 0 then begin
if currLen <> prevLen then inc(blTree[currLen * 2]);
inc(blTree[REP_3_6 * 2]);
end else
if count <= 10 then begin
inc(blTree[REPZ_3_10 * 2]);
end else begin
inc(blTree[REPZ_11_138 * 2]);
end;
count := 0;
prevLen := currLen;
if nextLen = 0 then begin
maxCount := 138;
minCount := 3;
end else
if currLen = nextLen then begin
maxCount := 6;
minCount := 3;
end else begin
maxCount := 7;
minCount := 4;
end;
end;
end;
procedure DefState.sendAllTrees(lCodes, dCodes, blCodes: int);
var
rank: int;
blTree: int_Array1d;
begin
sendBits(lCodes - 257, 5);
sendBits(dCodes - 1, 5);
sendBits(blCodes - 4, 4);
blTree := fldBlTree;
for rank := 0 to blCodes - 1 do begin
sendBits(blTree[blOrder[rank] * 2 + 1], 3);
end;
sendTree(fldDynamicLTree, lCodes - 1);
sendTree(fldDynamicDTree, dCodes - 1);
end;
procedure DefState.sendTree(const tree: int_Array1d; maxCode: int);
var
index: int;
count: int;
prevLen: int;
currLen: int;
nextLen: int;
maxCount: int;
minCount: int;
begin
prevLen := -1;
nextLen := tree[1];
count := 0;
maxCount := 7;
minCount := 4;
if nextLen = 0 then begin
maxCount := 138;
minCount := 3;
end;
for index := 0 to maxCode do begin
currLen := nextLen;
nextLen := tree[index * 2 + 3];
inc(count);
if (count < maxCount) and (currLen = nextLen) then continue;
if count < minCount then begin
repeat
sendCode(currLen, fldBlTree);
dec(count);
until count = 0;
end else
if currLen <> 0 then begin
if currLen <> prevLen then begin
sendCode(currLen, fldBlTree);
dec(count);
end;
sendCode(REP_3_6, fldBlTree);
sendBits(count - 3, 2);
end else
if count <= 10 then begin
sendCode(REPZ_3_10, fldBlTree);
sendBits(count - 3, 3);
end else begin
sendCode(REPZ_11_138, fldBlTree);
sendBits(count - 11, 7);
end;
count := 0;
prevLen := currLen;
if nextLen = 0 then begin
maxCount := 138;
minCount := 3;
end else
if currLen = nextLen then begin
maxCount := 6;
minCount := 3;
end else begin
maxCount := 7;
minCount := 4;
end;
end;
end;
procedure DefState.putShortMSB(b: int);
begin
putByte(b shr 8);
putByte(b);
end;
procedure DefState.sendCode(c: int; const tree: int_Array1d);
var
c2: int;
begin
c2 := c * 2;
sendBits(tree[c2] and $ffff, tree[c2 + 1] and $ffff);
end;
procedure DefState.sendBits(val, len: int);
var
buf: int;
valid: int;
begin
valid := fldBiValid;
buf := fldBiBuf or ((val shl valid) and $ffff);
if valid > BUF_SIZE - len then begin
putShort(buf);
buf := short(val shr (BUF_SIZE - valid));
fldBiValid := valid + len - BUF_SIZE;
end else begin
fldBiValid := valid + len;
end;
fldBiBuf := buf;
end;
procedure DefState.trAlign();
begin
sendBits(STATIC_TREES shl 1, 3);
sendCode(END_BLOCK, StaticTree.staticLTree);
biFlush();
if fldLastEobLen - fldBiValid + 11 < 9 then begin
sendBits(STATIC_TREES shl 1, 3);
sendCode(END_BLOCK, StaticTree.staticLTree);
biFlush();
end;
fldLastEobLen := 7;
end;
procedure DefState.compressBlock(const lTree, dTree: int_Array1d);
var
lc: int;
lx: int;
dist: int;
code: int;
extra: int;
buf: byte_Array1d;
begin
lx := 0;
if fldLastLit <> 0 then begin
buf := fldPendingBuf;
repeat
dist := ((int(buf[fldDBuf + lx * 2]) shl 8) and $ff00) or (int(buf[fldDBuf + lx * 2 + 1]) and $ff);
lc := int(buf[fldLBuf + lx]) and $ff;
inc(lx);
if dist = 0 then begin
sendCode(lc, lTree);
continue;
end;
code := lengthCode[lc];
sendCode(code + (LITERALS + 1), lTree);
extra := StaticTree.extraLBits[code];
if extra <> 0 then begin
dec(lc, baseLength[code]);
sendBits(lc, extra);
end;
dec(dist);
code := dcode(dist);
sendCode(code, dTree);
extra := StaticTree.extraDBits[code];
if extra <> 0 then begin
dec(dist, baseDist[code]);
sendBits(dist, extra);
end;
until lx >= fldLastLit;
end;
sendCode(END_BLOCK, lTree);
fldLastEobLen := lTree[END_BLOCK * 2 + 1];
end;
procedure DefState.setDataType();
var
index: int;
binFreq: int;
asciiFreq: int;
tree: int_Array1d;
begin
index := 0;
binFreq := 0;
asciiFreq := 0;
tree := fldDynamicLTree;
while index < 7 do begin
inc(binFreq, tree[index * 2]);
inc(index);
end;
while index < 128 do begin
inc(asciiFreq, tree[index * 2]);
inc(index);
end;
while index < LITERALS do begin
inc(binFreq, tree[index * 2]);
inc(index);
end;
if binFreq > (asciiFreq shr 2) then begin
fldDataType := Z_BINARY;
exit;
end;
fldDataType := Z_ASCII;
end;
procedure DefState.biFlush();
var
buf: int;
valid: int;
begin
buf := fldBiBuf;
valid := fldBiValid;
if valid = 16 then begin
putShort(buf);
fldBiBuf := 0;
fldBiValid := 0;
exit;
end;
if valid >= 8 then begin
putByte(buf);
fldBiBuf := buf shr 8;
fldBiValid := valid - 8;
end;
end;
procedure DefState.biWindup();
var
valid: int;
begin
valid := fldBiValid;
if valid > 8 then begin
putShort(fldBiBuf);
end else
if valid > 0 then begin
putByte(fldBiBuf);
end;
fldBiBuf := 0;
fldBiValid := 0;
end;
procedure DefState.copyBlock(buf, len: int; header: boolean);
begin
biWindup();
fldLastEobLen := 8;
if header then begin
putShort(len);
putShort(not len);
end;
putBytes(fldWindowBuf, buf, len);
end;
procedure DefState.flushBlockOnly(eof: boolean);
var
blockStart: int;
begin
blockStart := fldBlockStart;
if blockStart >= 0 then begin
trFlushBlock(blockStart, fldStrStart - blockStart, eof);
end else begin
trFlushBlock(-1, fldStrStart - blockStart, eof);
end;
fldBlockStart := fldStrStart;
fldStream.flushPending();
end;
procedure DefState.trStoredBlock(buf, storedLen: int; eof: boolean);
begin
if eof then begin
sendBits((STORED_BLOCK shl 1) + 1, 3);
end else begin
sendBits(STORED_BLOCK shl 1, 3);
end;
copyBlock(buf, storedLen, true);
end;
procedure DefState.trFlushBlock(buf, storedLen: int; eof: boolean);
var
optLenb: int;
staticLenb: int;
maxBlIndex: int;
begin
maxBlIndex := 0;
if fldLevel > 0 then begin
if fldDataType = Z_UNKNOWN then setDataType();
fldLDesc.buildTree(self);
fldDDesc.buildTree(self);
maxBlIndex := buildBlTree();
optLenb := (fldOptLen + 10) shr 3;
staticLenb := (fldStaticLen + 10) shr 3;
if staticLenb <= optLenb then optLenb := staticLenb;
end else begin
optLenb := storedLen + 5;
staticLenb := optLenb;
end;
if (storedLen + 4 <= optLenb) and (buf <> -1) then begin
trStoredBlock(buf, storedLen, eof);
end else
if staticLenb = optLenb then begin
if eof then begin
sendBits((STATIC_TREES shl 1) + 1, 3);
end else begin
sendBits(STATIC_TREES shl 1, 3);
end;
compressBlock(StaticTree.staticLTree, StaticTree.staticDTree);
end else begin
if eof then begin
sendBits((DYN_TREES shl 1) + 1, 3);
end else begin
sendBits(DYN_TREES shl 1, 3);
end;
sendAllTrees(fldLDesc.fldMaxCode + 1, fldDDesc.fldMaxCode + 1, maxBlIndex + 1);
compressBlock(fldDynamicLTree, fldDynamicDTree);
end;
initBlock();
if eof then biWindup();
end;
procedure DefState.fillWindow();
var
n: int;
m: int;
p: int;
more: int;
insh: int;
wSize: int;
strStart: int;
hashSize: int;
hashMask: int;
hashShift: int;
lookahead: int;
blockStart: int;
matchStart: int;
windowSize: int;
windowBuf: byte_Array1d;
headBuf: int_Array1d;
prevBuf: int_Array1d;
stream: ZStream;
begin
insh := fldInsh;
wSize := fldWSize;
strStart := fldStrStart;
hashSize := fldHashSize;
hashMask := fldHashMask;
hashShift := fldHashShift;
lookahead := fldLookahead;
blockStart := fldBlockStart;
matchStart := fldMatchStart;
windowSize := fldWindowSize;
windowBuf := fldWindowBuf;
headBuf := fldHeadBuf;
prevBuf := fldPrevBuf;
stream := fldStream;
repeat
more := windowSize - lookahead - strStart;
if (more = 0) and (strStart = 0) and (lookahead = 0) then begin
more := wSize;
end else
if more = -1 then begin
dec(more);
end else
if strStart >= wSize * 2 - MIN_LOOKAHEAD then begin
&Array.copyPrimitives(windowBuf, wSize, windowBuf, 0, wSize);
dec(matchStart, wSize);
dec(strStart, wSize);
dec(blockStart, wSize);
n := hashSize;
p := n;
repeat
dec(p);
m := headBuf[p] and $ffff;
if m >= wSize then begin
headBuf[p] := short(m - wSize);
end else begin
headBuf[p] := 0;
end;
dec(n);
until n = 0;
n := wSize;
p := n;
repeat
dec(p);
m := prevBuf[p] and $ffff;
if m >= wSize then begin
prevBuf[p] := short(m - wSize);
end else begin
prevBuf[p] := 0;
end;
dec(n);
until n = 0;
inc(more, wSize);
end;
if stream.fldAvailableIn = 0 then exit;
n := stream.readBuf(windowBuf, strStart + lookahead, more);
inc(lookahead, n);
if lookahead >= MIN_MATCH then insh := (((int(windowBuf[strStart]) and $ff) shl hashShift) xor (int(windowBuf[strStart + 1]) and $ff)) and hashMask;
until (lookahead >= MIN_LOOKAHEAD) or (stream.fldAvailableIn = 0);
fldMatchStart := matchStart;
fldBlockStart := blockStart;
fldLookahead := lookahead;
fldStrStart := strStart;
fldInsh := insh;
end;
function DefState.trTally(dist, lc: int): boolean;
var
dBuf: int;
dCode: int;
lastLit: int;
inLength: int;
outLength: int;
pendingBuf: byte_Array1d;
tree: int_Array1d;
begin
dBuf := fldDBuf;
lastLit := fldLastLit;
pendingBuf := fldPendingBuf;
pendingBuf[dBuf + lastLit * 2] := byte(dist shr 8);
pendingBuf[dBuf + lastLit * 2 + 1] := byte(dist);
pendingBuf[fldLBuf + lastLit] := byte(lc);
inc(lastLit);
fldLastLit := lastLit;
if dist = 0 then begin
inc(fldDynamicLTree[lc * 2]);
end else begin
dec(dist);
inc(fldMatches);
inc(fldDynamicLTree[(lengthCode[lc] + (LITERALS + 1)) * 2]);
inc(fldDynamicDTree[self.dcode(dist) * 2]);
end;
if ((lastLit and $1fff) = 0) and (fldLevel > 2) then begin
tree := fldDynamicDTree;
outLength := lastLit * 8;
inLength := fldStrStart - fldBlockStart;
for dCode := 0 to D_CODES - 1 do begin
inc(outLength, int(long(tree[dCode * 2]) * (long(5) + long(StaticTree.extraDBits[dCode]))));
end;
outLength := outLength shr 3;
if (fldMatches < lastLit div 2) and (outLength < inLength div 2) then begin
result := true;
exit;
end;
end;
result := lastLit = fldLitBufSize - 1;
end;
function DefState.buildBlTree(): int;
var
codes: int;
tree: int_Array1d;
begin
scanTree(fldDynamicLTree, fldLDesc.fldMaxCode);
scanTree(fldDynamicDTree, fldDDesc.fldMaxCode);
fldBlDesc.buildTree(self);
codes := BL_CODES - 1;
tree := fldBlTree;
while (codes >= 3) and (tree[blOrder[codes] * 2 + 1] = 0) do begin
dec(codes);
end;
inc(fldOptLen, 3 * (codes + 1) + 14);
result := codes;
end;
function DefState.deflateStored(flush: int): int;
var
maxStart: int;
maxBlockSize: int;
stream:ZStream;
begin
stream := fldStream;
maxBlockSize := $ffff;
if maxBlockSize > fldPendingSize - 5 then maxBlockSize := fldPendingSize - 5;
repeat
if fldLookahead <= 1 then begin
fillWindow();
if (fldLookahead = 0) and (flush = NO_FLUSH) then begin
result := NEED_MORE;
exit;
end;
if fldLookahead = 0 then break;
end;
inc(fldStrStart, fldLookahead);
fldLookahead := 0;
maxStart := fldBlockStart + maxBlockSize;
if (fldStrStart = 0) or (fldStrStart >= maxStart) then begin
fldLookahead := fldStrStart - maxStart;
fldStrStart := maxStart;
flushBlockOnly(false);
if stream.fldAvailableOut = 0 then begin
result := NEED_MORE;
exit;
end;
end;
if fldStrStart - fldBlockStart >= fldWSize - MIN_LOOKAHEAD then begin
flushBlockOnly(false);
if stream.fldAvailableOut = 0 then begin
result := NEED_MORE;
exit;
end;
end;
until false;
flushBlockOnly(flush = FINISH);
if stream.fldAvailableOut = 0 then begin
if flush = FINISH then begin
result := FINISH_STARTED;
exit;
end;
result := NEED_MORE;
exit;
end;
if flush = FINISH then begin
result := FINISH_DONE;
exit;
end;
result := BLOCK_DONE;
end;
function DefState.deflateFast(flush: int): int;
var
bFlush: boolean;
hashHead: int;
stream: ZStream;
begin
stream := fldStream;
hashHead := 0;
repeat
if fldLookahead < MIN_LOOKAHEAD then begin
fillWindow();
if (fldLookahead < MIN_LOOKAHEAD) and (flush = NO_FLUSH) then begin
result := NEED_MORE;
exit;
end;
if fldLookahead = 0 then break;
end;
if fldLookahead >= MIN_MATCH then begin
fldInsh := ((fldInsh shl fldHashShift) xor (int(fldWindowBuf[fldStrStart + (MIN_MATCH - 1)]) and $ff)) and fldHashMask;
hashHead := fldHeadBuf[fldInsh] and $ffff;
fldPrevBuf[fldStrStart and fldWMask] := fldHeadBuf[fldInsh];
fldHeadBuf[fldInsh] := short(fldStrStart);
end;
if (hashHead <> 0) and (((fldStrStart - hashHead) and $ffff) <= fldWSize - MIN_LOOKAHEAD) and (fldStrategy <> HUFFMAN_ONLY) then fldMatchLength := longestMatch(hashHead);
if fldMatchLength >= MIN_MATCH then begin
bFlush := trTally(fldStrStart - fldMatchStart, fldMatchLength - MIN_MATCH);
dec(fldLookahead, fldMatchLength);
if (fldMatchLength <= fldMaxLazyMatch) and (fldLookahead >= MIN_MATCH) then begin
dec(fldMatchLength);
repeat
inc(fldStrStart);
fldInsh := ((fldInsh shl fldHashShift) xor (int(fldWindowBuf[fldStrStart + (MIN_MATCH - 1)]) and $ff)) and fldHashMask;
hashHead := fldHeadBuf[fldInsh] and $ffff;
fldPrevBuf[fldStrStart and fldWMask] := fldHeadBuf[fldInsh];
fldHeadBuf[fldInsh] := short(fldStrStart);
dec(fldMatchLength);
until fldMatchLength = 0;
inc(fldStrStart);
end else begin
inc(fldStrStart, fldMatchLength);
fldMatchLength := 0;
fldInsh := int(fldWindowBuf[fldStrStart]) and $ff;
fldInsh := ((fldInsh shl fldHashShift) xor (int(fldWindowBuf[fldStrStart + 1]) and $ff)) and fldHashMask;
end;
end else begin
bFlush := trTally(0, int(fldWindowBuf[fldStrStart]) and $ff);
dec(fldLookahead);
inc(fldStrStart);
end;
if bFlush then begin
flushBlockOnly(false);
if stream.fldAvailableOut = 0 then begin
result := NEED_MORE;
exit;
end;
end;
until false;
flushBlockOnly(flush = FINISH);
if stream.fldAvailableOut = 0 then begin
if flush = FINISH then begin
result := FINISH_STARTED;
exit;
end;
result := NEED_MORE;
exit;
end;
if flush = FINISH then begin
result := FINISH_DONE;
exit;
end;
result := BLOCK_DONE;
end;
function DefState.deflateSlow(flush: int): int;
var
bFlush: boolean;
maxInsert: int;
hashHead: int;
stream: ZStream;
begin
stream := fldStream;
hashHead := 0;
repeat
if fldLookahead < MIN_LOOKAHEAD then begin
fillWindow();
if (fldLookahead < MIN_LOOKAHEAD) and (flush = NO_FLUSH) then begin
result := NEED_MORE;
exit;
end;
if fldLookahead = 0 then break;
end;
if fldLookahead >= MIN_MATCH then begin
fldInsh := ((fldInsh shl fldHashShift) xor (int(fldWindowBuf[fldStrStart + (MIN_MATCH - 1)]) and $ff)) and fldHashMask;
hashHead := fldHeadBuf[fldInsh] and $ffff;
fldPrevBuf[fldStrStart and fldWMask] := fldHeadBuf[fldInsh];
fldHeadBuf[fldInsh] := short(fldStrStart);
end;
fldPrevLength := fldMatchLength;
fldPrevMatch := fldMatchStart;
fldMatchLength := MIN_MATCH - 1;
if (hashHead <> 0) and (fldPrevLength < fldMaxLazyMatch) and (((fldStrStart - hashHead) and $ffff) <= fldWSize - MIN_LOOKAHEAD) then begin
if fldStrategy <> HUFFMAN_ONLY then begin
fldMatchLength := longestMatch(hashHead);
end;
if (fldMatchLength <= 5) and ((fldStrategy = FILTERED) or ((fldMatchLength = MIN_MATCH) and (fldStrStart - fldMatchStart > $1000))) then begin
fldMatchLength := MIN_MATCH - 1;
end;
end;
if (fldPrevLength >= MIN_MATCH) and (fldMatchLength <= fldPrevLength) then begin
maxInsert := fldStrStart + fldLookahead - MIN_MATCH;
bFlush := trTally(fldStrStart - fldPrevMatch - 1, fldPrevLength - MIN_MATCH);
dec(fldLookahead, fldPrevLength - 1);
dec(fldPrevLength, 2);
repeat
inc(fldStrStart);
if fldStrStart <= maxInsert then begin
fldInsh := ((fldInsh shl fldHashShift) xor (int(fldWindowBuf[fldStrStart + (MIN_MATCH - 1)]) and $ff)) and fldHashMask;
hashHead := fldHeadBuf[fldInsh] and $ffff;
fldPrevBuf[fldStrStart and fldWMask] := fldHeadBuf[fldInsh];
fldHeadBuf[fldInsh] := short(fldStrStart);
end;
dec(fldPrevLength);
until fldPrevLength = 0;
fldMatchAvailable := 0;
fldMatchLength := MIN_MATCH - 1;
inc(fldStrStart);
if bFlush then begin
flushBlockOnly(false);
if stream.fldAvailableOut = 0 then begin
result := NEED_MORE;
exit;
end;
end;
end else
if fldMatchAvailable <> 0 then begin
bFlush := trTally(0, int(fldWindowBuf[fldStrStart - 1]) and $ff);
if bFlush then flushBlockOnly(false);
inc(fldStrStart);
dec(fldLookahead);
if stream.fldAvailableOut = 0 then begin
result := NEED_MORE;
exit;
end;
end else begin
fldMatchAvailable := 1;
inc(fldStrStart);
dec(fldLookahead);
end;
until false;
if fldMatchAvailable <> 0 then begin
trTally(0, int(fldWindowBuf[fldStrStart - 1]) and $ff);
fldMatchAvailable := 0;
end;
flushBlockOnly(flush = FINISH);
if stream.fldAvailableOut = 0 then begin
if flush = FINISH then begin
result := FINISH_STARTED;
exit;
end;
result := NEED_MORE;
exit;
end;
if flush = FINISH then begin
result := FINISH_DONE;
exit;
end;
result := BLOCK_DONE;
end;
function DefState.deflateReset(): int;
var
wrap: int;
stream: ZStream;
begin
stream := fldStream;
stream.fldTotalIn := 0;
stream.fldTotalOut := 0;
stream.fldMessage := '';
stream.fldDataType := Z_UNKNOWN;
fldPendingPos := 0;
fldPendingOut := 0;
wrap := fldWrap;
if wrap < 0 then fldWrap := -wrap;
if wrap = 0 then begin
fldStatus := BUSY_STATE;
end else begin
fldStatus := INIT_STATE;
end;
stream.fldChecksum.reset();
fldLastFlush := NO_FLUSH;
trInit();
lmInit();
result := OK;
end;
function DefState.deflateBegin(comLevel, method, windowBits, memLevel, strategy: int): int;
var
wrapLocal: int;
stream: ZStream;
begin
wrapLocal := 1;
stream := fldStream;
stream.fldMessage := '';
if comLevel = DEFAULT_COMPRESSION then comLevel := 6;
if windowBits < 0 then begin
wrapLocal := 0;
windowBits := -windowBits;
end else
if windowBits >= USE_CRC then begin
wrapLocal := 2;
dec(windowBits, USE_CRC);
stream.fldChecksum.free();
stream.fldChecksum := CRC32.create();
end;
if
(method <> Z_DEFLATED) or
(windowBits < MIN_WBITS) or (windowBits > MAX_WBITS) or
(memLevel < MIN_MEM_LEVEL) or (memLevel > MAX_MEM_LEVEL) or
(strategy < DEFAULT_STRATEGY) or (strategy > HUFFMAN_ONLY) or
(comLevel < NO_COMPRESSION) or (comLevel > BEST_COMPRESSION)
then begin
result := STREAM_ERROR;
exit;
end;
fldWrap := wrapLocal;
fldWBits := windowBits;
fldWSize := 1 shl windowBits;
fldWMask := fldWSize - 1;
fldHashBits := memLevel + 7;
fldHashSize := 1 shl fldHashBits;
fldHashMask := fldHashSize - 1;
fldHashShift := (fldHashBits + (MIN_MATCH - 1)) div MIN_MATCH;
fldWindowBuf := &Array.newByte1d(fldWSize * 2);
fldPrevBuf := &Array.newInt1d(fldWSize);
fldHeadBuf := &Array.newInt1d(fldHashSize);
fldLitBufSize := 1 shl (memLevel + 6);
fldPendingBuf := &Array.newByte1d(fldLitBufSize * 4);
fldPendingSize := fldLitBufSize * 4;
fldDBuf := fldLitBufSize div 2;
fldLBuf := fldLitBufSize * 3;
fldLevel := comLevel;
fldStrategy := strategy;
result := deflateReset();
end;
function DefState.longestMatch(curMatch: int): int;
function predinc(var variable: int): int; inline;
begin
inc(variable);
result := variable;
end;
var
scanEndCurr: byte;
scanEndPrev: byte;
scan: int;
match: int;
limit: int;
wMask: int;
strEnd: int;
length: int;
lookahead: int;
bestLength: int;
chainLength: int;
niceMatchLocal: int;
windowBuf: byte_Array1d;
begin
chainLength := fldMaxChainLength;
scan := fldStrStart;
bestLength := fldPrevLength;
if scan > fldWSize - MIN_LOOKAHEAD then begin
limit := scan - (fldWSize - MIN_LOOKAHEAD);
end else begin
limit := 0;
end;
niceMatchLocal := fldNiceMatch;
wMask := fldWMask;
strEnd := scan + MAX_MATCH;
windowBuf := fldWindowBuf;
scanEndPrev := windowBuf[scan + bestLength - 1];
scanEndCurr := windowBuf[scan + bestLength];
if fldPrevLength >= fldGoodMatch then chainLength := CoInt.sar(chainLength, 2);
lookahead := fldLookahead;
if niceMatchLocal > lookahead then niceMatchLocal := lookahead;
repeat
match := curMatch;
if
(windowBuf[match + bestLength] = scanEndCurr) and
(windowBuf[match + bestLength - 1] = scanEndPrev) and
(windowBuf[match] = windowBuf[scan]) and
(windowBuf[predinc(match)] = windowBuf[scan + 1])
then begin
inc(scan, 2);
inc(match);
repeat
until
(windowBuf[predinc(scan)] <> windowBuf[predinc(match)]) or (windowBuf[predinc(scan)] <> windowBuf[predinc(match)]) or
(windowBuf[predinc(scan)] <> windowBuf[predinc(match)]) or (windowBuf[predinc(scan)] <> windowBuf[predinc(match)]) or
(windowBuf[predinc(scan)] <> windowBuf[predinc(match)]) or (windowBuf[predinc(scan)] <> windowBuf[predinc(match)]) or
(windowBuf[predinc(scan)] <> windowBuf[predinc(match)]) or (windowBuf[predinc(scan)] <> windowBuf[predinc(match)]) or
(scan >= strEnd)
;
length := MAX_MATCH - (strEnd - scan);
scan := strEnd - MAX_MATCH;
if length > bestLength then begin
fldMatchStart := curMatch;
bestLength := length;
if length >= niceMatchLocal then break;
scanEndPrev := windowBuf[scan + bestLength - 1];
scanEndCurr := windowBuf[scan + bestLength];
end;
end;
curMatch := fldPrevBuf[curMatch and wMask] and $ffff;
if curMatch <= limit then break;
dec(chainLength);
until chainLength = 0;
result := CoInt.min(bestLength, lookahead);
end;
function DefState.getGZIPHeader(): GZIPHeader;
var
gHeader: GZIPHeader;
begin
gHeader := fldGHeader;
if gHeader = nil then begin
gHeader := GZIPHeader.create();
fldGHeader := gHeader;
end;
result := gHeader;
end;
procedure DefState.pqDownHeap(const tree: int_Array1d; k: int);
var
v: int;
j: int;
len: int;
depth: byte_Array1d;
buf: int_Array1d;
begin
depth := fldDepth;
len := fldHeapLen;
buf := fldHeapBuf;
v := buf[k];
j := k shl 1;
while j <= len do begin
if (j < len) and smaller(tree, buf[j + 1], buf[j], depth) then inc(j);
if smaller(tree, v, buf[j], depth) then break;
buf[k] := buf[j];
k := j;
j := j shl 1;
end;
buf[k] := v;
end;
procedure DefState.putBytes(const data: byte_Array1d; offset, length: int);
begin
&Array.checkBounds(data, offset, length);
&Array.copyPrimitives(data, offset, fldPendingBuf, fldPendingPos, length);
inc(fldPendingPos, length);
end;
procedure DefState.putByte(c: int);
begin
fldPendingBuf[fldPendingPos] := byte(c);
inc(fldPendingPos);
end;
procedure DefState.putShort(w: int);
begin
putByte(w);
putByte(w shr 8);
end;
function DefState.deflateBegin(level, wbits, memLevel: int): int;
begin
result := deflateBegin(level, Z_DEFLATED, wbits, memLevel, DEFAULT_STRATEGY);
end;
function DefState.deflateBegin(level, wbits: int): int;
begin
result := deflateBegin(level, Z_DEFLATED, wbits, DEF_MEM_LEVEL, DEFAULT_STRATEGY);
end;
function DefState.deflateBegin(level: int): int;
begin
result := deflateBegin(level, Z_DEFLATED, DEFAULT_WBITS, DEF_MEM_LEVEL, DEFAULT_STRATEGY);
end;
function DefState.deflateEnd(): int;
var
status: int;
begin
status := fldStatus;
if (status <> INIT_STATE) and (status <> BUSY_STATE) and (status <> FINISH_STATE) then begin
result := STREAM_ERROR;
exit;
end;
fldPendingBuf := nil;
fldHeadBuf := nil;
fldPrevBuf := nil;
fldWindowBuf := nil;
if status = BUSY_STATE then begin
result := DATA_ERROR;
exit;
end;
result := OK;
end;
function DefState.deflateParameters(level, strategy: int): int;
var
cfg: Config;
stream: ZStream;
begin
result := OK;
if level = DEFAULT_COMPRESSION then level := 6;
if (level < 0) or (level > 9) or (strategy < 0) or (strategy > HUFFMAN_ONLY) then begin
result := STREAM_ERROR;
exit;
end;
stream := fldStream;
if (configTable[fldLevel].func <> configTable[level].func) and (stream.fldTotalIn <> 0) then begin
result := stream.deflate(PARTIAL_FLUSH);
end;
if fldLevel <> level then begin
cfg := configTable[fldLevel];
fldLevel := level;
fldMaxLazyMatch := cfg.maxLazy;
fldGoodMatch := cfg.goodLength;
fldNiceMatch := cfg.niceLength;
fldMaxChainLength := cfg.maxChain;
end;
fldStrategy := strategy;
end;
function DefState.deflateSetDictionary(const dictionary: byte_Array1d; length: int): int;
var
idx: int;
len: int;
dif: int;
insh: int;
wMask: int;
hashMask: int;
hashShift: int;
windowBuf: byte_Array1d;
prevBuf: int_Array1d;
headBuf: int_Array1d;
begin
if (dictionary = nil) or (fldStatus <> INIT_STATE) then begin
result := STREAM_ERROR;
exit;
end;
len := length;
idx := 0;
fldStream.fldChecksum.update(dictionary, 0, length);
if len < MIN_MATCH then begin
result := OK;
exit;
end;
dif := fldWSize - MIN_LOOKAHEAD;
if len > dif then begin
len := dif;
idx := length - len;
end;
wMask := fldWMask;
hashMask := fldHashMask;
hashShift := fldHashShift;
windowBuf := fldWindowBuf;
prevBuf := fldPrevBuf;
headBuf := fldHeadBuf;
&Array.copyPrimitives(dictionary, idx, windowBuf, 0, len);
fldStrStart := len;
fldBlockStart := len;
insh := (((int(windowBuf[0]) and $ff) shl hashShift) xor (int(windowBuf[1]) and $ff)) and hashMask;
for idx := 0 to len - MIN_MATCH do begin
insh := ((insh shl hashShift) xor (int(windowBuf[idx + (MIN_MATCH - 1)]) and $ff)) and hashMask;
prevBuf[idx and wMask] := headBuf[insh];
headBuf[insh] := short(idx);
end;
fldInsh := insh;
result := OK;
end;
function DefState.deflate(flush: int): int;
var
adler: int;
header: int;
bState: int;
oldFlush: int;
levelFlags: int;
stream: ZStream;
begin
if (flush > FINISH) or (flush < 0) then begin
result := STREAM_ERROR;
exit;
end;
stream := fldStream;
if (stream.fldNextOutArray = nil) or ((stream.fldNextInArray = nil) and (stream.fldAvailableIn <> 0)) or ((fldStatus = FINISH_STATE) and (flush <> FINISH)) then begin
stream.fldMessage := errorMessages[NEED_DICT - STREAM_ERROR];
result := STREAM_ERROR;
exit;
end;
if stream.fldAvailableOut = 0 then begin
stream.fldMessage := errorMessages[NEED_DICT - BUF_ERROR];
result := BUF_ERROR;
exit;
end;
oldFlush := fldLastFlush;
fldLastFlush := flush;
if fldStatus = INIT_STATE then begin
if fldWrap = 2 then begin
getGZIPHeader().put(self);
fldStatus := BUSY_STATE;
stream.fldChecksum.reset();
end else begin
header := (Z_DEFLATED + ((fldWBits - 8) shl 4)) shl 8;
levelFlags := ((fldLevel - 1) and $ff) shr 1;
if levelFlags > 3 then levelFlags := 3;
header := header or (levelFlags shl 6);
if fldStrStart <> 0 then header := header or PRESET_DICT;
inc(header, 31 - (header mod 31));
fldStatus := BUSY_STATE;
putShortMSB(header);
if fldStrStart <> 0 then begin
adler := stream.fldChecksum.getValue();
putShortMSB(adler shr 16);
putShortMSB(adler);
end;
stream.fldChecksum.reset();
end;
end;
if fldPendingPos <> 0 then begin
stream.flushPending();
if stream.fldAvailableOut = 0 then begin
fldLastFlush := -1;
result := OK;
exit;
end;
end else
if (stream.fldAvailableIn = 0) and (flush <= oldFlush) and (flush <> FINISH) then begin
stream.fldMessage := errorMessages[NEED_DICT - BUF_ERROR];
result := BUF_ERROR;
exit;
end;
if (fldStatus = FINISH_STATE) and (stream.fldAvailableIn <> 0) then begin
stream.fldMessage := errorMessages[NEED_DICT - BUF_ERROR];
result := BUF_ERROR;
exit;
end;
if (stream.fldAvailableIn <> 0) or (fldLookahead <> 0) or ((flush <> NO_FLUSH) and (fldStatus <> FINISH_STATE)) then begin
bState := -1;
case configTable[fldLevel].func of
STORED:
bState := deflateStored(flush);
FAST:
bState := deflateFast(flush);
SLOW:
bState := deflateSlow(flush);
end;
if (bState = FINISH_STARTED) or (bState = FINISH_DONE) then begin
fldStatus := FINISH_STATE;
end;
if (bState = NEED_MORE) or (bState = FINISH_STARTED) then begin
if stream.fldAvailableOut = 0 then fldLastFlush := -1;
result := OK;
exit;
end;
if bState = BLOCK_DONE then begin
if flush = PARTIAL_FLUSH then begin
trAlign();
end else begin
trStoredBlock(0, 0, false);
if flush = FULL_FLUSH then begin
&Array.fillPrimitives(fldHeadBuf, 0, fldHashSize, 0);
end;
end;
stream.flushPending();
if stream.fldAvailableOut = 0 then begin
fldLastFlush := -1;
result := OK;
exit;
end;
end;
end;
if flush <> FINISH then begin
result := OK;
exit;
end;
if fldWrap <= 0 then begin
result := STREAM_END;
exit;
end;
adler := stream.fldChecksum.getValue();
if fldWrap = 2 then begin
putByte(adler);
putByte(adler shr 8);
putByte(adler shr 16);
putByte(adler shr 24);
putByte(int(stream.fldTotalIn));
putByte(int(stream.fldTotalIn) shr 8);
putByte(int(stream.fldTotalIn) shr 16);
putByte(int(stream.fldTotalIn) shr 24);
getGZIPHeader().setCRC(adler);
end else begin
putShortMSB(adler shr 16);
putShortMSB(adler);
end;
stream.flushPending();
if fldWrap > 0 then fldWrap := -fldWrap;
if fldPendingPos = 0 then begin
result := STREAM_END;
exit;
end;
result := OK;
end;
constructor DefState.create(stream: ZStream);
begin
inherited create();
fldWrap := 1;
fldDynamicLTree := &Array.newInt1d(HEAP_SIZE * 2);
fldDynamicDTree := &Array.newInt1d((2 * D_CODES + 1) * 2);
fldBlTree := &Array.newInt1d((2 * BL_CODES + 1) * 2);
fldBlCount := &Array.newInt1d(MAX_BITS + 1);
fldHeapBuf := &Array.newInt1d(2 * L_CODES + 1);
fldDepth := &Array.newByte1d(2 * L_CODES + 1);
fldLDesc := Tree.create();
fldDDesc := Tree.create();
fldBlDesc := Tree.create();
fldStream := stream;
end;
destructor DefState.destroy;
begin
fldLDesc.free();
fldDDesc.free();
fldBlDesc.free();
fldGHeader.free();
inherited destroy;
end;
{%endregion}
{%region InfState }
class procedure InfState.initialize();
begin
mark := [ 0, 0, -1, -1 ];
end;
class procedure InfState.finalize();
begin
mark := nil;
end;
procedure InfState.checksum(n, v: int);
var
idx: int;
buf: byte_Array1d;
begin
buf := fldCRCBuf;
for idx := 0 to n - 1 do begin
buf[idx] := byte(v);
v := v shr 8;
end;
fldStream.fldChecksum.update(buf, 0, n);
end;
function InfState.inflateReset(): int;
var
stream: ZStream;
iBlocks: InfBlocks;
begin
stream := fldStream;
iBlocks := fldBlocks;
if (stream = nil) or (iBlocks = nil) then begin
result := STREAM_ERROR;
exit;
end;
with stream do begin
fldTotalIn := 0;
fldTotalOut := 0;
fldMessage := '';
end;
fldMode := HEAD;
fldNeedBytes := -1;
iBlocks.reset(stream);
result := OK;
end;
function InfState.readBytes(n, r, f: int): int;
var
needBytes: int;
needCheck: int;
stream: ZStream;
begin
fldReadReturn := false;
stream := fldStream;
if fldNeedBytes = -1 then begin
fldNeedBytes := n;
fldNeedCheck := 0;
end;
needBytes := fldNeedBytes;
needCheck := fldNeedCheck;
while needBytes > 0 do begin
if stream.fldAvailableIn = 0 then begin
fldNeedCheck := needCheck;
fldReadReturn := true;
result := r;
exit;
end;
r := f;
dec(stream.fldAvailableIn);
inc(stream.fldTotalIn);
needCheck := needCheck or ((int(stream.fldNextInArray[stream.fldNextInIndex]) and $ff) shl int((n - needBytes) * 8));
inc(stream.fldNextInIndex);
dec(needBytes);
end;
if n = 2 then needCheck := needCheck and $ffff;
fldNeedCheck := needCheck;
fldNeedBytes := -1;
result := r;
end;
function InfState.readBytes(r, f: int): int;
var
needCheck: int;
tmpString: ByteArrayOutputStream;
stream: ZStream;
begin
fldReadReturn := false;
needCheck := fldNeedCheck;
tmpString := fldTmpString;
stream := fldStream;
while needCheck <> 0 do begin
if stream.fldAvailableIn = 0 then begin
fldReadReturn := true;
result := r;
exit;
end;
r := f;
dec(stream.fldAvailableIn);
inc(stream.fldTotalIn);
tmpString.write(stream.fldNextInArray, stream.fldNextInIndex, 1);
stream.fldChecksum.update(stream.fldNextInArray, stream.fldNextInIndex, 1);
inc(stream.fldNextInIndex);
dec(needCheck);
end;
fldNeedCheck := needCheck;
result := r;
end;
function InfState.readString(r, f: int): int;
var
b: int;
tmpString: ByteArrayOutputStream;
stream: ZStream;
begin
fldReadReturn := false;
tmpString := fldTmpString;
stream := fldStream;
b := 0;
repeat
if stream.fldAvailableIn = 0 then begin
fldReadReturn := true;
result := r;
exit;
end;
r := f;
dec(stream.fldAvailableIn);
inc(stream.fldTotalIn);
b := stream.fldNextInArray[stream.fldNextInIndex];
if b <> 0 then tmpString.write(b);
stream.fldChecksum.update(stream.fldNextInArray, stream.fldNextInIndex, 1);
inc(stream.fldNextInIndex);
until b = 0;
result := r;
end;
function InfState.inflateEnd(): int;
var
iBlocks: InfBlocks;
begin
iBlocks := fldBlocks;
if iBlocks <> nil then iBlocks.reset(fldStream);
result := OK;
end;
function InfState.inflateBegin(wbits: int): int;
var
stream: ZStream;
begin
stream := fldStream;
stream.fldMessage := '';
fldBlocks.free();
fldBlocks := nil;
fldWrap := 0;
if wbits < 0 then begin
wbits := -wbits;
end else begin
fldWrap := (wbits shr 4) + 1;
if wbits < 48 then wbits := wbits and $0f;
end;
if (wbits < 8) or (wbits > 15) then begin
inflateEnd();
result := STREAM_ERROR;
exit;
end;
fldWBits := wbits;
fldBlocks := InfBlocks.create(stream, 1 shl wbits);
inflateReset();
result := OK;
end;
function InfState.inflate(f: int): int;
var
r: int;
b: int;
needCheck: int;
abyte: byte_Array1d;
stream: ZStream;
iBlocks: InfBlocks;
gHeader: GZIPHeader;
tmpString: ByteArrayOutputStream;
begin
stream := fldStream;
if (stream = nil) or (stream.fldNextInArray = nil) then begin
if (f = FINISH) and (fldMode = HEAD) then begin
result := OK;
exit;
end;
result := STREAM_ERROR;
exit;
end;
gHeader := fldGHeader;
tmpString := fldTmpString;
needCheck := fldNeedCheck;
if f = FINISH then begin
f := BUF_ERROR;
end else begin
f := OK;
end;
r := BUF_ERROR;
repeat
case fldMode of
HEAD: begin
if fldWrap = 0 then begin
fldMode := BLOCKS;
continue;
end;
r := readBytes(2, r, f);
if fldReadReturn then begin
result := r;
exit;
end;
needCheck := fldNeedCheck;
if ((fldWrap and $02) <> 0) and (needCheck = $8b1f) then begin
stream.fldChecksum.free();
stream.fldChecksum := CRC32.create();
checksum(2, needCheck);
if gHeader = nil then begin
gHeader := GZIPHeader.create();
fldGHeader := gHeader;
end;
fldMode := FLAGS;
continue;
end;
fldFlags := 0;
fldMethod := needCheck and $ff;
b := (needCheck shr 8) and $ff;
if ((fldWrap and $01) = 0) or ((((fldMethod shl 8) + b) mod 31) <> 0) then begin
fldMode := BAD;
stream.fldMessage := 'incorrect header check';
continue;
end;
if (fldMethod and $0f) <> Z_DEFLATED then begin
fldMode := BAD;
stream.fldMessage := 'unknown compression method';
continue;
end;
if CoInt.sar(fldMethod, 4) + 8 > fldWBits then begin
fldMode := BAD;
stream.fldMessage := 'invalid window size';
continue;
end;
stream.fldChecksum.free();
stream.fldChecksum := Adler32.create();
if (b and PRESET_DICT) = 0 then begin
fldMode := BLOCKS;
continue;
end;
fldMode := DICT4;
end;
DICT4: begin
if stream.fldAvailableIn = 0 then begin
result := r;
exit;
end;
r := f;
dec(stream.fldAvailableIn);
inc(stream.fldTotalIn);
needCheck := (int(stream.fldNextInArray[stream.fldNextInIndex]) and $ff) shl 24;
fldNeedCheck := needCheck;
inc(stream.fldNextInIndex);
fldMode := DICT3;
end;
DICT3: begin
if stream.fldAvailableIn = 0 then begin
result := r;
exit;
end;
r := f;
dec(stream.fldAvailableIn);
inc(stream.fldTotalIn);
needCheck := needCheck or ((int(stream.fldNextInArray[stream.fldNextInIndex]) and $ff) shl 16);
fldNeedCheck := needCheck;
inc(stream.fldNextInIndex);
fldMode := DICT2;
end;
DICT2: begin
if stream.fldAvailableIn = 0 then begin
result := r;
exit;
end;
r := f;
dec(stream.fldAvailableIn);
inc(stream.fldTotalIn);
needCheck := needCheck or ((int(stream.fldNextInArray[stream.fldNextInIndex]) and $ff) shl 8);
fldNeedCheck := needCheck;
inc(stream.fldNextInIndex);
fldMode := DICT1;
end;
DICT1: begin
if stream.fldAvailableIn = 0 then begin
result := r;
exit;
end;
r := f;
dec(stream.fldAvailableIn);
inc(stream.fldTotalIn);
needCheck := needCheck or (int(stream.fldNextInArray[stream.fldNextInIndex]) and $ff);
fldNeedCheck := needCheck;
inc(stream.fldNextInIndex);
stream.fldChecksum.reset(needCheck);
fldMode := DICT0;
result := NEED_DICT;
exit;
end;
DICT0: begin
fldMode := BAD;
stream.fldMessage := 'need dictionary';
fldMarker := 0;
result := STREAM_ERROR;
exit;
end;
BLOCKS: begin
iBlocks := fldBlocks;
if iBlocks = nil then begin
result := STREAM_ERROR;
exit;
end;
r := iBlocks.proc(stream, r);
if r = DATA_ERROR then begin
fldMode := BAD;
fldMarker := 0;
continue;
end;
if r = OK then r := f;
if r <> STREAM_END then begin
result := r;
exit;
end;
r := f;
fldWas := stream.fldChecksum.getValue();
iBlocks.reset(stream);
if fldWrap = 0 then begin
fldMode := DONE;
continue;
end;
fldMode := CHECK4;
end;
CHECK4: begin
if stream.fldAvailableIn = 0 then begin
result := r;
exit;
end;
r := f;
dec(stream.fldAvailableIn);
inc(stream.fldTotalIn);
needCheck := (int(stream.fldNextInArray[stream.fldNextInIndex]) and $ff) shl 24;
fldNeedCheck := needCheck;
inc(stream.fldNextInIndex);
fldMode := CHECK3;
end;
CHECK3: begin
if stream.fldAvailableIn = 0 then begin
result := r;
exit;
end;
r := f;
dec(stream.fldAvailableIn);
inc(stream.fldTotalIn);
needCheck := needCheck or ((int(stream.fldNextInArray[stream.fldNextInIndex]) and $ff) shl 16);
fldNeedCheck := needCheck;
inc(stream.fldNextInIndex);
fldMode := CHECK2;
end;
CHECK2: begin
if stream.fldAvailableIn = 0 then begin
result := r;
exit;
end;
r := f;
dec(stream.fldAvailableIn);
inc(stream.fldTotalIn);
needCheck := needCheck or ((int(stream.fldNextInArray[stream.fldNextInIndex]) and $ff) shl 8);
fldNeedCheck := needCheck;
inc(stream.fldNextInIndex);
fldMode := CHECK1;
end;
CHECK1: begin
if stream.fldAvailableIn = 0 then begin
result := r;
exit;
end;
r := f;
dec(stream.fldAvailableIn);
inc(stream.fldTotalIn);
needCheck := needCheck or (int(stream.fldNextInArray[stream.fldNextInIndex]) and $ff);
inc(stream.fldNextInIndex);
if fldFlags <> 0 then needCheck := CoInt.byteSwap(needCheck);
if fldWas <> needCheck then begin
stream.fldMessage := 'incorrect data check';
end else
if (fldFlags <> 0) and (gHeader <> nil) then begin
gHeader.fldCRC := needCheck;
end;
fldNeedCheck := needCheck;
fldMode := LENGTH;
end;
LENGTH: begin
if (fldWrap <> 0) and (fldFlags <> 0) then begin
r := readBytes(4, r, f);
if fldReadReturn then begin
result := r;
exit;
end;
if stream.fldMessage = 'incorrect data check' then begin
fldMode := BAD;
fldMarker := 5;
continue;
end;
if fldNeedCheck <> int(stream.fldTotalOut) then begin
stream.fldMessage := 'incorrect length check';
fldMode := BAD;
continue;
end;
stream.fldMessage := '';
end else begin
if stream.fldMessage = 'incorrect data check' then begin
fldMode := BAD;
fldMarker := 5;
continue;
end;
end;
fldMode := DONE;
end;
DONE: begin
result := STREAM_END;
exit;
end;
BAD: begin
result := DATA_ERROR;
exit;
end;
FLAGS: begin
r := readBytes(2, r, f);
if fldReadReturn then begin
result := r;
exit;
end;
needCheck := fldNeedCheck;
fldFlags := needCheck and $ffff;
if (fldFlags and $ff) <> Z_DEFLATED then begin
stream.fldMessage := 'unknown compression method';
fldMode := BAD;
continue;
end;
if (fldFlags and $e000) <> 0 then begin
stream.fldMessage := 'unknown header flags set';
fldMode := BAD;
continue;
end;
if (fldFlags and $0200) <> 0 then checksum(2, needCheck);
fldMode := TIME;
end;
TIME: begin
r := readBytes(4, r, f);
if fldReadReturn then begin
result := r;
exit;
end;
needCheck := fldNeedCheck;
{ if gHeader <> nil then begin
gHeader.fldTime := needCheck;
end; }
if (fldFlags and $0200) <> 0 then checksum(4, needCheck);
fldMode := OS;
end;
OS: begin
r := readBytes(2, r, f);
if fldReadReturn then begin
result := r;
exit;
end;
needCheck := fldNeedCheck;
if gHeader <> nil then begin
{ gHeader.fldXFlags := needCheck and $ff; }
gHeader.fldOS := (needCheck shr 8) and $ff;
end;
if (fldFlags and $0200) <> 0 then checksum(2, needCheck);
fldMode := EXLEN;
end;
EXLEN: begin
if (fldFlags and $0400) <> 0 then begin
r := readBytes(2, r, f);
if fldReadReturn then begin
result := r;
exit;
end;
needCheck := fldNeedCheck;
if gHeader <> nil then gHeader.fldExtra := &Array.newByte1d(needCheck and $ffff);
if (fldFlags and $0200) <> 0 then checksum(2, needCheck);
end else
if gHeader <> nil then gHeader.fldExtra := nil;
fldMode := EXTRA;
end;
EXTRA: begin
if (fldFlags and $0400) <> 0 then begin
r := readBytes(r, f);
if fldReadReturn then begin
result := r;
exit;
end;
if gHeader <> nil then begin
abyte := tmpString.toByteArray();
tmpString.seek(0, SeekFrom.sfBegin);
tmpString.truncate();
if system.length(abyte) = system.length(gHeader.fldExtra) then begin
&Array.copyPrimitives(abyte, 0, gHeader.fldExtra, 0, system.length(abyte));
end else begin
stream.fldMessage := 'bad extra field length';
fldMode := BAD;
continue;
end;
end;
end else
if gHeader <> nil then gHeader.fldExtra := nil;
fldMode := NAME;
end;
NAME: begin
if (fldFlags and $0800) <> 0 then begin
r := readString(r, f);
if fldReadReturn then begin
result := r;
exit;
end;
if gHeader <> nil then gHeader.fldName := tmpString.toByteArray();
tmpString.seek(0, SeekFrom.sfBegin);
tmpString.truncate();
end else
if gHeader <> nil then gHeader.fldName := nil;
fldMode := COMMENT;
end;
COMMENT: begin
if (fldFlags and $1000) <> 0 then begin
r := readString(r, f);
if fldReadReturn then begin
result := r;
exit;
end;
if gHeader <> nil then gHeader.fldComment := tmpString.toByteArray();
tmpString.seek(0, SeekFrom.sfBegin);
tmpString.truncate();
end else
if gHeader <> nil then gHeader.fldComment := nil;
fldMode := HCRC;
end;
HCRC: begin
if (fldFlags and $0200) <> 0 then begin
r := readBytes(2, r, f);
if fldReadReturn then begin
result := r;
exit;
end;
needCheck := fldNeedCheck;
{ if gHeader <> nil then begin
gHeader.fldHCRC := needCheck and $ffff;
end; }
if needCheck <> (stream.fldChecksum.getValue() and $ffff) then begin
fldMode := BAD;
stream.fldMessage := 'header crc mismatch';
fldMarker := 5;
continue;
end;
end;
stream.fldChecksum.free();
stream.fldChecksum := CRC32.create();
fldMode := BLOCKS;
end;
else
result := STREAM_ERROR;
exit;
end;
until false;
end;
function InfState.inflateSetDictionary(const dictionary: byte_Array1d; length: int): int;
var
idx: int;
len: int;
need: int;
wbits: int;
stream: ZStream;
adler: Checksum32;
iBlocks: InfBlocks;
begin
stream := fldStream;
iBlocks := fldBlocks;
if (stream = nil) or (iBlocks = nil) or ((fldMode <> DICT0) and (fldWrap <> 0)) then begin
result := STREAM_ERROR;
exit;
end;
idx := 0;
len := length;
adler := stream.fldChecksum;
if fldMode = DICT0 then begin
need := adler.getValue();
adler.reset();
adler.update(dictionary, 0, length);
if adler.getValue() <> need then begin
result := DATA_ERROR;
exit;
end;
end;
adler.reset();
wbits := 1 shl fldWBits;
if len >= wbits then begin
len := wbits - 1;
idx := length - len;
end;
iBlocks.setDictionary(dictionary, idx, len);
fldMode := BLOCKS;
result := OK;
end;
function InfState.inflateSync(): int;
var
b: byte;
n: int;
p: int;
m: int;
r: long;
w: long;
nextInArray: byte_Array1d;
stream: ZStream;
begin
stream := fldStream;
if stream = nil then begin
result := STREAM_ERROR;
exit;
end;
if fldMode <> BAD then begin
fldMode := BAD;
fldMarker := 0;
end;
n := stream.fldAvailableIn;
if n = 0 then begin
result := BUF_ERROR;
exit;
end;
p := stream.fldNextInIndex;
m := fldMarker;
nextInArray := stream.fldNextInArray;
while (n <> 0) and (m < 4) do begin
b := nextInArray[p];
if b = mark[m] then begin
inc(m);
end else
if b <> 0 then begin
m := 0;
end else begin
m := 4 - m;
end;
inc(p);
dec(n);
end;
inc(stream.fldTotalIn, long(p) - long(stream.fldNextInIndex));
stream.fldNextInIndex := p;
stream.fldAvailableIn := n;
fldMarker := m;
if m <> 4 then begin
result := DATA_ERROR;
exit;
end;
r := stream.fldTotalIn;
w := stream.fldTotalOut;
inflateReset();
stream.fldTotalIn := r;
stream.fldTotalOut := w;
fldMode := BLOCKS;
result := OK;
end;
function InfState.inflateSyncPoint(): int;
var
iBlocks: InfBlocks;
begin
iBlocks := fldBlocks;
if (fldStream = nil) or (iBlocks = nil) then begin
result := STREAM_ERROR;
exit;
end;
if iBlocks.syncPoint() then begin
result := 1;
exit;
end;
result := 0;
end;
constructor InfState.create(stream: ZStream);
begin
inherited create();
fldNeedBytes := -1;
fldWas := -1;
fldCRCBuf := &Array.newByte1d(4);
fldTmpString := ByteArrayOutputStream.create();
fldStream := stream;
end;
destructor InfState.destroy;
begin
fldTmpString.free();
fldBlocks.free();
fldGHeader.free();
inherited destroy;
end;
{%endregion}
{%region InfBlocks }
class procedure InfBlocks.initialize();
begin
inflateMask := [
$0000, $0001, $0003, $0007, $000f, $001f, $003f, $007f, $00ff, $01ff,
$03ff, $07ff, $0fff, $1fff, $3fff, $7fff, $ffff
];
border := [
16, 17, 18, 0, 8, 7, 9, 6, 10, 5,
11, 4, 12, 3, 13, 2, 14, 1, 15
];
end;
class procedure InfBlocks.finalize();
begin
border := nil;
inflateMask := nil;
end;
procedure InfBlocks.proc1();
var
bl: int_Array1d;
bd: int_Array1d;
tl: int_Array2d;
td: int_Array2d;
begin
bl := &Array.newInt1d(1);
bd := &Array.newInt1d(1);
tl := &Array.newInt2d(1);
td := &Array.newInt2d(1);
InfTree.inflateTreesFixed(bl, bd, tl, td);
fldCodes.init(bl[0], bd[0], tl[0], 0, td[0], 0);
end;
procedure InfBlocks.reset(stream: ZStream);
begin
fldMode := &TYPE;
fldBitK := 0;
fldBitB := 0;
fldRead := 0;
fldWrite := 0;
if fldCheck then stream.fldChecksum.reset();
end;
procedure InfBlocks.setDictionary(const d: byte_Array1d; start, n: int);
begin
&Array.copyPrimitives(d, start, fldWindow, 0, n);
fldRead := n;
fldWrite := n;
end;
procedure InfBlocks.update(stream: ZStream; b, k, n, p, q: int);
begin
fldBitB := b;
fldBitK := k;
stream.fldAvailableIn := n;
inc(stream.fldTotalIn, long(p) - long(stream.fldNextInIndex));
stream.fldNextInIndex := p;
fldWrite := q;
end;
function InfBlocks.syncPoint(): boolean;
begin
result := fldMode = LENS;
end;
function InfBlocks.proc(stream: ZStream; r: int): int;
var
t: int;
b: int;
k: int;
p: int;
n: int;
q: int;
m: int;
i: int;
j: int;
c: int;
index: int;
bb: int_Array1d;
bl: int_Array1d;
bd: int_Array1d;
tb: int_Array1d;
tl: int_Array1d;
td: int_Array1d;
blens: int_Array1d;
hufts: int_Array1d;
iCodes: InfCodes;
iTree: InfTree;
begin
p := stream.fldNextInIndex;
n := stream.fldAvailableIn;
b := fldBitB;
k := fldBitK;
q := fldWrite;
bb := fldBB;
tb := fldTB;
hufts := fldHufts;
iCodes := fldCodes;
iTree := fldTree;
if q < fldRead then begin
m := fldRead - q - 1;
end else begin
m := fldEnd - q;
end;
repeat
case fldMode of
&TYPE: begin
while k < 3 do begin
if n = 0 then begin
update(stream, b, k, n, p, q);
result := inflateFlush(stream, r);
exit;
end;
r := OK;
dec(n);
b := b or ((int(stream.fldNextInArray[p]) and $ff) shl k);
inc(p);
inc(k, 8);
end;
t := b and $07;
fldLast := t and $01;
case t shr 1 of
0: begin
b := b shr 3;
dec(k, 3);
t := k and $07;
b := b shr t;
dec(k, t);
fldMode := LENS;
end;
1: begin
proc1();
b := b shr 3;
dec(k, 3);
fldMode := CODES;
end;
2: begin
b := b shr 3;
dec(k, 3);
fldMode := TABLE;
end;
3: begin
b := b shr 3;
dec(k, 3);
fldMode := BAD;
stream.fldMessage := 'invalid block type';
r := DATA_ERROR;
update(stream, b, k, n, p, q);
result := inflateFlush(stream, r);
exit;
end;
end;
end;
LENS: begin
while k < 32 do begin
if n = 0 then begin
update(stream, b, k, n, p, q);
result := inflateFlush(stream, r);
exit;
end;
r := OK;
dec(n);
b := b or ((int(stream.fldNextInArray[p]) and $ff) shl k);
inc(p);
inc(k, 8);
end;
if (((not b) shr 16) and $ffff) <> (b and $ffff) then begin
fldMode := BAD;
stream.fldMessage := 'invalid stored block lengths';
r := DATA_ERROR;
update(stream, b, k, n, p, q);
result := inflateFlush(stream, r);
exit;
end;
fldLeft := b and $ffff;
b := 0;
k := 0;
if fldLeft <> 0 then begin
fldMode := STORED;
end else
if fldLast <> 0 then begin
fldMode := DRY;
end else begin
fldMode := &TYPE;
end;
end;
STORED: begin
if n = 0 then begin
update(stream, b, k, n, p, q);
result := inflateFlush(stream, r);
exit;
end;
if m = 0 then begin
if (q = fldEnd) and (fldRead <> 0) then begin
q := 0;
if q < fldRead then begin
m := fldRead - q - 1;
end else begin
m := fldEnd - q;
end;
end;
if m = 0 then begin
fldWrite := q;
r := inflateFlush(stream, r);
q := fldWrite;
if q < fldRead then begin
m := fldRead - q - 1;
end else begin
m := fldEnd - q;
end;
if (q = fldEnd) and (fldRead <> 0) then begin
q := 0;
if q < fldRead then begin
m := fldRead - q - 1;
end else begin
m := fldEnd - q;
end;
end;
if m = 0 then begin
update(stream, b, k, n, p, q);
result := inflateFlush(stream, r);
exit;
end;
end;
end;
r := OK;
t := fldLeft;
if t > n then t := n;
if t > m then t := m;
&Array.copyPrimitives(stream.fldNextInArray, p, fldWindow, q, t);
inc(p, t);
dec(n, t);
inc(q, t);
dec(m, t);
dec(fldLeft, t);
if fldLeft <> 0 then continue;
if fldLast <> 0 then begin
fldMode := DRY;
end else begin
fldMode := &TYPE;
end;
end;
TABLE: begin
while k < 14 do begin
if n = 0 then begin
update(stream, b, k, n, p, q);
result := inflateFlush(stream, r);
exit;
end;
r := OK;
dec(n);
b := b or ((int(stream.fldNextInArray[p]) and $ff) shl k);
inc(p);
inc(k, 8);
end;
t := b and $3fff;
fldTable := t;
if ((t and $1f) > 29) or (((t shr 5) and $1f) > 29) then begin
fldMode := BAD;
stream.fldMessage := 'too many length or distance symbols';
r := DATA_ERROR;
update(stream, b, k, n, p, q);
result := inflateFlush(stream, r);
exit;
end;
t := (t and $1f) + ((t shr 5) and $1f) + 258;
blens := fldBlens;
if (blens = nil) or (system.length(blens) < t) then begin
fldBlens := &Array.newInt1d(t);
end else begin
&Array.fillPrimitives(blens, 0, t, 0);
end;
b := b shr 14;
dec(k, 14);
fldIndex := 0;
fldMode := BTREE;
end;
BTREE: begin
blens := fldBlens;
while fldIndex < (fldTable shr 10) + 4 do begin
while k < 3 do begin
if n = 0 then begin
update(stream, b, k, n, p, q);
result := inflateFlush(stream, r);
exit;
end;
r := OK;
dec(n);
b := b or ((int(stream.fldNextInArray[p]) and $ff) shl k);
inc(p);
inc(k, 8);
end;
blens[border[fldIndex]] := b and $07;
inc(fldIndex);
b := b shr 3;
dec(k, 3);
end;
index := fldIndex;
while index < 19 do begin
blens[border[index]] := 0;
inc(index);
end;
fldIndex := index;
bb[0] := 7;
t := iTree.inflateTreesBits(blens, bb, tb, hufts, stream);
if t <> OK then begin
r := t;
if r = DATA_ERROR then begin
blens := nil;
fldMode := BAD;
end;
update(stream, b, k, n, p, q);
result := inflateFlush(stream, r);
exit;
end;
fldIndex := 0;
fldMode := DTREE;
end;
DTREE: begin
blens := fldBlens;
repeat
t := fldTable;
if fldIndex >= (t and $1f) + ((t shr 5) and $1f) + 258 then break;
t := bb[0];
while k < t do begin
if n = 0 then begin
update(stream, b, k, n, p, q);
result := inflateFlush(stream, r);
exit;
end;
r := OK;
dec(n);
b := b or ((int(stream.fldNextInArray[p]) and $ff) shl k);
inc(p);
inc(k, 8);
end;
t := hufts[(tb[0] + (b and inflateMask[t])) * 3 + 1];
c := hufts[(tb[0] + (b and inflateMask[t])) * 3 + 2];
if c < 16 then begin
b := b shr t;
dec(k, t);
blens[fldIndex] := c;
inc(fldIndex);
end else begin
if c = 18 then begin
i := 7;
j := 11;
end else begin
i := c - 14;
j := 3;
end;
while k < t + i do begin
if n = 0 then begin
update(stream, b, k, n, p, q);
result := inflateFlush(stream, r);
exit;
end;
r := OK;
dec(n);
b := b or ((int(stream.fldNextInArray[p]) and $ff) shl k);
inc(p);
inc(k, 8);
end;
b := b shr t;
dec(k, t);
inc(j, b and inflateMask[i]);
b := b shr i;
dec(k, i);
i := fldIndex;
t := fldTable;
if (i + j > (t and $1f) + ((t shr 5) and $1f) + 258) or ((c = 16) and (i < 1)) then begin
fldBlens := nil;
fldMode := BAD;
stream.fldMessage := 'invalid bit length repeat';
r := DATA_ERROR;
update(stream, b, k, n, p, q);
result := inflateFlush(stream, r);
exit;
end;
if c = 16 then begin
c := blens[i - 1];
end else begin
c := 0;
end;
&Array.fillPrimitives(blens, i, j, c);
fldIndex := i + j;
end;
until false;
tb[0] := -1;
bl := &Array.newInt1d(1);
bd := &Array.newInt1d(1);
tl := &Array.newInt1d(1);
td := &Array.newInt1d(1);
bl[0] := 9;
bd[0] := 6;
t := fldTable;
t := iTree.inflateTreesDynamic((t and $1f) + 257, ((t shr 5) and $1f) + 1, blens, bl, bd, tl, td, hufts, stream);
if t <> OK then begin
if t = DATA_ERROR then begin
fldBlens := nil;
fldMode := BAD;
end;
r := t;
update(stream, b, k, n, p, q);
result := inflateFlush(stream, r);
exit;
end;
iCodes.init(bl[0], bd[0], hufts, tl[0], hufts, td[0]);
fldMode := CODES;
end;
CODES: begin
update(stream, b, k, n, p, q);
r := iCodes.proc(self, stream, r);
if r <> STREAM_END then begin
result := inflateFlush(stream, r);
exit;
end;
r := OK;
p := stream.fldNextInIndex;
n := stream.fldAvailableIn;
b := fldBitB;
k := fldBitK;
q := fldWrite;
if q < fldRead then begin
m := fldRead - q - 1;
end else begin
m := fldEnd - q;
end;
if fldLast = 0 then begin
fldMode := &TYPE;
end else begin
fldMode := DRY;
end;
end;
DRY: begin
fldWrite := q;
r := inflateFlush(stream, r);
q := fldWrite;
if q < fldRead then begin
m := fldRead - q - 1;
end else begin
m := fldEnd - q;
end;
if fldRead <> fldWrite then begin
update(stream, b, k, n, p, q);
result := inflateFlush(stream, r);
exit;
end;
fldMode := DONE;
end;
DONE: begin
r := STREAM_END;
update(stream, b, k, n, p, q);
result := inflateFlush(stream, r);
exit;
end;
BAD: begin
r := DATA_ERROR;
update(stream, b, k, n, p, q);
result := inflateFlush(stream, r);
exit;
end;
else
r := STREAM_ERROR;
update(stream, b, k, n, p, q);
result := inflateFlush(stream, r);
exit;
end;
until false;
end;
function InfBlocks.inflateFlush(stream: ZStream; r: int): int;
var
n: int;
p: int;
q: int;
window: byte_Array1d;
begin
p := stream.fldNextOutIndex;
q := fldRead;
if q <= fldWrite then begin
n := fldWrite - q;
end else begin
n := fldEnd - q;
end;
if n > stream.fldAvailableOut then n := stream.fldAvailableOut;
if (n <> 0) and (r = BUF_ERROR) then r := OK;
dec(stream.fldAvailableOut, n);
inc(stream.fldTotalOut, long(n));
window := fldWindow;
if fldCheck then stream.fldChecksum.update(window, q, n);
&Array.copyPrimitives(window, q, stream.fldNextOutArray, p, n);
inc(p, n);
inc(q, n);
if q = fldEnd then begin
q := 0;
if fldWrite = fldEnd then fldWrite := 0;
n := fldWrite - q;
if n > stream.fldAvailableOut then n := stream.fldAvailableOut;
if (n <> 0) and (r = BUF_ERROR) then r := OK;
dec(stream.fldAvailableOut, n);
inc(stream.fldTotalOut, long(n));
if fldCheck then stream.fldChecksum.update(window, q, n);
&Array.copyPrimitives(window, q, stream.fldNextOutArray, p, n);
inc(p, n);
inc(q, n);
end;
stream.fldNextOutIndex := p;
fldRead := q;
result := r;
end;
constructor InfBlocks.create(stream: ZStream; w: int);
begin
inherited create();
fldEnd := w;
fldWindow := &Array.newByte1d(w);
fldCheck := InfState(stream.fldInflateState).fldWrap <> 0;
fldMode := &TYPE;
fldBB := &Array.newInt1d(1);
fldTB := &Array.newInt1d(1);
fldHufts := &Array.newInt1d(MANY * 3);
fldCodes := InfCodes.create();
fldTree := InfTree.create();
reset(stream);
end;
destructor InfBlocks.destroy;
begin
fldTree.free();
fldCodes.free();
inherited destroy;
end;
{%endregion}
{%region InfCodes }
class procedure InfCodes.initialize();
begin
inflateMask := [
$00000000, $00000001, $00000003, $00000007, $0000000f,
$0000001f, $0000003f, $0000007f, $000000ff, $000001ff,
$000003ff, $000007ff, $00000fff, $00001fff, $00003fff,
$00007fff, $0000ffff
];
end;
class procedure InfCodes.finalize();
begin
inflateMask := nil;
end;
function InfCodes.inflateFast(bl, bd: int; const tlArray: int_Array1d; tlIndex: int; const tdArray: int_Array1d; tdIndex: int; blocks: InfBlocks; stream: ZStream): int;
var
t: int;
e: int;
b: int;
k: int;
p: int;
n: int;
q: int;
m: int;
c: int;
d: int;
r: int;
ml: int;
md: int;
&end: int;
tpIndexBase: int;
tpIndexPTM3: int;
window: byte_Array1d;
tpArray: int_Array1d;
begin
p := stream.fldNextInIndex;
n := stream.fldAvailableIn;
b := blocks.fldBitB;
k := blocks.fldBitK;
q := blocks.fldWrite;
if q < blocks.fldRead then begin
m := blocks.fldRead - q - 1;
end else begin
m := blocks.fldEnd - q;
end;
ml := inflateMask[bl];
md := inflateMask[bd];
window := blocks.fldWindow;
repeat
while k < 20 do begin
dec(n);
b := b or ((int(stream.fldNextInArray[p]) and $ff) shl k);
inc(p);
inc(k, 8);
end;
t := b and ml;
tpArray := tlArray;
tpIndexBase := tlIndex;
tpIndexPTM3 := (tpIndexBase + t) * 3;
e := tpArray[tpIndexPTM3];
if e = 0 then begin
b := CoInt.sar(b, tpArray[tpIndexPTM3 + 1]);
dec(k, tpArray[tpIndexPTM3 + 1]);
window[q] := byte(tpArray[tpIndexPTM3 + 2]);
inc(q);
dec(m);
continue;
end;
repeat
b := CoInt.sar(b, tpArray[tpIndexPTM3 + 1]);
dec(k, tpArray[tpIndexPTM3 + 1]);
if (e and $10) <> 0 then begin
e := e and $f;
c := tpArray[tpIndexPTM3 + 2] + (b and inflateMask[e]);
b := CoInt.sar(b, e);
dec(k, e);
while k < 15 do begin
dec(n);
b := b or ((int(stream.fldNextInArray[p]) and $ff) shl k);
inc(p);
inc(k, 8);
end;
t := b and md;
tpArray := tdArray;
tpIndexBase := tdIndex;
tpIndexPTM3 := (tpIndexBase + t) * 3;
e := tpArray[tpIndexPTM3];
repeat
b := CoInt.sar(b, tpArray[tpIndexPTM3 + 1]);
dec(k, tpArray[tpIndexPTM3 + 1]);
if (e and $10) <> 0 then begin
e := e and $f;
while k < e do begin
dec(n);
b := b or ((int(stream.fldNextInArray[p]) and $ff) shl k);
inc(p);
inc(k, 8);
end;
d := tpArray[tpIndexPTM3 + 2] + (b and inflateMask[e]);
b := CoInt.sar(b, e);
dec(k, e);
dec(m, c);
if q >= d then begin
r := q - d;
if d = 1 then begin
window[q] := window[r];
inc(q);
inc(r);
window[q] := window[r];
inc(q);
inc(r);
dec(c, 2);
end else begin
&Array.copyPrimitives(window, r, window, q, 2);
inc(q, 2);
inc(r, 2);
dec(c, 2);
end;
end else begin
r := q - d;
&end := blocks.fldEnd;
repeat
inc(r, &end);
until r >= 0;
e := &end - r;
if c > e then begin
dec(c, e);
if (q - r <= 0) or (q - r >= e) then begin
&Array.copyPrimitives(window, r, window, q, e);
inc(q, e);
inc(r, e);
e := 0;
end else repeat
window[q] := window[r];
inc(q);
inc(r);
dec(e);
until e = 0;
r := 0;
end;
end;
if (q - r <= 0) and (q - r >= c) then begin
&Array.copyPrimitives(window, r, window, q, c);
inc(q, c);
inc(r, c);
c := 0;
break;
end;
repeat
window[q] := window[r];
inc(q);
inc(r);
dec(c);
until c = 0;
break;
end;
if (e and $40) <> 0 then begin
stream.fldMessage := 'invalid distance code';
c := stream.fldAvailableIn - n;
if CoInt.sar(k, 3) < c then c := CoInt.sar(k, 3);
inc(n, c);
dec(p, c);
dec(k, c shl 3);
blocks.update(stream, b, k, n, p, q);
result := DATA_ERROR;
exit;
end;
inc(t, tpArray[tpIndexPTM3 + 2] + (b and inflateMask[e]));
tpIndexPTM3 := (tpIndexBase + t) * 3;
e := tpArray[tpIndexPTM3];
until false;
break;
end;
if (e and $40) <> 0 then begin
if (e and $20) <> 0 then begin
c := stream.fldAvailableIn - n;
if CoInt.sar(k, 3) < c then c := CoInt.sar(k, 3);
inc(n, c);
dec(p, c);
dec(k, c shl 3);
blocks.update(stream, b, k, n, p, q);
result := STREAM_END;
exit;
end;
stream.fldMessage := 'invalid literal/length code';
c := stream.fldAvailableIn - n;
if CoInt.sar(k, 3) < c then c := CoInt.sar(k, 3);
inc(n, c);
dec(p, c);
dec(k, c shl 3);
blocks.update(stream, b, k, n, p, q);
result := DATA_ERROR;
exit;
end;
inc(t, tpArray[tpIndexPTM3 + 2] + (b and inflateMask[e]));
tpIndexPTM3 := (tpIndexBase + t) * 3;
e := tpArray[tpIndexPTM3];
if e = 0 then begin
b := CoInt.sar(b, tpArray[tpIndexPTM3 + 1]);
dec(k, tpArray[tpIndexPTM3 + 1]);
window[q] := byte(tpArray[tpIndexPTM3 + 2]);
inc(q);
dec(m);
break;
end;
until false;
until (m < 258) or (n < 10);
c := stream.fldAvailableIn - n;
if CoInt.sar(k, 3) < c then c := COInt.sar(k, 3);
inc(n, c);
dec(p, c);
dec(k, c shl 3);
blocks.update(stream, b, k, n, p, q);
result := OK;
end;
procedure InfCodes.init(bl, bd: int; const tlArray: int_Array1d; tlIndex: int; const tdArray: int_Array1d; tdIndex: int);
begin
fldMode := START;
fldLBits := byte(bl);
fldDBits := byte(bd);
fldLTreeArray := tlArray;
fldLTreeIndex := tlIndex;
fldDTreeArray := tdArray;
fldDTreeIndex := tdIndex;
fldTreeArray := nil;
end;
function InfCodes.proc(blocks: InfBlocks; stream: ZStream; r: int): int;
var
j: int;
e: int;
b: int;
k: int;
p: int;
n: int;
q: int;
m: int;
f: int;
bEnd: int;
tIndex: int;
window: byte_Array1d;
tArray: int_Array1d;
begin
p := stream.fldNextInIndex;
n := stream.fldAvailableIn;
b := blocks.fldBitB;
k := blocks.fldBitK;
q := blocks.fldWrite;
if q < blocks.fldRead then begin
m := blocks.fldRead - q - 1;
end else begin
m := blocks.fldEnd - q;
end;
window := blocks.fldWindow;
repeat
case fldMode of
START: begin
if (m >= 258) and (n >= 10) then begin
blocks.update(stream, b, k, n, p, q);
r := inflateFast(fldLBits, fldDBits, fldLTreeArray, fldLTreeIndex, fldDTreeArray, fldDTreeIndex, blocks, stream);
p := stream.fldNextInIndex;
n := stream.fldAvailableIn;
b := blocks.fldBitB;
k := blocks.fldBitK;
q := blocks.fldWrite;
if q < blocks.fldRead then begin
m := blocks.fldRead - q - 1;
end else begin
m := blocks.fldEnd - q;
end;
if r <> OK then begin
if r = STREAM_END then begin
fldMode := WASH;
continue;
end;
fldMode := BADCODE;
continue;
end;
end;
fldNeed := fldLBits;
fldTreeArray := fldLTreeArray;
fldTreeIndex := fldLTreeIndex;
fldMode := LEN;
end;
LEN: begin
j := fldNeed;
while k < j do begin
if n = 0 then begin
blocks.update(stream, b, k, n, p, q);
result := blocks.inflateFlush(stream, r);
exit;
end;
r := OK;
dec(n);
b := b or ((int(stream.fldNextInArray[p]) and $ff) shl k);
inc(p);
inc(k, 8);
end;
tArray := fldTreeArray;
tIndex := (fldTreeIndex + (b and inflateMask[j])) * 3;
b := b shr tArray[tIndex + 1];
dec(k, tArray[tIndex + 1]);
e := tArray[tIndex];
if e = 0 then begin
fldLit := tArray[tIndex + 2];
fldMode := LIT;
continue;
end;
if (e and $10) <> 0 then begin
fldGet := e and $0f;
fldLen := tArray[tIndex + 2];
fldMode := LENEXT;
continue;
end;
if (e and $40) = 0 then begin
fldNeed := e;
fldTreeIndex := (tIndex div 3) + tArray[tIndex + 2];
continue;
end;
if (e and $20) <> 0 then begin
fldMode := WASH;
continue;
end;
fldMode := BADCODE;
stream.fldMessage := 'invalid literal/length code';
r := DATA_ERROR;
blocks.update(stream, b, k, n, p, q);
result := blocks.inflateFlush(stream, r);
exit;
end;
LENEXT: begin
j := fldGet;
while k < j do begin
if n = 0 then begin
blocks.update(stream, b, k, n, p, q);
result := blocks.inflateFlush(stream, r);
exit;
end;
r := OK;
dec(n);
b := b or ((int(stream.fldNextInArray[p]) and $ff) shl k);
inc(p);
inc(k, 8);
end;
inc(fldLen, b and inflateMask[j]);
b := CoInt.sar(b, j);
dec(k, j);
fldNeed := fldDBits;
fldTreeArray := fldDTreeArray;
fldTreeIndex := fldDTreeIndex;
fldMode := DIST;
end;
DIST: begin
j := fldNeed;
while k < j do begin
if n = 0 then begin
blocks.update(stream, b, k, n, p, q);
result := blocks.inflateFlush(stream, r);
exit;
end;
r := OK;
dec(n);
b := b or ((int(stream.fldNextInArray[p]) and $ff) shl k);
inc(p);
inc(k, 8);
end;
tArray := fldTreeArray;
tIndex := (fldTreeIndex + (b and inflateMask[j])) * 3;
b := CoInt.sar(b, tArray[tIndex + 1]);
dec(k, tArray[tIndex + 1]);
e := tArray[tIndex];
if (e and $10) <> 0 then begin
fldGet := e and $f;
fldDist := tArray[tIndex + 2];
fldMode := DISTEXT;
continue;
end;
if (e and $40) = 0 then begin
fldNeed := e;
fldTreeIndex := (tIndex div 3) + tArray[tIndex + 2];
continue;
end;
fldMode := BADCODE;
stream.fldMessage := 'invalid distance code';
r := DATA_ERROR;
blocks.update(stream, b, k, n, p, q);
result := blocks.inflateFlush(stream, r);
exit;
end;
DISTEXT: begin
j := fldGet;
while k < j do begin
if n = 0 then begin
blocks.update(stream, b, k, n, p, q);
result := blocks.inflateFlush(stream, r);
exit;
end;
r := OK;
dec(n);
b := b or ((int(stream.fldNextInArray[p]) and $ff) shl k);
inc(p);
inc(k, 8);
end;
inc(fldDist, b and inflateMask[j]);
b := CoInt.sar(b, j);
dec(k, j);
fldMode := COPY;
end;
COPY: begin
f := q - fldDist;
bEnd := blocks.fldEnd;
while f < 0 do begin
inc(f, bEnd);
end;
while fldLen <> 0 do begin
if m = 0 then begin
if (q = blocks.fldEnd) and (blocks.fldRead <> 0) then begin
q := 0;
if q < blocks.fldRead then begin
m := blocks.fldRead - q - 1;
end else begin
m := blocks.fldEnd - q;
end;
end;
if m = 0 then begin
blocks.fldWrite := q;
r := blocks.inflateFlush(stream, r);
q := blocks.fldWrite;
if q < blocks.fldRead then begin
m := blocks.fldRead - q - 1;
end else begin
m := blocks.fldEnd - q;
end;
if (q = blocks.fldEnd) and (blocks.fldRead <> 0) then begin
q := 0;
if q < blocks.fldRead then begin
m := blocks.fldRead - q - 1;
end else begin
m := blocks.fldEnd - q;
end;
end;
if m = 0 then begin
blocks.update(stream, b, k, n, p, q);
result := blocks.inflateFlush(stream, r);
exit;
end;
end;
end;
window[q] := window[f];
inc(q);
inc(f);
dec(m);
if f = blocks.fldEnd then f := 0;
dec(fldLen);
end;
fldMode := START;
end;
LIT: begin
if m = 0 then begin
if (q = blocks.fldEnd) and (blocks.fldRead <> 0) then begin
q := 0;
if q < blocks.fldRead then begin
m := blocks.fldRead - q - 1;
end else begin
m := blocks.fldEnd - q;
end;
end;
if m = 0 then begin
blocks.fldWrite := q;
r := blocks.inflateFlush(stream, r);
q := blocks.fldWrite;
if q < blocks.fldRead then begin
m := blocks.fldRead - q - 1;
end else begin
m := blocks.fldEnd - q;
end;
if (q = blocks.fldEnd) and (blocks.fldRead <> 0) then begin
q := 0;
if q < blocks.fldRead then begin
m := blocks.fldRead - q - 1;
end else begin
m := blocks.fldEnd - q;
end;
end;
if m = 0 then begin
blocks.update(stream, b, k, n, p, q);
result := blocks.inflateFlush(stream, r);
exit;
end;
end;
end;
r := OK;
window[q] := byte(fldLit);
inc(q);
dec(m);
fldMode := START;
end;
WASH: begin
if k > 7 then begin
dec(k, 8);
inc(n);
dec(p);
end;
blocks.fldWrite := q;
r := blocks.inflateFlush(stream, r);
q := blocks.fldWrite;
if q < blocks.fldRead then begin
m := blocks.fldRead - q - 1;
end else begin
m := blocks.fldEnd - q;
end;
if blocks.fldRead <> blocks.fldWrite then begin
blocks.update(stream, b, k, n, p, q);
result := blocks.inflateFlush(stream, r);
exit;
end;
fldMode := &END;
end;
&END: begin
r := STREAM_END;
blocks.update(stream, b, k, n, p, q);
result := blocks.inflateFlush(stream, r);
exit;
end;
BADCODE: begin
r := DATA_ERROR;
blocks.update(stream, b, k, n, p, q);
result := blocks.inflateFlush(stream, r);
exit;
end;
else
r := STREAM_ERROR;
blocks.update(stream, b, k, n, p, q);
result := blocks.inflateFlush(stream, r);
exit;
end;
until false;
end;
{%endregion}
{%region InfTree }
class procedure InfTree.initialize();
begin
fixedTL := [
96, 7, 256, 0, 8, 80, 0, 8, 16, 84, 8, 115,
82, 7, 31, 0, 8, 112, 0, 8, 48, 0, 9, 192,
80, 7, 10, 0, 8, 96, 0, 8, 32, 0, 9, 160,
0, 8, 0, 0, 8, 128, 0, 8, 64, 0, 9, 224,
80, 7, 6, 0, 8, 88, 0, 8, 24, 0, 9, 144,
83, 7, 59, 0, 8, 120, 0, 8, 56, 0, 9, 208,
81, 7, 17, 0, 8, 104, 0, 8, 40, 0, 9, 176,
0, 8, 8, 0, 8, 136, 0, 8, 72, 0, 9, 240,
80, 7, 4, 0, 8, 84, 0, 8, 20, 85, 8, 227,
83, 7, 43, 0, 8, 116, 0, 8, 52, 0, 9, 200,
81, 7, 13, 0, 8, 100, 0, 8, 36, 0, 9, 168,
0, 8, 4, 0, 8, 132, 0, 8, 68, 0, 9, 232,
80, 7, 8, 0, 8, 92, 0, 8, 28, 0, 9, 152,
84, 7, 83, 0, 8, 124, 0, 8, 60, 0, 9, 216,
82, 7, 23, 0, 8, 108, 0, 8, 44, 0, 9, 184,
0, 8, 12, 0, 8, 140, 0, 8, 76, 0, 9, 248,
80, 7, 3, 0, 8, 82, 0, 8, 18, 85, 8, 163,
83, 7, 35, 0, 8, 114, 0, 8, 50, 0, 9, 196,
81, 7, 11, 0, 8, 98, 0, 8, 34, 0, 9, 164,
0, 8, 2, 0, 8, 130, 0, 8, 66, 0, 9, 228,
80, 7, 7, 0, 8, 90, 0, 8, 26, 0, 9, 148,
84, 7, 67, 0, 8, 122, 0, 8, 58, 0, 9, 212,
82, 7, 19, 0, 8, 106, 0, 8, 42, 0, 9, 180,
0, 8, 10, 0, 8, 138, 0, 8, 74, 0, 9, 244,
80, 7, 5, 0, 8, 86, 0, 8, 22, 192, 8, 0,
83, 7, 51, 0, 8, 118, 0, 8, 54, 0, 9, 204,
81, 7, 15, 0, 8, 102, 0, 8, 38, 0, 9, 172,
0, 8, 6, 0, 8, 134, 0, 8, 70, 0, 9, 236,
80, 7, 9, 0, 8, 94, 0, 8, 30, 0, 9, 156,
84, 7, 99, 0, 8, 126, 0, 8, 62, 0, 9, 220,
82, 7, 27, 0, 8, 110, 0, 8, 46, 0, 9, 188,
0, 8, 14, 0, 8, 142, 0, 8, 78, 0, 9, 252,
96, 7, 256, 0, 8, 81, 0, 8, 17, 85, 8, 131,
82, 7, 31, 0, 8, 113, 0, 8, 49, 0, 9, 194,
80, 7, 10, 0, 8, 97, 0, 8, 33, 0, 9, 162,
0, 8, 1, 0, 8, 129, 0, 8, 65, 0, 9, 226,
80, 7, 6, 0, 8, 89, 0, 8, 25, 0, 9, 146,
83, 7, 59, 0, 8, 121, 0, 8, 57, 0, 9, 210,
81, 7, 17, 0, 8, 105, 0, 8, 41, 0, 9, 178,
0, 8, 9, 0, 8, 137, 0, 8, 73, 0, 9, 242,
80, 7, 4, 0, 8, 85, 0, 8, 21, 80, 8, 258,
83, 7, 43, 0, 8, 117, 0, 8, 53, 0, 9, 202,
81, 7, 13, 0, 8, 101, 0, 8, 37, 0, 9, 170,
0, 8, 5, 0, 8, 133, 0, 8, 69, 0, 9, 234,
80, 7, 8, 0, 8, 93, 0, 8, 29, 0, 9, 154,
84, 7, 83, 0, 8, 125, 0, 8, 61, 0, 9, 218,
82, 7, 23, 0, 8, 109, 0, 8, 45, 0, 9, 186,
0, 8, 13, 0, 8, 141, 0, 8, 77, 0, 9, 250,
80, 7, 3, 0, 8, 83, 0, 8, 19, 85, 8, 195,
83, 7, 35, 0, 8, 115, 0, 8, 51, 0, 9, 198,
81, 7, 11, 0, 8, 99, 0, 8, 35, 0, 9, 166,
0, 8, 3, 0, 8, 131, 0, 8, 67, 0, 9, 230,
80, 7, 7, 0, 8, 91, 0, 8, 27, 0, 9, 150,
84, 7, 67, 0, 8, 123, 0, 8, 59, 0, 9, 214,
82, 7, 19, 0, 8, 107, 0, 8, 43, 0, 9, 182,
0, 8, 11, 0, 8, 139, 0, 8, 75, 0, 9, 246,
80, 7, 5, 0, 8, 87, 0, 8, 23, 192, 8, 0,
83, 7, 51, 0, 8, 119, 0, 8, 55, 0, 9, 206,
81, 7, 15, 0, 8, 103, 0, 8, 39, 0, 9, 174,
0, 8, 7, 0, 8, 135, 0, 8, 71, 0, 9, 238,
80, 7, 9, 0, 8, 95, 0, 8, 31, 0, 9, 158,
84, 7, 99, 0, 8, 127, 0, 8, 63, 0, 9, 222,
82, 7, 27, 0, 8, 111, 0, 8, 47, 0, 9, 190,
0, 8, 15, 0, 8, 143, 0, 8, 79, 0, 9, 254,
96, 7, 256, 0, 8, 80, 0, 8, 16, 84, 8, 115,
82, 7, 31, 0, 8, 112, 0, 8, 48, 0, 9, 193,
80, 7, 10, 0, 8, 96, 0, 8, 32, 0, 9, 161,
0, 8, 0, 0, 8, 128, 0, 8, 64, 0, 9, 225,
80, 7, 6, 0, 8, 88, 0, 8, 24, 0, 9, 145,
83, 7, 59, 0, 8, 120, 0, 8, 56, 0, 9, 209,
81, 7, 17, 0, 8, 104, 0, 8, 40, 0, 9, 177,
0, 8, 8, 0, 8, 136, 0, 8, 72, 0, 9, 241,
80, 7, 4, 0, 8, 84, 0, 8, 20, 85, 8, 227,
83, 7, 43, 0, 8, 116, 0, 8, 52, 0, 9, 201,
81, 7, 13, 0, 8, 100, 0, 8, 36, 0, 9, 169,
0, 8, 4, 0, 8, 132, 0, 8, 68, 0, 9, 233,
80, 7, 8, 0, 8, 92, 0, 8, 28, 0, 9, 153,
84, 7, 83, 0, 8, 124, 0, 8, 60, 0, 9, 217,
82, 7, 23, 0, 8, 108, 0, 8, 44, 0, 9, 185,
0, 8, 12, 0, 8, 140, 0, 8, 76, 0, 9, 249,
80, 7, 3, 0, 8, 82, 0, 8, 18, 85, 8, 163,
83, 7, 35, 0, 8, 114, 0, 8, 50, 0, 9, 197,
81, 7, 11, 0, 8, 98, 0, 8, 34, 0, 9, 165,
0, 8, 2, 0, 8, 130, 0, 8, 66, 0, 9, 229,
80, 7, 7, 0, 8, 90, 0, 8, 26, 0, 9, 149,
84, 7, 67, 0, 8, 122, 0, 8, 58, 0, 9, 213,
82, 7, 19, 0, 8, 106, 0, 8, 42, 0, 9, 181,
0, 8, 10, 0, 8, 138, 0, 8, 74, 0, 9, 245,
80, 7, 5, 0, 8, 86, 0, 8, 22, 192, 8, 0,
83, 7, 51, 0, 8, 118, 0, 8, 54, 0, 9, 205,
81, 7, 15, 0, 8, 102, 0, 8, 38, 0, 9, 173,
0, 8, 6, 0, 8, 134, 0, 8, 70, 0, 9, 237,
80, 7, 9, 0, 8, 94, 0, 8, 30, 0, 9, 157,
84, 7, 99, 0, 8, 126, 0, 8, 62, 0, 9, 221,
82, 7, 27, 0, 8, 110, 0, 8, 46, 0, 9, 189,
0, 8, 14, 0, 8, 142, 0, 8, 78, 0, 9, 253,
96, 7, 256, 0, 8, 81, 0, 8, 17, 85, 8, 131,
82, 7, 31, 0, 8, 113, 0, 8, 49, 0, 9, 195,
80, 7, 10, 0, 8, 97, 0, 8, 33, 0, 9, 163,
0, 8, 1, 0, 8, 129, 0, 8, 65, 0, 9, 227,
80, 7, 6, 0, 8, 89, 0, 8, 25, 0, 9, 147,
83, 7, 59, 0, 8, 121, 0, 8, 57, 0, 9, 211,
81, 7, 17, 0, 8, 105, 0, 8, 41, 0, 9, 179,
0, 8, 9, 0, 8, 137, 0, 8, 73, 0, 9, 243,
80, 7, 4, 0, 8, 85, 0, 8, 21, 80, 8, 258,
83, 7, 43, 0, 8, 117, 0, 8, 53, 0, 9, 203,
81, 7, 13, 0, 8, 101, 0, 8, 37, 0, 9, 171,
0, 8, 5, 0, 8, 133, 0, 8, 69, 0, 9, 235,
80, 7, 8, 0, 8, 93, 0, 8, 29, 0, 9, 155,
84, 7, 83, 0, 8, 125, 0, 8, 61, 0, 9, 219,
82, 7, 23, 0, 8, 109, 0, 8, 45, 0, 9, 187,
0, 8, 13, 0, 8, 141, 0, 8, 77, 0, 9, 251,
80, 7, 3, 0, 8, 83, 0, 8, 19, 85, 8, 195,
83, 7, 35, 0, 8, 115, 0, 8, 51, 0, 9, 199,
81, 7, 11, 0, 8, 99, 0, 8, 35, 0, 9, 167,
0, 8, 3, 0, 8, 131, 0, 8, 67, 0, 9, 231,
80, 7, 7, 0, 8, 91, 0, 8, 27, 0, 9, 151,
84, 7, 67, 0, 8, 123, 0, 8, 59, 0, 9, 215,
82, 7, 19, 0, 8, 107, 0, 8, 43, 0, 9, 183,
0, 8, 11, 0, 8, 139, 0, 8, 75, 0, 9, 247,
80, 7, 5, 0, 8, 87, 0, 8, 23, 192, 8, 0,
83, 7, 51, 0, 8, 119, 0, 8, 55, 0, 9, 207,
81, 7, 15, 0, 8, 103, 0, 8, 39, 0, 9, 175,
0, 8, 7, 0, 8, 135, 0, 8, 71, 0, 9, 239,
80, 7, 9, 0, 8, 95, 0, 8, 31, 0, 9, 159,
84, 7, 99, 0, 8, 127, 0, 8, 63, 0, 9, 223,
82, 7, 27, 0, 8, 111, 0, 8, 47, 0, 9, 191,
0, 8, 15, 0, 8, 143, 0, 8, 79, 0, 9, 255
];
fixedTD := [
80, 5, 1, 87, 5, 257, 83, 5, 17, 91, 5, 4097,
81, 5, 5, 89, 5, 1025, 85, 5, 65, 93, 5, 16385,
80, 5, 3, 88, 5, 513, 84, 5, 33, 92, 5, 8193,
82, 5, 9, 90, 5, 2049, 86, 5, 129, 192, 5, 24577,
80, 5, 2, 87, 5, 385, 83, 5, 25, 91, 5, 6145,
81, 5, 7, 89, 5, 1537, 85, 5, 97, 93, 5, 24577,
80, 5, 4, 88, 5, 769, 84, 5, 49, 92, 5, 12289,
82, 5, 13, 90, 5, 3073, 86, 5, 193, 192, 5, 24577
];
cpLens := [
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
];
cpLext := [
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, 112,
112
];
cpDist := [
1, 2, 3, 4, 5, 7, 9, 13, 17,
25, 33, 49, 65, 97, 129, 193, 257, 385, 513,
769, 1025, 1537, 2049, 3073, 4097, 6145, 8193, 12289, 16385,
24577
];
cpDext := [
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
];
end;
class procedure InfTree.finalize();
begin
cpDext := nil;
cpDist := nil;
cpLext := nil;
cpLens := nil;
fixedTD := nil;
fixedTL := nil;
end;
class procedure InfTree.inflateTreesFixed(const bl, bd: int_Array1d; const tl, td: int_Array2d);
begin
bl[0] := FIXED_BL;
bd[0] := FIXED_BD;
tl[0] := fixedTL;
td[0] := fixedTD;
end;
procedure InfTree.initWorkArea(vsize: int);
var
index: int;
component: int_Array1d;
components: int_Array2d;
begin
if fldHN = nil then begin
fldHN := &Array.newInt1d(1);
fldV := &Array.newInt1d(vsize);
fldC := &Array.newInt1d(BMAX + 1);
fldR := &Array.newInt1d(3);
fldU := &Array.newInt1d(BMAX);
fldX := &Array.newInt1d(BMAX + 1);
end;
if system.length(fldV) < vsize then fldV := &Array.newInt1d(vsize);
components := [ fldV, fldC, fldR, fldU, fldX ];
for index := system.length(components) - 1 downto 0 do begin
component := components[index];
&Array.fillPrimitives(component, 0, system.length(component), 0);
end;
end;
function InfTree.huftBuild(const bArray: int_Array1d; bIndex, n, s: int; const d, e, t, m, hp, hn, v: int_Array1d): int;
var
a: int;
f: int;
g: int;
h: int;
i: int;
j: int;
k: int;
l: int;
p: int;
q: int;
w: int;
y: int;
z: int;
xp: int;
mask: int;
c: int_Array1d;
r: int_Array1d;
u: int_Array1d;
x: int_Array1d;
begin
p := 0;
i := n;
c := fldC;
repeat
inc(c[bArray[bIndex + p]]);
inc(p);
dec(i);
until i = 0;
if c[0] = n then begin
t[0] := -1;
m[0] := 0;
result := OK;
exit;
end;
l := m[0];
j := 1;
while (j <= BMAX) and (c[j] = 0) do begin
inc(j);
end;
k := j;
if l < j then l := j;
i := BMAX;
while (i > 0) and (c[i] = 0) do begin
dec(i);
end;
g := i;
if l > i then l := i;
m[0] := l;
y := 1 shl j;
while j < i do begin
dec(y, c[j]);
if y < 0 then begin
result := DATA_ERROR;
exit;
end;
inc(j);
y := y shl 1;
end;
dec(y, c[i]);
if y < 0 then begin
result := DATA_ERROR;
exit;
end;
inc(c[i], y);
x := fldX;
x[1] := 0;
j := 0;
p := 1;
xp := 2;
dec(i);
while i <> 0 do begin
inc(j, c[p]);
x[xp] := j;
inc(xp);
inc(p);
dec(i);
end;
i := 0;
p := 0;
repeat
j := bArray[bIndex + p];
if j <> 0 then begin
v[x[j]] := i;
inc(x[j]);
end;
inc(p);
inc(i);
until i >= n;
n := x[g];
x[0] := 0;
i := 0;
p := 0;
h := -1;
w := -l;
u := fldU;
u[0] := 0;
q := 0;
z := 0;
r := fldR;
while k <= g do begin
a := c[k];
while a <> 0 do begin
dec(a);
while k > w + l do begin
inc(h);
inc(w, l);
z := g - w;
if z > l then z := l;
j := k - w;
f := 1 shl j;
if f > a + 1 then begin
dec(f, a + 1);
xp := k;
if j < z then begin
inc(j);
while j < z do begin
f := f shl 1;
inc(xp);
if f <= c[xp] then break;
dec(f, c[xp]);
inc(j);
end;
end;
end;
z := 1 shl j;
if hn[0] + z > MANY then begin
result := DATA_ERROR;
exit;
end;
q := hn[0];
u[h] := q;
inc(hn[0], z);
if h <> 0 then begin
x[h] := i;
r[0] := byte(j);
r[1] := byte(l);
j := i shr (w - l);
r[2] := q - u[h - 1] - j;
&Array.copyPrimitives(r, 0, hp, (u[h - 1] + j) * 3, 3);
end else begin
t[0] := q;
end;
end;
r[1] := byte(k - w);
if p >= n then begin
r[0] := 128 + 64;
end else begin
if v[p] < s then begin
if v[p] < 256 then begin
r[0] := 0;
end else begin
r[0] := 32 + 64;
end;
r[2] := v[p];
end else begin
r[0] := byte(e[v[p] - s] + (16 + 64));
r[2] := d[v[p] - s];
end;
inc(p);
end;
f := 1 shl (k - w);
j := i shr w;
while j < z do begin
&Array.copyPrimitives(r, 0, hp, (q + j) * 3, 3);
inc(j, f);
end;
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;
mask := (1 shl w) - 1;
while (i and mask) <> x[h] do begin
dec(h);
dec(w, l);
mask := (1 shl w) - 1;
end;
end;
inc(k);
end;
if (y <> 0) and (g <> 1) then begin
result := BUF_ERROR;
exit;
end;
result := OK;
end;
function InfTree.inflateTreesBits(const c, bb, tb, hp: int_Array1d; stream: ZStream): int;
var
zlibResult: int;
hn: int_Array1d;
begin
initWorkArea(19);
hn := fldHN;
hn[0] := 0;
zlibResult := huftBuild(c, 0, 19, 19, nil, nil, tb, bb, hp, hn, fldV);
if zlibResult = DATA_ERROR then begin
stream.fldMessage := 'oversubscribed dynamic bit lengths tree';
end else
if (zlibResult = BUF_ERROR) or (bb[0] = 0) then begin
stream.fldMessage := 'incomplete dynamic bit lengths tree';
result := DATA_ERROR;
exit;
end;
result := zlibResult;
end;
function InfTree.inflateTreesDynamic(nl, nd: int; const c, bl, bd, tl, td, hp: int_Array1d; stream: ZStream): int;
var
zlibResult: int;
hn: int_Array1d;
begin
initWorkArea(288);
hn := fldHN;
hn[0] := 0;
zlibResult := huftBuild(c, 0, nl, 257, cpLens, cpLext, tl, bl, hp, hn, fldV);
if (zlibResult <> OK) or (bl[0] = 0) then begin
if zlibResult = DATA_ERROR then begin
stream.fldMessage := 'oversubscribed literal/length tree';
end else
if zlibResult <> MEM_ERROR then begin
stream.fldMessage := 'incomplete literal/length tree';
result := DATA_ERROR;
exit;
end;
result := zlibResult;
exit;
end;
initWorkArea(288);
zlibResult := huftBuild(c, nl, nd, 0, cpDist, cpDext, td, bd, hp, hn, fldV);
if (zlibResult <> OK) or ((bd[0] = 0) and (nl > 257)) then begin
case zlibResult of
DATA_ERROR: begin
stream.fldMessage := 'oversubscribed distance tree';
end;
BUF_ERROR: begin
stream.fldMessage := 'incomplete distance tree';
result := DATA_ERROR;
exit;
end;
else
if zlibResult <> MEM_ERROR then begin
stream.fldMessage := 'empty distance tree with lengths';
result := DATA_ERROR;
exit;
end;
end;
result := zlibResult;
exit;
end;
result := OK;
end;
{%endregion}
{%region StaticTree }
class procedure StaticTree.initialize();
begin
staticLTree := [
12, 8, 140, 8, 76, 8, 204, 8, 44, 8,
172, 8, 108, 8, 236, 8, 28, 8, 156, 8,
92, 8, 220, 8, 60, 8, 188, 8, 124, 8,
252, 8, 2, 8, 130, 8, 66, 8, 194, 8,
34, 8, 162, 8, 98, 8, 226, 8, 18, 8,
146, 8, 82, 8, 210, 8, 50, 8, 178, 8,
114, 8, 242, 8, 10, 8, 138, 8, 74, 8,
202, 8, 42, 8, 170, 8, 106, 8, 234, 8,
26, 8, 154, 8, 90, 8, 218, 8, 58, 8,
186, 8, 122, 8, 250, 8, 6, 8, 134, 8,
70, 8, 198, 8, 38, 8, 166, 8, 102, 8,
230, 8, 22, 8, 150, 8, 86, 8, 214, 8,
54, 8, 182, 8, 118, 8, 246, 8, 14, 8,
142, 8, 78, 8, 206, 8, 46, 8, 174, 8,
110, 8, 238, 8, 30, 8, 158, 8, 94, 8,
222, 8, 62, 8, 190, 8, 126, 8, 254, 8,
1, 8, 129, 8, 65, 8, 193, 8, 33, 8,
161, 8, 97, 8, 225, 8, 17, 8, 145, 8,
81, 8, 209, 8, 49, 8, 177, 8, 113, 8,
241, 8, 9, 8, 137, 8, 73, 8, 201, 8,
41, 8, 169, 8, 105, 8, 233, 8, 25, 8,
153, 8, 89, 8, 217, 8, 57, 8, 185, 8,
121, 8, 249, 8, 5, 8, 133, 8, 69, 8,
197, 8, 37, 8, 165, 8, 101, 8, 229, 8,
21, 8, 149, 8, 85, 8, 213, 8, 53, 8,
181, 8, 117, 8, 245, 8, 13, 8, 141, 8,
77, 8, 205, 8, 45, 8, 173, 8, 109, 8,
237, 8, 29, 8, 157, 8, 93, 8, 221, 8,
61, 8, 189, 8, 125, 8, 253, 8, 19, 9,
275, 9, 147, 9, 403, 9, 83, 9, 339, 9,
211, 9, 467, 9, 51, 9, 307, 9, 179, 9,
435, 9, 115, 9, 371, 9, 243, 9, 499, 9,
11, 9, 267, 9, 139, 9, 395, 9, 75, 9,
331, 9, 203, 9, 459, 9, 43, 9, 299, 9,
171, 9, 427, 9, 107, 9, 363, 9, 235, 9,
491, 9, 27, 9, 283, 9, 155, 9, 411, 9,
91, 9, 347, 9, 219, 9, 475, 9, 59, 9,
315, 9, 187, 9, 443, 9, 123, 9, 379, 9,
251, 9, 507, 9, 7, 9, 263, 9, 135, 9,
391, 9, 71, 9, 327, 9, 199, 9, 455, 9,
39, 9, 295, 9, 167, 9, 423, 9, 103, 9,
359, 9, 231, 9, 487, 9, 23, 9, 279, 9,
151, 9, 407, 9, 87, 9, 343, 9, 215, 9,
471, 9, 55, 9, 311, 9, 183, 9, 439, 9,
119, 9, 375, 9, 247, 9, 503, 9, 15, 9,
271, 9, 143, 9, 399, 9, 79, 9, 335, 9,
207, 9, 463, 9, 47, 9, 303, 9, 175, 9,
431, 9, 111, 9, 367, 9, 239, 9, 495, 9,
31, 9, 287, 9, 159, 9, 415, 9, 95, 9,
351, 9, 223, 9, 479, 9, 63, 9, 319, 9,
191, 9, 447, 9, 127, 9, 383, 9, 255, 9,
511, 9, 0, 7, 64, 7, 32, 7, 96, 7,
16, 7, 80, 7, 48, 7, 112, 7, 8, 7,
72, 7, 40, 7, 104, 7, 24, 7, 88, 7,
56, 7, 120, 7, 4, 7, 68, 7, 36, 7,
100, 7, 20, 7, 84, 7, 52, 7, 116, 7,
3, 8, 131, 8, 67, 8, 195, 8, 35, 8,
163, 8, 99, 8, 227, 8
];
staticDTree := [
0, 5, 16, 5, 8, 5, 24, 5, 4, 5,
20, 5, 12, 5, 28, 5, 2, 5, 18, 5,
10, 5, 26, 5, 6, 5, 22, 5, 14, 5,
30, 5, 1, 5, 17, 5, 9, 5, 25, 5,
5, 5, 21, 5, 13, 5, 29, 5, 3, 5,
19, 5, 11, 5, 27, 5, 7, 5, 23, 5
];
extraLBits := [
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
];
extraDBits := [
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
];
extraBLBits := [
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 2, 3, 7
];
staticLDesc := StaticTree.create(staticLTree, extraLBits, LITERALS + 1, L_CODES, MAX_BITS);
staticDDesc := StaticTree.create(staticDTree, extraDBits, 0, D_CODES, MAX_BITS);
staticBLDesc := StaticTree.create(nil, extraBLBits, 0, BL_CODES, MAX_BL_BITS);
end;
class procedure StaticTree.finalize();
begin
staticBLDesc.free();
staticDDesc.free();
staticLDesc.free();
extraBLBits := nil;
extraDBits := nil;
extraLBits := nil;
staticDTree := nil;
staticLTree := nil;
end;
constructor StaticTree.create(const staticTree, extraBits: int_Array1d; extraBase, elements, maxLength: int);
begin
inherited create();
fldStaticTree := staticTree;
fldExtraBits := extraBits;
fldExtraBase := extraBase;
fldElements := elements;
fldMaxLength := maxLength;
end;
{%endregion}
{%region Tree }
class procedure Tree.genCodes(const tree: int_Array1d; maxCode: int; const blCount: int_Array1d);
var
idx: int;
len: int;
buf: int;
code: int;
bits: int;
nextCode: int_Array1d;
begin
nextCode := &Array.newInt1d(MAX_BITS + 1);
code := 0;
for bits := 1 to MAX_BITS do begin
code := short((code + blCount[bits - 1]) shl 1);
nextCode[bits] := code;
end;
for idx := 0 to maxCode do begin
len := tree[idx * 2 + 1];
if len = 0 then continue;
buf := nextCode[len];
tree[idx * 2] := short(biReverse(buf, len));
nextCode[len] := buf + 1;
end;
end;
class function Tree.biReverse(code, len: int): int;
var
bits: int;
begin
bits := 0;
repeat
bits := bits or (code and $01);
code := code shr 1;
bits := bits shl 1;
dec(len);
until len <= 0;
result := bits shr 1;
end;
procedure Tree.genBitlen(dState: DefState);
var
f: int;
h: int;
n: int;
m: int;
base: int;
bits: int;
xbits: int;
heapMax: int;
maxCode: int;
overflow: int;
maxLength: int;
heapBuf: int_Array1d;
blCount: int_Array1d;
dTree: int_Array1d;
sTree: int_Array1d;
extra: int_Array1d;
sDesc: StaticTree;
begin
sDesc := fldStaticDesc;
dTree := fldDynamicTree;
sTree := sDesc.fldStaticTree;
extra := sDesc.fldExtraBits;
base := sDesc.fldExtraBase;
maxLength := sDesc.fldMaxLength;
overflow := 0;
blCount := dState.fldBlCount;
&Array.fillPrimitives(blCount, 0, MAX_BITS, 0);
maxCode := fldMaxCode;
heapMax := dState.fldHeapMax;
heapBuf := dState.fldHeapBuf;
dTree[heapBuf[heapMax] * 2 + 1] := 0;
h := heapMax + 1;
while h < HEAP_SIZE do begin
n := heapBuf[h];
bits := dTree[dTree[n * 2 + 1] * 2 + 1] + 1;
if bits > maxLength then begin
bits := maxLength;
inc(overflow);
end;
dTree[n * 2 + 1] := short(bits);
if n > maxCode then begin
inc(h);
continue;
end;
inc(blCount[bits]);
xbits := 0;
if n >= base then xbits := extra[n - base];
f := dTree[n * 2];
inc(dState.fldOptLen, f * (bits + xbits));
if sTree <> nil then inc(dState.fldStaticLen, f * (sTree[n * 2 + 1] + xbits));
inc(h);
end;
if overflow = 0 then exit;
repeat
bits := &Array.lastIndexOfNon(0, blCount, maxLength - 1, 0);
dec(blCount[bits]);
inc(blCount[bits + 1], 2);
dec(blCount[maxLength]);
dec(overflow, 2);
until overflow <= 0;
for bits := maxLength downto 1 do begin
n := blCount[bits];
while n <> 0 do begin
dec(h);
m := heapBuf[h];
if m > maxCode then continue;
if dTree[m * 2 + 1] <> bits then begin
inc(dState.fldOptLen, int((long(bits) - long(dTree[m * 2 + 1])) * long(dTree[m * 2])));
dTree[m * 2 + 1] := short(bits);
end;
dec(n);
end;
end;
end;
procedure Tree.buildTree(dState: DefState);
var
n: int;
m: int;
node: int;
heapLen: int;
heapMax: int;
elements: int;
maxCodeLocal: int;
depth: byte_Array1d;
heapBuf: int_Array1d;
dTree: int_Array1d;
sTree: int_Array1d;
sDesc: StaticTree;
begin
sDesc := fldStaticDesc;
dTree := fldDynamicTree;
sTree := sDesc.fldStaticTree;
elements := sDesc.fldElements;
maxCodeLocal := -1;
heapLen := 0;
heapMax := HEAP_SIZE;
heapBuf := dState.fldHeapBuf;
depth := dState.fldDepth;
for n := 0 to elements - 1 do begin
if dTree[n * 2] <> 0 then begin
inc(heapLen);
maxCodeLocal := n;
heapBuf[heapLen] := n;
depth[n] := 0;
end else begin
dTree[n * 2 + 1] := 0;
end;
end;
while heapLen < 2 do begin
inc(heapLen);
if maxCodeLocal < 2 then begin
inc(maxCodeLocal);
node := maxCodeLocal;
end else begin
node := 0;
end;
heapBuf[heapLen] := node;
dTree[node * 2] := 1;
depth[node] := 0;
dec(dState.fldOptLen);
if sTree <> nil then dec(dState.fldStaticLen, sTree[node * 2 + 1]);
end;
fldMaxCode := maxCodeLocal;
dState.fldHeapLen := heapLen;
for n := heapLen div 2 downto 1 do begin
dState.pqDownHeap(dTree, n);
end;
node := elements;
repeat
n := heapBuf[1];
heapBuf[1] := heapBuf[heapLen];
dec(heapLen);
dState.fldHeapLen := heapLen;
dState.pqDownHeap(dTree, 1);
m := heapBuf[1];
dec(heapMax);
heapBuf[heapMax] := n;
dec(heapMax);
heapBuf[heapMax] := m;
dTree[node * 2] := short(dTree[n * 2] + dTree[m * 2]);
depth[node] := byte(CoInt.max(depth[n], depth[m]) + 1);
dTree[n * 2 + 1] := short(node);
dTree[m * 2 + 1] := short(node);
heapBuf[1] := node;
inc(node);
dState.fldHeapLen := heapLen;
dState.pqDownHeap(dTree, 1);
until heapLen < 2;
dec(heapMax);
heapBuf[heapMax] := heapBuf[1];
dState.fldHeapLen := heapLen;
dState.fldHeapMax := heapMax;
genBitlen(dState);
genCodes(dTree, maxCodeLocal, dState.fldBlCount);
end;
{%endregion}
{%region} initialization
CRC32.initialize();
DefState.initialize();
InfState.initialize();
InfBlocks.initialize();
InfCodes.initialize();
InfTree.initialize();
StaticTree.initialize();
{%endregion}
{%region} finalization
StaticTree.finalize();
InfTree.finalize();
InfCodes.finalize();
InfBlocks.finalize();
InfState.finalize();
DefState.finalize();
CRC32.finalize();
{%endregion}
end.
