{ * Compressor                                                                 * }
{ ****************************************************************************** }
{ * https://zpascal.net                                                        * }
{ * https://github.com/PassByYou888/zAI                                        * }
{ * https://github.com/PassByYou888/ZServer4D                                  * }
{ * https://github.com/PassByYou888/PascalString                               * }
{ * https://github.com/PassByYou888/zRasterization                             * }
{ * https://github.com/PassByYou888/CoreCipher                                 * }
{ * https://github.com/PassByYou888/zSound                                     * }
{ * https://github.com/PassByYou888/zChinese                                   * }
{ * https://github.com/PassByYou888/zExpression                                * }
{ * https://github.com/PassByYou888/zGameWare                                  * }
{ * https://github.com/PassByYou888/zAnalysis                                  * }
{ * https://github.com/PassByYou888/FFMPEG-Header                              * }
{ * https://github.com/PassByYou888/zTranslate                                 * }
{ * https://github.com/PassByYou888/InfiniteIoT                                * }
{ * https://github.com/PassByYou888/FastMD5                                    * }
{ ****************************************************************************** }
unit CoreCompress;

{$INCLUDE zDefine.inc}

interface

uses Math, Types, CoreClasses;

type
  PPCCInt8 = ^PCCInt8;
  PCCInt8 = ^TCCInt8;
  TCCInt8 = ShortInt;

  PPCCUInt8 = ^PCCUInt8;
  PCCUInt8 = ^TCCUInt8;
  TCCUInt8 = Byte;

  PCCInt16 = ^TCCInt16;
  TCCInt16 = SmallInt;

  PCCUInt16 = ^TCCUInt16;
  TCCUInt16 = Word;

  PCCInt32 = ^TCCInt32;
  TCCInt32 = Integer;

  PCCUInt32 = ^TCCUInt32;
  TCCUInt32 = Cardinal;

  PCCInt64 = ^TCCInt64;
  TCCInt64 = Int64;

  PCCUInt64 = ^TCCUInt64;
  TCCUInt64 = UInt64;

  PCCPtr = ^TCCPtr;
  TCCPtr = Pointer;

  TCCPtrUInt = nativeUInt;
  TCCPtrInt = NativeInt;

  PPCCPtrInt = ^PCCPtrInt;
  PCCPtrUInt = ^TCCPtrUInt;
  PCCPtrInt = ^TCCPtrInt;

  PCCSizeUInt = ^TCCSizeUInt;
  TCCSizeUInt = TCCPtrUInt;

  PCCSizeInt = ^TCCSizeInt;
  TCCSizeInt = TCCPtrInt;

  PCCNativeUInt = ^TCCNativeUInt;
  TCCNativeUInt = TCCPtrUInt;

  PCCNativeInt = ^TCCNativeInt;
  TCCNativeInt = TCCPtrInt;

  PCCSize = ^TCCSizeUInt;
  TCCSize = TCCPtrUInt;

  PCCUInt8Array = ^TCCUInt8Array;
  TCCUInt8Array = array [0 .. MaxInt div SizeOf(TCCUInt8) - 1] of TCCUInt8;

  PPCCUInt64Record = ^PCCUInt64Record;
  PCCUInt64Record = ^TCCUInt64Record;

  TCCUInt64Record = packed record
    case Boolean of
      False: ( {$IFDEF BIG_ENDIAN}Hi, Lo{$ELSE}Lo, Hi{$ENDIF}: TCCUInt32;);
      True: (Value: TCCUInt64;);
  end;

  TCompressor = class(TCoreClassObject)
  private const
    ChunkHeadSize = $3000;
    ChunkSize = $FFFF - ChunkHeadSize;
    PrepareBuffSize = $FFFF;
  public
    constructor Create; reintroduce; virtual;
    destructor Destroy; override;
    function Compress(const aInData: TCCPtr; const aInSize: TCCSizeUInt; const aOutData: TCCPtr; const aOutLimit: TCCSizeUInt): TCCSizeUInt; virtual;
    function Decompress(const aInData: TCCPtr; const aInSize: TCCSizeUInt; const aOutData: TCCPtr; const aOutLimit: TCCSizeUInt): TCCSizeUInt; virtual;

    procedure CompressStream(sour: TCoreClassStream; StartPos, EndPos: NativeInt; CompressTo: TCoreClassStream);
    procedure DecompressStream(sour, DecompressTo: TCoreClassStream);
  end;

  TCompressorClass = class of TCompressor;

  TCompressorDeflate = class(TCompressor)
  private const
    HashBits = 16;
    HashSize = 1 shl HashBits;
    HashMask = HashSize - 1;
    HashShift = 32 - HashBits;
    WindowSize = 32768;
    WindowMask = WindowSize - 1;
    MinMatch = 3;
    MaxMatch = 258;
    MaxOffset = 32768;
    HashRef_ENDIAN_B30 = {$IF defined(BIG_ENDIAN)}$FFFFFF00{$ELSE}$00FFFFFF{$IFEND};

{$IFNDEF BIG_ENDIAN}
    MultiplyDeBruijnBytePosition: array [0 .. 31] of TCCUInt8 = (0, 0, 3, 0, 3, 1, 3, 0, 3, 2, 2, 1, 3, 2, 0, 1, 3, 3, 1, 2, 2, 2, 2, 0, 3, 1, 2, 0, 1, 0, 1, 1);
{$ENDIF}
    //
    LengthCodes: array [0 .. 28, 0 .. 3] of TCCUInt32 =
      ( // Code, ExtraBits, Min, Max
      (257, 0, 3, 3), (258, 0, 4, 4), (259, 0, 5, 5),
      (260, 0, 6, 6), (261, 0, 7, 7), (262, 0, 8, 8),
      (263, 0, 9, 9), (264, 0, 10, 10), (265, 1, 11, 12),
      (266, 1, 13, 14), (267, 1, 15, 16), (268, 1, 17, 18),
      (269, 2, 19, 22), (270, 2, 23, 26), (271, 2, 27, 30),
      (272, 2, 31, 34), (273, 3, 35, 42), (274, 3, 43, 50),
      (275, 3, 51, 58), (276, 3, 59, 66), (277, 4, 67, 82),
      (278, 4, 83, 98), (279, 4, 99, 114), (280, 4, 115, 130),
      (281, 5, 131, 162), (282, 5, 163, 194), (283, 5, 195, 226),
      (284, 5, 227, 257), (285, 0, 258, 258)
      );
    DistanceCodes: array [0 .. 29, 0 .. 3] of TCCUInt32 =
      ( // Code, ExtraBits, Min, Max
      (0, 0, 1, 1), (1, 0, 2, 2), (2, 0, 3, 3),
      (3, 0, 4, 4), (4, 1, 5, 6), (5, 1, 7, 8),
      (6, 2, 9, 12), (7, 2, 13, 16), (8, 3, 17, 24),
      (9, 3, 25, 32), (10, 4, 33, 48), (11, 4, 49, 64),
      (12, 5, 65, 96), (13, 5, 97, 128), (14, 6, 129, 192),
      (15, 6, 193, 256), (16, 7, 257, 384), (17, 7, 385, 512),
      (18, 8, 513, 768), (19, 8, 769, 1024), (20, 9, 1025, 1536),
      (21, 9, 1537, 2048), (22, 10, 2049, 3072), (23, 10, 3073, 4096),
      (24, 11, 4097, 6144), (25, 11, 6145, 8192), (26, 12, 8193, 12288),
      (27, 12, 12289, 16384), (28, 13, 16385, 24576), (29, 13, 24577, 32768)
      );
    MirrorBytes: array [TCCUInt8] of TCCUInt8 =
      (
      $00, $80, $40, $C0, $20, $A0, $60, $E0,
      $10, $90, $50, $D0, $30, $B0, $70, $F0,
      $08, $88, $48, $C8, $28, $A8, $68, $E8,
      $18, $98, $58, $D8, $38, $B8, $78, $F8,
      $04, $84, $44, $C4, $24, $A4, $64, $E4,
      $14, $94, $54, $D4, $34, $B4, $74, $F4,
      $0C, $8C, $4C, $CC, $2C, $AC, $6C, $EC,
      $1C, $9C, $5C, $DC, $3C, $BC, $7C, $FC,
      $02, $82, $42, $C2, $22, $A2, $62, $E2,
      $12, $92, $52, $D2, $32, $B2, $72, $F2,
      $0A, $8A, $4A, $CA, $2A, $AA, $6A, $EA,
      $1A, $9A, $5A, $DA, $3A, $BA, $7A, $FA,
      $06, $86, $46, $C6, $26, $A6, $66, $E6,
      $16, $96, $56, $D6, $36, $B6, $76, $F6,
      $0E, $8E, $4E, $CE, $2E, $AE, $6E, $EE,
      $1E, $9E, $5E, $DE, $3E, $BE, $7E, $FE,
      $01, $81, $41, $C1, $21, $A1, $61, $E1,
      $11, $91, $51, $D1, $31, $B1, $71, $F1,
      $09, $89, $49, $C9, $29, $A9, $69, $E9,
      $19, $99, $59, $D9, $39, $B9, $79, $F9,
      $05, $85, $45, $C5, $25, $A5, $65, $E5,
      $15, $95, $55, $D5, $35, $B5, $75, $F5,
      $0D, $8D, $4D, $CD, $2D, $AD, $6D, $ED,
      $1D, $9D, $5D, $DD, $3D, $BD, $7D, $FD,
      $03, $83, $43, $C3, $23, $A3, $63, $E3,
      $13, $93, $53, $D3, $33, $B3, $73, $F3,
      $0B, $8B, $4B, $CB, $2B, $AB, $6B, $EB,
      $1B, $9B, $5B, $DB, $3B, $BB, $7B, $FB,
      $07, $87, $47, $C7, $27, $A7, $67, $E7,
      $17, $97, $57, $D7, $37, $B7, $77, $F7,
      $0F, $8F, $4F, $CF, $2F, $AF, $6F, $EF,
      $1F, $9F, $5F, $DF, $3F, $BF, $7F, $FF
      );
    CLCIndex: array [0 .. 18] of TCCUInt8 = (16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15);

  type
    PHashTable = ^THashTable;
    THashTable = array [0 .. HashSize - 1] of PCCUInt8;
    PChainTable = ^TChainTable;
    TChainTable = array [0 .. WindowSize - 1] of TCCPtr;
    PTree = ^TTree;

    TTree = packed record
      Table: array [0 .. 15] of TCCUInt16;
      Translation: array [0 .. 287] of TCCUInt16;
    end;

    PBuffer = ^TBuffer;
    TBuffer = array [0 .. 65535] of TCCUInt8;
    PLengths = ^TLengths;
    TLengths = array [0 .. 288 + 32 - 1] of TCCUInt8;
    POffsets = ^TOffsets;
    TOffsets = array [0 .. 15] of TCCUInt16;
    TBits = array [0 .. 29] of TCCUInt8;
    PBits = ^TBits;
    TBase = array [0 .. 29] of TCCUInt16;
    PBase = ^TBase;

  var
    fHashTable: THashTable;
    fChainTable: TChainTable;
    fLengthCodesLookUpTable: array [0 .. 258] of TCCInt32;
    fDistanceCodesLookUpTable: array [0 .. 32768] of TCCInt32;
    fSymbolLengthTree: TTree;
    fDistanceTree: TTree;
    fFixedSymbolLengthTree: TTree;
    fFixedDistanceTree: TTree;
    fLengthBits: TBits;
    fDistanceBits: TBits;
    fLengthBase: TBase;
    fDistanceBase: TBase;
    fCodeTree: TTree;
    fLengths: TLengths;
    fWithHeader: Boolean;
    fGreedy: Boolean;
    fSkipStrength: TCCUInt32;
    fMaxSteps: TCCUInt32;
  public
    constructor Create; override;
    destructor Destroy; override;
    function Compress(const aInData: TCCPtr; const aInSize: TCCSizeUInt; const aOutData: TCCPtr; const aOutLimit: TCCSizeUInt): TCCSizeUInt; override;
    function Decompress(const aInData: TCCPtr; const aInSize: TCCSizeUInt; const aOutData: TCCPtr; const aOutLimit: TCCSizeUInt): TCCSizeUInt; override;

    property WithHeader: Boolean read fWithHeader write fWithHeader;
    property Greedy: Boolean read fGreedy write fGreedy;
    property SkipStrength: TCCUInt32 read fSkipStrength write fSkipStrength;
    property MaxSteps: TCCUInt32 read fMaxSteps write fMaxSteps;
  end;

  TCompressorBRRC = class(TCompressor)
  private const
    FlagModel = 0;
    LiteralModel = 2;
    SizeModels = 258;
  public
    constructor Create; override;
    destructor Destroy; override;
    function Compress(const aInData: TCCPtr; const aInSize: TCCSizeUInt; const aOutData: TCCPtr; const aOutLimit: TCCSizeUInt): TCCSizeUInt; override;
    function Decompress(const aInData: TCCPtr; const aInSize: TCCSizeUInt; const aOutData: TCCPtr; const aOutLimit: TCCSizeUInt): TCCSizeUInt; override;
  end;

function CoreCompressStream(Compressor: TCompressor; sour: TCoreClassStream; ComTo: TCoreClassStream): Boolean;
function CoreDecompressStream(Compressor: TCompressor; sour: TCoreClassStream; DeTo: TCoreClassStream): Boolean;

function DeflateCompressStream(sour: TCoreClassStream; ComTo: TCoreClassStream): Boolean;
function DeflateDecompressStream(sour: TCoreClassStream; DeTo: TCoreClassStream): Boolean;

function BRRCCompressStream(sour: TCoreClassStream; ComTo: TCoreClassStream): Boolean;
function BRRCDecompressStream(sour: TCoreClassStream; DeTo: TCoreClassStream): Boolean;

implementation

uses MemoryStream64;

function CoreCompressStream(Compressor: TCompressor; sour: TCoreClassStream; ComTo: TCoreClassStream): Boolean;
begin
  try
    Compressor.CompressStream(sour, 0, sour.Size, ComTo);
    Result := True;
  except
      Result := False;
  end;
end;

function CoreDecompressStream(Compressor: TCompressor; sour: TCoreClassStream; DeTo: TCoreClassStream): Boolean;
begin
  try
    Compressor.DecompressStream(sour, DeTo);
    Result := True;
  except
      Result := False;
  end;
end;

function DeflateCompressStream(sour: TCoreClassStream; ComTo: TCoreClassStream): Boolean;
var
  c: TCompressorDeflate;
begin
  c := TCompressorDeflate.Create;
  Result := CoreCompressStream(c, sour, ComTo);
  DisposeObject(c);
end;

function DeflateDecompressStream(sour: TCoreClassStream; DeTo: TCoreClassStream): Boolean;
var
  c: TCompressorDeflate;
begin
  c := TCompressorDeflate.Create;
  Result := CoreDecompressStream(c, sour, DeTo);
  DisposeObject(c);
end;

function BRRCCompressStream(sour: TCoreClassStream; ComTo: TCoreClassStream): Boolean;
var
  c: TCompressorBRRC;
begin
  c := TCompressorBRRC.Create;
  Result := CoreCompressStream(c, sour, ComTo);
  DisposeObject(c);
end;

function BRRCDecompressStream(sour: TCoreClassStream; DeTo: TCoreClassStream): Boolean;
var
  c: TCompressorBRRC;
begin
  c := TCompressorBRRC.Create;
  Result := CoreDecompressStream(c, sour, DeTo);
  DisposeObject(c);
end;

procedure BytewiseMemoryMove(const aSource; var aDestination; const aLength: TCCSizeUInt);
var
  index: TCCSizeUInt;
  Source, Destination: PCCUInt8Array;
begin
  if aLength > 0 then
    begin
      Source := TCCPtr(@aSource);
      Destination := TCCPtr(@aDestination);
      for index := 0 to aLength - 1 do
        begin
          Destination^[index] := Source^[index];
        end;
    end;
end;

procedure RLELikeSideEffectAwareMemoryMove(const aSource; var aDestination; const aLength: TCCSizeUInt);
begin
  if aLength > 0 then
    begin
      if (TCCSizeUInt(TCCPtr(@aSource)) + aLength) <= TCCSizeUInt(TCCPtr(@aDestination)) then
        // Non-overlapping, so we an use an optimized memory move function
          CopyPtr(@aSource, @aDestination, aLength)
      else
        // Overlapping, so we must do copy byte-wise for to get the free RLE-like side-effect included
          BytewiseMemoryMove(aSource, aDestination, aLength);
    end;
end;

{$IFDEF RangeCheck}{$R-}{$ENDIF}

{$IFNDEF fpc}


function BSRDWord(Value: TCCUInt32): TCCUInt32;

const
  BSRDebruijn32Multiplicator = TCCUInt32($07C4ACDD);
  BSRDebruijn32Shift = 27;
  BSRDebruijn32Mask = 31;
  BSRDebruijn32Table: array [0 .. 31] of TCCInt32 = (0, 9, 1, 10, 13, 21, 2, 29, 11, 14, 16, 18, 22, 25, 3, 30, 8, 12, 20, 28, 15, 17, 24, 7, 19, 27, 23, 6, 26, 5, 4, 31);
begin
  if Value = 0 then
    begin
      Result := 255;
    end
  else
    begin
      Value := Value or (Value shr 1);
      Value := Value or (Value shr 2);
      Value := Value or (Value shr 4);
      Value := Value or (Value shr 8);
      Value := Value or (Value shr 16);
      Result := BSRDebruijn32Table[((Value * BSRDebruijn32Multiplicator) shr BSRDebruijn32Shift) and BSRDebruijn32Mask];
    end;
end;
{$IFEND}


function SARLongint(Value, Shift: TCCInt32): TCCInt32;
begin
  Shift := Shift and 31;
  Result := (TCCUInt32(Value) shr Shift) or (TCCUInt32(TCCInt32(TCCUInt32(-TCCUInt32(TCCUInt32(Value) shr 31)) and TCCUInt32(-TCCUInt32(Ord(Shift <> 0) and 1)))) shl (32 - Shift));
end;

function SARInt64(Value: TCCInt64; Shift: TCCInt32): TCCInt64;
begin
  Shift := Shift and 63;
  Result := (TCCInt64(Value) shr Shift) or (TCCInt64(TCCInt64(TCCInt64(-TCCInt64(TCCInt64(Value) shr 63)) and TCCInt64(-TCCInt64(Ord(Shift <> 0) and 1)))) shl (63 - Shift));
end;

constructor TCompressor.Create;
begin
  inherited Create;
end;

destructor TCompressor.Destroy;
begin
  inherited Destroy;
end;

function TCompressor.Compress(const aInData: TCCPtr; const aInSize: TCCSizeUInt; const aOutData: TCCPtr; const aOutLimit: TCCSizeUInt): TCCSizeUInt;
begin
  Result := 0;
end;

function TCompressor.Decompress(const aInData: TCCPtr; const aInSize: TCCSizeUInt; const aOutData: TCCPtr; const aOutLimit: TCCSizeUInt): TCCSizeUInt;
begin
  Result := 0;
end;

procedure TCompressor.CompressStream(sour: TCoreClassStream; StartPos, EndPos: NativeInt; CompressTo: TCoreClassStream);
type
  TPrepareBuff = array [0 .. PrepareBuffSize + 2] of Byte;
  PPrepareBuff = ^TPrepareBuff;

var
  buff: array [0 .. ChunkSize] of Byte;
  PrepareBuffPtr: PPrepareBuff;
  siz: Int64;
  j: NativeInt;
  Num: NativeInt;
  Rest: NativeInt;
begin
  siz := EndPos - StartPos;
  if siz > 0 then
    begin
      CompressTo.write(siz, 8);
      sour.Position := StartPos;

      new(PrepareBuffPtr);
      if siz > ChunkSize then
        begin
          Num := siz div ChunkSize;
          Rest := siz mod ChunkSize;

          for j := 0 to Num - 1 do
            begin
              sour.read(buff[0], ChunkSize);
              PWORD(@(PrepareBuffPtr^[0]))^ := Compress(@buff[0], ChunkSize, @PrepareBuffPtr^[2], PrepareBuffSize);
              CompressTo.write(PrepareBuffPtr^[0], PWORD(@(PrepareBuffPtr^[0]))^ + 2);
            end;

          if Rest > 0 then
            begin
              sour.read(buff[0], Rest);
              PWORD(@(PrepareBuffPtr^[0]))^ := Compress(@buff[0], Rest, @PrepareBuffPtr^[2], PrepareBuffSize);
              CompressTo.write(PrepareBuffPtr^[0], PWORD(@(PrepareBuffPtr^[0]))^ + 2);
            end;
        end
      else
        begin
          sour.read(buff[0], siz);
          PWORD(@(PrepareBuffPtr^[0]))^ := Compress(@buff[0], siz, @PrepareBuffPtr^[2], PrepareBuffSize);
          CompressTo.write(PrepareBuffPtr^[0], PWORD(@(PrepareBuffPtr^[0]))^ + 2);
        end;
      Dispose(PrepareBuffPtr);
    end;
end;

procedure TCompressor.DecompressStream(sour, DecompressTo: TCoreClassStream);
var
  siz, cSiz: Int64;
  bufSiz, deBufSiz: Word;
  buff, decryptBuff: Pointer;
begin
  if sour.Position + 10 < sour.Size then
    begin
      sour.read(siz, 8);
      cSiz := 0;

      buff := GetMemory(PrepareBuffSize);
      decryptBuff := GetMemory(PrepareBuffSize);
      while cSiz < siz do
        begin
          if sour.read(bufSiz, 2) <> 2 then
              Break;
          if sour.read(buff^, bufSiz) <> bufSiz then
              Break;

          deBufSiz := Decompress(buff, bufSiz, decryptBuff, PrepareBuffSize);
          DecompressTo.write(decryptBuff^, deBufSiz);
          inc(cSiz, deBufSiz);
        end;
      FreeMemory(buff);
      FreeMemory(decryptBuff);
    end;
end;

constructor TCompressorDeflate.Create;
  procedure BuildFixedTrees(var aLT, aDT: TTree);
  var
    i: TCCInt32;
  begin
    for i := 0 to 6 do
      begin
        aLT.Table[i] := 0;
      end;
    aLT.Table[7] := 24;
    aLT.Table[8] := 152;
    aLT.Table[9] := 112;
    for i := 0 to 23 do
        aLT.Translation[i] := 256 + i;
    for i := 0 to 143 do
        aLT.Translation[24 + i] := i;
    for i := 0 to 7 do
        aLT.Translation[168 + i] := 280 + i;
    for i := 0 to 111 do
        aLT.Translation[176 + i] := 144 + i;
    for i := 0 to 4 do
        aDT.Table[i] := 0;
    aDT.Table[5] := 32;
    for i := 0 to 31 do
        aDT.Translation[i] := i;
  end;
  procedure BuildBitsBase(aBits: PCCUInt8Array; aBase: PCCUInt16; aDelta, aFirst: TCCInt32);
  var
    i, Sum: TCCInt32;
  begin
    for i := 0 to aDelta - 1 do
        aBits^[i] := 0;
    for i := 0 to (30 - aDelta) - 1 do
        aBits^[i + aDelta] := i div aDelta;
    Sum := aFirst;
    for i := 0 to 29 do
      begin
        aBase^ := Sum;
        inc(aBase);
        inc(Sum, 1 shl aBits^[i]);
      end;
  end;

var
  index, ValueIndex: TCCInt32;
begin
  inherited Create;
  for index := 0 to length(LengthCodes) - 1 do
    for ValueIndex := IfThen(index = 0, 0, LengthCodes[index, 2]) to LengthCodes[index, 3] do
        fLengthCodesLookUpTable[ValueIndex] := index;
  for index := 0 to length(DistanceCodes) - 1 do
    for ValueIndex := IfThen(index = 0, 0, DistanceCodes[index, 2]) to DistanceCodes[index, 3] do
        fDistanceCodesLookUpTable[ValueIndex] := index;

  FillPtrByte(@fLengthBits, SizeOf(TBits), 0);
  FillPtrByte(@fDistanceBits, SizeOf(TBits), 0);
  FillPtrByte(@fLengthBase, SizeOf(TBase), 0);
  FillPtrByte(@fDistanceBase, SizeOf(TBase), 0);
  FillPtrByte(@fFixedSymbolLengthTree, SizeOf(TTree), 0);
  FillPtrByte(@fFixedDistanceTree, SizeOf(TTree), 0);
  BuildFixedTrees(fFixedSymbolLengthTree, fFixedDistanceTree);
  BuildBitsBase(TCCPtr(@fLengthBits[0]), PCCUInt16(TCCPtr(@fLengthBase[0])), 4, 3);
  BuildBitsBase(TCCPtr(@fDistanceBits[0]), PCCUInt16(TCCPtr(@fDistanceBase[0])), 2, 1);
  fLengthBits[28] := 0;
  fLengthBase[28] := 258;
  fWithHeader := False;
  fGreedy := False;
  fSkipStrength := 32;
  fMaxSteps := 128;
end;

destructor TCompressorDeflate.Destroy;
begin
  inherited Destroy;
end;

function TCompressorDeflate.Compress(const aInData: TCCPtr; const aInSize: TCCSizeUInt; const aOutData: TCCPtr; const aOutLimit: TCCSizeUInt): TCCSizeUInt;
var
  OutputBits, CountOutputBits: TCCUInt32;
  DestLen: TCCSizeUInt;
  OK: Boolean;
  procedure DoOutputBits(const aBits, aCountBits: TCCUInt32);
  begin
    Assert((CountOutputBits + aCountBits) <= 32);
    OutputBits := OutputBits or (aBits shl CountOutputBits);
    inc(CountOutputBits, aCountBits);
    while CountOutputBits >= 8 do
      begin
        if DestLen < aOutLimit then
          begin
            PCCUInt8Array(aOutData)^[DestLen] := OutputBits and $FF;
            inc(DestLen);
          end
        else
          begin
            OK := False;
          end;
        OutputBits := OutputBits shr 8;
        dec(CountOutputBits, 8);
      end;
  end;
  procedure DoOutputLiteral(const AValue: TCCUInt8);
  begin
    case AValue of
      0 .. 143: DoOutputBits(MirrorBytes[$30 + AValue], 8);
      else DoOutputBits((MirrorBytes[$90 + (AValue - 144)] shl 1) or 1, 9);
    end;
  end;
  procedure DoOutputCopy(const aDistance, aLength: TCCUInt32);
  var
    Remain, ToDo, index: TCCUInt32;
  begin
    Remain := aLength;
    while Remain > 0 do
      begin
        case Remain of
          0 .. 258: ToDo := Remain;
          259 .. 260: ToDo := Remain - 3;
          else ToDo := 258;
        end;
        dec(Remain, ToDo);
        index := fLengthCodesLookUpTable[Min(Max(ToDo, 0), 258)];
        if LengthCodes[index, 0] <= 279 then
            DoOutputBits(MirrorBytes[(LengthCodes[index, 0] - 256) shl 1], 7)
        else
            DoOutputBits(MirrorBytes[$C0 + (LengthCodes[index, 0] - 280)], 8);
        if LengthCodes[index, 1] <> 0 then
            DoOutputBits(ToDo - LengthCodes[index, 2], LengthCodes[index, 1]);
        index := fDistanceCodesLookUpTable[Min(Max(aDistance, 0), 32768)];
        DoOutputBits(MirrorBytes[DistanceCodes[index, 0] shl 3], 5);
        if DistanceCodes[index, 1] <> 0 then
            DoOutputBits(aDistance - DistanceCodes[index, 2], DistanceCodes[index, 1]);
      end;
  end;
  procedure OutputStartBlock;
  begin
    DoOutputBits(1, 1); // Final block
    DoOutputBits(1, 2); // Static huffman block
  end;
  procedure OutputEndBlock;
  begin
    DoOutputBits(0, 7); // Close block
    DoOutputBits(0, 7); // Make sure all bits are flushed
  end;
  function Adler32(const aData: TCCPtr; const aLength: TCCUInt32): TCCUInt32;
  const
    Base = 65521;
    MaximumCountAtOnce = 5552;
  var
    Buf: PCCUInt8;
    Remain, s1, s2, ToDo, index: TCCUInt32;
  begin
    s1 := 1;
    s2 := 0;
    Buf := aData;
    Remain := aLength;
    while Remain > 0 do
      begin
        if Remain < MaximumCountAtOnce then
            ToDo := Remain
        else
            ToDo := MaximumCountAtOnce;
        dec(Remain, ToDo);
        for index := 1 to ToDo do
          begin
            inc(s1, TCCUInt8(Buf^));
            inc(s2, s1);
            inc(Buf);
          end;
        s1 := s1 mod Base;
        s2 := s2 mod Base;
      end;
    Result := (s2 shl 16) or s1;
  end;

var
  CurrentPointer, EndPointer, EndSearchPointer, Head, CurrentPossibleMatch: PCCUInt8;
  BestMatchDistance, BestMatchLength, MatchLength, CheckSum, Step, Difference, Offset, UnsuccessfulFindMatchAttempts: TCCUInt32;
  HashTableItem: PPCCUInt8;
begin
  OK := True;
  DestLen := 0;
  OutputBits := 0;
  CountOutputBits := 0;
  if fWithHeader then
    begin
      DoOutputBits($78, 8); // CMF
      DoOutputBits($9C, 8); // FLG Default Compression
    end;
  OutputStartBlock;
  FillPtrByte(@fHashTable, SizeOf(THashTable), 0);
  FillPtrByte(@fChainTable, SizeOf(TChainTable), 0);
  CurrentPointer := aInData;
  EndPointer := TCCPtr(TCCPtrUInt(TCCPtrUInt(CurrentPointer) + TCCPtrUInt(aInSize)));
  EndSearchPointer := TCCPtr(TCCPtrUInt((TCCPtrUInt(CurrentPointer) + TCCPtrUInt(aInSize)) - TCCPtrUInt(TCCInt64(Max(TCCInt64(MinMatch), TCCInt64(SizeOf(TCCUInt32)))))));
  UnsuccessfulFindMatchAttempts := TCCUInt32(1) shl fSkipStrength;
  while TCCPtrUInt(CurrentPointer) < TCCPtrUInt(EndSearchPointer) do
    begin
      HashTableItem := @fHashTable[((((PCCUInt32(TCCPtr(CurrentPointer))^ and TCCUInt32(HashRef_ENDIAN_B30){$IF defined(BIG_ENDIAN)} shr 8{$IFEND})) * TCCUInt32($1E35A7BD)) shr HashShift) and HashMask];
      Head := HashTableItem^;
      CurrentPossibleMatch := Head;
      BestMatchDistance := 0;
      BestMatchLength := 1;
      Step := 0;
      while Assigned(CurrentPossibleMatch) and
        (TCCPtrUInt(CurrentPointer) > TCCPtrUInt(CurrentPossibleMatch)) and
        (TCCPtrInt(TCCPtrUInt(TCCPtrUInt(CurrentPointer) - TCCPtrUInt(CurrentPossibleMatch))) < TCCPtrInt(MaxOffset)) do
        begin
          Difference := PCCUInt32(TCCPtr(@PCCUInt8Array(CurrentPointer)^[0]))^ xor PCCUInt32(TCCPtr(@PCCUInt8Array(CurrentPossibleMatch)^[0]))^;
          if (Difference and TCCUInt32(HashRef_ENDIAN_B30)) = 0 then
            begin
              if (BestMatchLength <= (TCCPtrUInt(EndPointer) - TCCPtrUInt(CurrentPointer))) and
                (PCCUInt8Array(CurrentPointer)^[BestMatchLength - 1] = PCCUInt8Array(CurrentPossibleMatch)^[BestMatchLength - 1]) then
                begin
                  MatchLength := MinMatch;

                  while ((TCCPtrUInt(@PCCUInt8Array(CurrentPointer)^[MatchLength]) and (SizeOf(TCCUInt32) - 1)) <> 0) and
                    ((TCCPtrUInt(@PCCUInt8Array(CurrentPointer)^[MatchLength]) < TCCPtrUInt(EndPointer))) and
                    (PCCUInt8Array(CurrentPointer)^[MatchLength] = PCCUInt8Array(CurrentPossibleMatch)^[MatchLength]) do
                      inc(MatchLength);

                  while (TCCPtrUInt(@PCCUInt8Array(CurrentPointer)^[MatchLength + (SizeOf(TCCUInt32) - 1)]) < TCCPtrUInt(EndPointer)) do
                    begin
                      Difference := PCCUInt32(TCCPtr(@PCCUInt8Array(CurrentPointer)^[MatchLength]))^ xor PCCUInt32(TCCPtr(@PCCUInt8Array(CurrentPossibleMatch)^[MatchLength]))^;
                      if Difference = 0 then
                        begin
                          inc(MatchLength, SizeOf(TCCUInt32));
                        end
                      else
                        begin
{$IF defined(BIG_ENDIAN)}
                          if (Difference shr 16) <> 0 then
                              inc(MatchLength, not(Difference shr 24))
                          else
                              inc(MatchLength, 2 + (not(Difference shr 8)));
{$ELSE}
                          inc(MatchLength, MultiplyDeBruijnBytePosition[TCCUInt32(TCCUInt32(Difference and (-Difference)) * TCCUInt32($077CB531)) shr 27]);
{$IFEND}
                          Break;
                        end;
                    end;
                  if BestMatchLength < MatchLength then
                    begin
                      BestMatchDistance := TCCPtrUInt(TCCPtrUInt(CurrentPointer) - TCCPtrUInt(CurrentPossibleMatch));
                      BestMatchLength := MatchLength;
                    end;
                end;
            end;
          inc(Step);
          if Step < fMaxSteps then
              CurrentPossibleMatch := fChainTable[(TCCPtrUInt(CurrentPossibleMatch) - TCCPtrUInt(aInData)) and WindowMask]
          else
              Break;
        end;
      if (BestMatchDistance > 0) and (BestMatchLength > 1) then
        begin
          DoOutputCopy(BestMatchDistance, BestMatchLength);
          UnsuccessfulFindMatchAttempts := TCCUInt32(1) shl fSkipStrength;
        end
      else
        begin
          if fSkipStrength > 31 then
            begin
              DoOutputLiteral(CurrentPointer^);
            end
          else
            begin
              Step := UnsuccessfulFindMatchAttempts shr fSkipStrength;
              Offset := 0;
              while (Offset < Step) and ((TCCPtrUInt(CurrentPointer) + Offset) < TCCPtrUInt(EndSearchPointer)) do
                begin
                  DoOutputLiteral(PCCUInt8Array(CurrentPointer)^[Offset]);
                  inc(Offset);
                end;
              BestMatchLength := Offset;
              inc(UnsuccessfulFindMatchAttempts, Ord(UnsuccessfulFindMatchAttempts < TCCUInt32($FFFFFFFF)) and 1);
            end;
        end;

      if not OK then
          Break;

      HashTableItem^ := CurrentPointer;
      fChainTable[(TCCPtrUInt(CurrentPointer) - TCCPtrUInt(aInData)) and WindowMask] := Head;
      if fGreedy then
        begin
          inc(CurrentPointer);
          dec(BestMatchLength);
          while (BestMatchLength > 0) and (TCCPtrUInt(CurrentPointer) < TCCPtrUInt(EndSearchPointer)) do
            begin
              HashTableItem := @fHashTable[((((PCCUInt32(TCCPtr(CurrentPointer))^ and TCCUInt32(HashRef_ENDIAN_B30){$IF defined(BIG_ENDIAN)} shr 8{$IFEND})) * TCCUInt32($1E35A7BD)) shr HashShift) and HashMask];
              Head := HashTableItem^;
              HashTableItem^ := CurrentPointer;
              fChainTable[(TCCPtrUInt(CurrentPointer) - TCCPtrUInt(aInData)) and WindowMask] := Head;
              inc(CurrentPointer);
              dec(BestMatchLength);
            end;
        end;
      inc(CurrentPointer, BestMatchLength);
    end;
  while TCCPtrUInt(CurrentPointer) < TCCPtrUInt(EndPointer) do
    begin
      DoOutputLiteral(CurrentPointer^);

      if not OK then
          Break;

      inc(CurrentPointer);
    end;
  OutputEndBlock;
  if fWithHeader then
    begin
      CheckSum := Adler32(aInData, aInSize);
      if (DestLen + 4) < aOutLimit then
        begin
          PCCUInt8Array(aOutData)^[DestLen + 0] := (CheckSum shr 24) and $FF;
          PCCUInt8Array(aOutData)^[DestLen + 1] := (CheckSum shr 16) and $FF;
          PCCUInt8Array(aOutData)^[DestLen + 2] := (CheckSum shr 8) and $FF;
          PCCUInt8Array(aOutData)^[DestLen + 3] := (CheckSum shr 0) and $FF;
          inc(DestLen, 4);
        end;
    end;

  if OK then
      Result := DestLen
  else
      Result := 0;
end;

function TCompressorDeflate.Decompress(const aInData: TCCPtr; const aInSize: TCCSizeUInt; const aOutData: TCCPtr; const aOutLimit: TCCSizeUInt): TCCSizeUInt;
var
  Tag, BitCount: TCCUInt32;
  Source, SourceEnd: PCCUInt8;
  dest: PCCUInt8;
  DestLen: TCCSizeUInt;
  function Adler32(aData: TCCPtr; aLength: TCCUInt32): TCCUInt32;
  const
    Base = 65521;
    NMAX = 5552;
  var
    Buf: PCCUInt8;
    s1, s2, k, i: TCCUInt32;
  begin
    s1 := 1;
    s2 := 0;
    Buf := aData;
    while aLength > 0 do
      begin
        if aLength < NMAX then
            k := aLength
        else
            k := NMAX;
        dec(aLength, k);
        for i := 1 to k do
          begin
            inc(s1, TCCUInt8(Buf^));
            inc(s2, s1);
            inc(Buf);
          end;
        s1 := s1 mod Base;
        s2 := s2 mod Base;
      end;
    Result := (s2 shl 16) or s1;
  end;
  procedure BuildTree(var aTree: TTree; aLengths: PCCUInt8Array; aNum: TCCInt32);
  var
    Offsets: TOffsets;
    i: TCCInt32;
    Sum: TCCUInt32;
  begin
    for i := 0 to 15 do
        aTree.Table[i] := 0;
    for i := 0 to aNum - 1 do
        inc(aTree.Table[TCCUInt8(aLengths^[i])]);
    aTree.Table[0] := 0;
    Sum := 0;
    for i := 0 to 15 do
      begin
        Offsets[i] := Sum;
        inc(Sum, aTree.Table[i]);
      end;
    for i := 0 to aNum - 1 do
      if aLengths^[i] <> 0 then
        begin
          aTree.Translation[Offsets[TCCUInt8(aLengths^[i])]] := i;
          inc(Offsets[TCCUInt8(aLengths^[i])]);
        end;
  end;
  function GetBit: TCCUInt32;
  begin
    if BitCount = 0 then
      begin
        Tag := TCCUInt8(Source^);
        inc(Source);
        BitCount := 7;
      end
    else
        dec(BitCount);
    Result := Tag and 1;
    Tag := Tag shr 1;
  end;
  function ReadBits(aNum, aBase: TCCUInt32): TCCUInt32;
  var
    Limit, Mask: TCCUInt32;
  begin
    Result := 0;
    if aNum <> 0 then
      begin
        Limit := 1 shl aNum;
        Mask := 1;
        while Mask < Limit do
          begin
            if GetBit <> 0 then
                inc(Result, Mask);
            Mask := Mask shl 1;
          end;
      end;
    inc(Result, aBase);
  end;
  function DecodeSymbol(const aTree: TTree): TCCUInt32;
  var
    Sum, c, L: TCCInt32;
  begin
    Sum := 0;
    c := 0;
    L := 0;
    repeat
      c := (c * 2) + TCCInt32(GetBit);
      inc(L);
      inc(Sum, aTree.Table[L]);
      dec(c, aTree.Table[L]);
    until not(c >= 0);
    Result := aTree.Translation[Sum + c];
  end;
  procedure DecodeTrees(var aLT, aDT: TTree);
  var
    hlit, hdist, hclen, i, Num, Len, clen, Symbol, Prev: TCCUInt32;
  begin
    FillPtrByte(@fCodeTree, SizeOf(TTree), 0);
    FillPtrByte(@fLengths, SizeOf(TLengths), 0);
    hlit := ReadBits(5, 257);
    hdist := ReadBits(5, 1);
    hclen := ReadBits(4, 4);
    for i := 0 to 18 do
        fLengths[i] := 0;
    for i := 1 to hclen do
      begin
        clen := ReadBits(3, 0);
        fLengths[CLCIndex[i - 1]] := clen;
      end;
    BuildTree(fCodeTree, TCCPtr(@fLengths[0]), 19);
    Num := 0;
    while Num < (hlit + hdist) do
      begin
        Symbol := DecodeSymbol(fCodeTree);
        case Symbol of
          16:
            begin
              Prev := fLengths[Num - 1];
              Len := ReadBits(2, 3);
              while Len > 0 do
                begin
                  fLengths[Num] := Prev;
                  inc(Num);
                  dec(Len);
                end;
            end;
          17:
            begin
              Len := ReadBits(3, 3);
              while Len > 0 do
                begin
                  fLengths[Num] := 0;
                  inc(Num);
                  dec(Len);
                end;
            end;
          18:
            begin
              Len := ReadBits(7, 11);
              while Len > 0 do
                begin
                  fLengths[Num] := 0;
                  inc(Num);
                  dec(Len);
                end;
            end;
          else
            begin
              fLengths[Num] := Symbol;
              inc(Num);
            end;
        end;
      end;
    BuildTree(aLT, TCCPtr(@fLengths[0]), hlit);
    BuildTree(aDT, TCCPtr(@fLengths[hlit]), hdist);
  end;
  function InflateBlockData(const aLT, aDT: TTree): Boolean;
  var
    Symbol: TCCUInt32;
    Len, Distance, Offset: TCCInt32;
    t: PCCUInt8;
  begin
    Result := False;
    while (TCCPtrUInt(TCCPtr(Source)) < TCCPtrUInt(TCCPtr(SourceEnd))) or (BitCount > 0) do
      begin
        Symbol := DecodeSymbol(aLT);
        if Symbol = 256 then
          begin
            Result := True;
            Break;
          end;
        if Symbol < 256 then
          begin
            if (DestLen + 1) <= aOutLimit then
              begin
                dest^ := TCCUInt8(Symbol);
                inc(dest);
                inc(DestLen);
              end
            else
                Exit;
          end
        else
          begin
            dec(Symbol, 257);
            Len := ReadBits(fLengthBits[Symbol], fLengthBase[Symbol]);
            Distance := DecodeSymbol(aDT);
            Offset := ReadBits(fDistanceBits[Distance], fDistanceBase[Distance]);
            if (DestLen + TCCSizeUInt(Len)) <= aOutLimit then
              begin
                t := TCCPtr(dest);
                dec(t, Offset);
                RLELikeSideEffectAwareMemoryMove(t^, dest^, Len);
                inc(dest, Len);
                inc(DestLen, Len);
              end
            else
                Exit;
          end;
      end;
  end;
  function InflateUncompressedBlock: Boolean;
  var
    Len, InvLen: TCCUInt32;
  begin
    Result := False;
    Len := (TCCUInt8(PCCUInt8Array(Source)^[1]) shl 8) or TCCUInt8(PCCUInt8Array(Source)^[0]);
    InvLen := (TCCUInt8(PCCUInt8Array(Source)^[3]) shl 8) or TCCUInt8(PCCUInt8Array(Source)^[2]);
    if Len <> ((not InvLen) and $FFFF) then
        Exit;
    inc(Source, 4);
    if Len > 0 then
      begin
        if (DestLen + Len) < aOutLimit then
          begin
            CopyPtr(Source, dest, Len);
            inc(Source, Len);
            inc(dest, Len);
          end
        else
            Exit;
      end;
    BitCount := 0;
    inc(DestLen, Len);
    Result := True;
  end;
  function InflateFixedBlock: Boolean;
  begin
    Result := InflateBlockData(fFixedSymbolLengthTree, fFixedDistanceTree);
  end;
  function InflateDynamicBlock: Boolean;
  begin
    FillPtrByte(@fSymbolLengthTree, SizeOf(TTree), 0);
    FillPtrByte(@fDistanceTree, SizeOf(TTree), 0);
    DecodeTrees(fSymbolLengthTree, fDistanceTree);
    Result := InflateBlockData(fSymbolLengthTree, fDistanceTree);
  end;
  function Uncompress: Boolean;
  var
    FinalBlock: Boolean;
    BlockType: TCCUInt32;
  begin
    BitCount := 0;
    repeat
      FinalBlock := GetBit <> 0;
      BlockType := ReadBits(2, 0);
      case BlockType of
        0:
          begin
            Result := InflateUncompressedBlock;
          end;
        1:
          begin
            Result := InflateFixedBlock;
          end;
        2:
          begin
            Result := InflateDynamicBlock;
          end;
        else
          begin
            Result := False;
          end;
      end;
    until FinalBlock or not Result;
  end;
  function UncompressZLIB: Boolean;
  var
    cmf, flg: TCCUInt8;
    a32: TCCUInt32;
  begin
    Result := False;
    Source := aInData;
    cmf := TCCUInt8(PCCUInt8Array(Source)^[0]);
    flg := TCCUInt8(PCCUInt8Array(Source)^[1]);
    if ((((cmf shl 8) + flg) mod 31) <> 0) or ((cmf and $F) <> 8) or ((cmf shr 4) > 7) or ((flg and $20) <> 0) then
      begin
        Exit;
      end;
    a32 := (TCCUInt8(PCCUInt8Array(Source)^[aInSize - 4]) shl 24) or
      (TCCUInt8(PCCUInt8Array(Source)^[aInSize - 3]) shl 16) or
      (TCCUInt8(PCCUInt8Array(Source)^[aInSize - 2]) shl 8) or
      (TCCUInt8(PCCUInt8Array(Source)^[aInSize - 1]) shl 0);
    inc(Source, 2);
    SourceEnd := @PCCUInt8Array(Source)^[aInSize - 6];
    Result := Uncompress;
    if not Result then
      begin
        Exit;
      end;
    Result := Adler32(aOutData, DestLen) = a32;
  end;
  function UncompressDirect: Boolean;
  begin
    Source := aInData;
    SourceEnd := @PCCUInt8Array(Source)^[aInSize];
    Result := Uncompress;
  end;

begin
  dest := aOutData;
  DestLen := 0;
  Result := 0;
  if fWithHeader then
    begin
      if UncompressZLIB then
        begin
          Result := DestLen;
        end;
    end
  else
    begin
      if UncompressDirect then
        begin
          Result := DestLen;
        end;
    end;
end;

constructor TCompressorBRRC.Create;
begin
  inherited Create;
end;

destructor TCompressorBRRC.Destroy;
begin
  inherited Destroy;
end;

function TCompressorBRRC.Compress(const aInData: TCCPtr; const aInSize: TCCSizeUInt; const aOutData: TCCPtr; const aOutLimit: TCCSizeUInt): TCCSizeUInt;
var
{$IFNDEF CPU64}Code, {$ENDIF}Range, Cache, CountFFBytes: TCCUInt32;
{$IFDEF CPU64}Code: TCCUInt64; {$ENDIF}
  Model: array [0 .. SizeModels - 1] of TCCUInt32;
  OK, FirstByte{$IFNDEF CPU64}, Carry{$ENDIF} : Boolean;
  DestLen: TCCInt32;
  procedure EncoderShift;
{$IFDEF CPU64}
  var
    Carry: Boolean;
{$ENDIF}
  begin
{$IFDEF CPU64}
    Carry := PCCUInt64Record(TCCPtr(@Code))^.Hi <> 0; // or (Code shr 32)<>0; or also (Code and TCCUInt64($ffffffff00000000))<>0;
{$ENDIF}
    if (Code < $FF000000) or Carry then
      begin
        if FirstByte then
          begin
            FirstByte := False;
          end
        else
          begin
            if TCCSizeUInt(DestLen) < TCCSizeUInt(aOutLimit) then
              begin
                PCCUInt8Array(aOutData)^[DestLen] := TCCUInt8(Cache + TCCUInt8(Ord(Carry) and 1));
                inc(DestLen);
              end
            else
              begin
                OK := False;
                Exit;
              end;
          end;
        while CountFFBytes <> 0 do
          begin
            dec(CountFFBytes);
            if TCCSizeUInt(DestLen) < TCCSizeUInt(aOutLimit) then
              begin
                PCCUInt8Array(aOutData)^[DestLen] := TCCUInt8($FF + TCCUInt8(Ord(Carry) and 1));
                inc(DestLen);
              end
            else
              begin
                OK := False;
                Exit;
              end;
          end;
        Cache := (Code shr 24) and $FF;
      end
    else
      begin
        inc(CountFFBytes);
      end;
    Code := (Code shl 8){$IFDEF CPU64} and TCCUInt32($FFFFFFFF){$ENDIF};
    Carry := False;
  end;
  function EncodeBit(ModelIndex, Move, Bit: TCCInt32): TCCInt32;
  var
    Bound{$IFNDEF CPU64}, OldCode{$ENDIF}: TCCUInt32;
  begin
    Bound := (Range shr 12) * Model[ModelIndex];
    if Bit = 0 then
      begin
        Range := Bound;
        inc(Model[ModelIndex], (4096 - Model[ModelIndex]) shr Move);
      end
    else
      begin
{$IFNDEF CPU64}
        OldCode := Code;
{$ENDIF}
        inc(Code, Bound);
{$IFNDEF CPU64}
        Carry := Carry or (Code < OldCode);
{$ENDIF}
        dec(Range, Bound);
        dec(Model[ModelIndex], Model[ModelIndex] shr Move);
      end;
    while Range < $1000000 do
      begin
        Range := Range shl 8;
        EncoderShift;
      end;
    Result := Bit;
  end;
  procedure EncoderFlush;
  var
    Counter: TCCInt32;
  begin
    for Counter := 1 to 5 do
        EncoderShift;
  end;
  procedure EncodeTree(ModelIndex, Bits, Move, Value: TCCInt32);
  var
    Context: TCCInt32;
  begin
    Context := 1;
    while Bits > 0 do
      begin
        dec(Bits);
        Context := (Context shl 1) or EncodeBit(ModelIndex + Context, Move, (Value shr Bits) and 1);
      end;
  end;

var
  CurrentPointer, EndPointer: PCCUInt8;
  Len, MinDestLen: TCCInt32;
begin
  DestLen := 0;
  FirstByte := True;
  OK := True;
  CountFFBytes := 0;
  Range := $FFFFFFFF;
  Code := 0;
  for Len := 0 to SizeModels - 1 do
    begin
      Model[Len] := 2048;
    end;
  CurrentPointer := aInData;
  EndPointer := TCCPtr(TCCPtrUInt(TCCPtrUInt(CurrentPointer) + TCCPtrUInt(aInSize)));
  while TCCPtrUInt(CurrentPointer) < TCCPtrUInt(EndPointer) do
    begin
      EncodeBit(FlagModel, 1, 1);
      EncodeTree(LiteralModel, 8, 4, PCCUInt8(CurrentPointer)^);
      if not OK then
        begin
          Break;
        end;
      inc(CurrentPointer);
    end;
  EncodeBit(FlagModel, 1, 0);
  MinDestLen := Max(2, DestLen + 1);
  EncoderFlush;
  if OK then
    begin
      while (DestLen > MinDestLen) and (PCCUInt8Array(aOutData)^[DestLen - 1] = 0) do
          dec(DestLen);
      Result := DestLen;
    end
  else
      Result := 0;
end;

function TCompressorBRRC.Decompress(const aInData: TCCPtr; const aInSize: TCCSizeUInt; const aOutData: TCCPtr; const aOutLimit: TCCSizeUInt): TCCSizeUInt;
var
  Code, Range, Position: TCCUInt32;
  Model: array [0 .. SizeModels - 1] of TCCUInt32;
  OK: Boolean;
  function DecodeBit(ModelIndex, Move: TCCInt32): TCCInt32;
  var
    Bound: TCCUInt32;
  begin
    Bound := (Range shr 12) * Model[ModelIndex];
    if Code < Bound then
      begin
        Range := Bound;
        inc(Model[ModelIndex], (4096 - Model[ModelIndex]) shr Move);
        Result := 0;
      end
    else
      begin
        dec(Code, Bound);
        dec(Range, Bound);
        dec(Model[ModelIndex], Model[ModelIndex] shr Move);
        Result := 1;
      end;
    while Range < $1000000 do
      begin
        if Position < aInSize then
            Code := (Code shl 8) or PCCUInt8Array(aInData)^[Position]
        else
          begin
            if Position < (aInSize + 4 + 5) then
                Code := Code shl 8
            else
              begin
                OK := False;
                Break;
              end;
          end;
        inc(Position);
        Range := Range shl 8;
      end;
  end;
  function DecodeTree(ModelIndex, MaxValue, Move: TCCInt32): TCCInt32;
  begin
    Result := 1;
    while OK and (Result < MaxValue) do
        Result := (Result shl 1) or DecodeBit(ModelIndex + Result, Move);
    dec(Result, MaxValue);
  end;

var
  DestLen, Value: TCCInt32;
begin
  Result := 0;
  if aInSize >= 3 then
    begin
      OK := True;
      Code := (PCCUInt8Array(aInData)^[0] shl 24) or
        (PCCUInt8Array(aInData)^[1] shl 16) or
        (PCCUInt8Array(aInData)^[2] shl 8) or
        (PCCUInt8Array(aInData)^[3] shl 0);
      Position := 4;
      Range := $FFFFFFFF;
      for Value := 0 to SizeModels - 1 do
        begin
          Model[Value] := 2048;
        end;
      DestLen := 0;
      repeat
        Value := DecodeBit(FlagModel, 1);
        if OK then
          begin
            if Value <> 0 then
              begin
                Value := DecodeTree(LiteralModel, 256, 4);
                if OK and (TCCSizeUInt(DestLen) < TCCSizeUInt(aOutLimit)) then
                  begin
                    PCCUInt8Array(aOutData)^[DestLen] := Value;
                    inc(DestLen);
                  end
                else
                    Exit;
              end
            else
                Break;
          end
        else
            Exit;
      until False;

      Result := DestLen;
    end;
end;

{$IFDEF RangeCheck}{$R+}{$ENDIF}


end.