ulzmaencoder.pas

Pascal lzma 算法实现,可以直接在delphi中使用,Delphi 2007 是用这个东西发包的

unit ULZMAEncoder;

{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}

interface

uses UBitTreeEncoder,ULZMABase,ULZBinTree,URangeEncoder,Classes,Math,ULZMACommon;

const EMatchFinderTypeBT2 = 0;
      EMatchFinderTypeBT4 = 1;
      kIfinityPrice:integer = $FFFFFFF;
      kDefaultDictionaryLogSize = 22;
      kNumFastBytesDefault = $20;
      kNumLenSpecSymbols = ULZMABase.kNumLowLenSymbols + ULZMABase.kNumMidLenSymbols;
      kNumOpts = 1 shl 12;
      kPropSize = 5;

type TLZMAEncoder2=class;
     TLZMALiteralEncoder=class;
     TLZMAOptimal=class;
     TLZMALenPriceTableEncoder=class;

     TLZMAEncoder=class
       private
         FOnProgress:TLZMAProgress;
         procedure DoProgress(const Action:TLZMAProgressAction;const Value:integer);
       public
         g_FastPos:array [0..1 shl 11-1] of byte;
         _state:integer;
         _previousByte:byte;
         _repDistances:array [0..ULZMABase.kNumRepDistances-1] of integer;

         _optimum: array [0..kNumOpts-1] of TLZMAOptimal;
         _matchFinder:TLZBinTree;
         _rangeEncoder:TRangeEncoder;

         _isMatch:array [0..ULZMABase.kNumStates shl ULZMABase.kNumPosStatesBitsMax-1]of smallint;
         _isRep:array [0..ULZMABase.kNumStates-1] of smallint;
         _isRepG0:array [0..ULZMABase.kNumStates-1] of smallint;
         _isRepG1:array [0..ULZMABase.kNumStates-1] of smallint;
         _isRepG2:array [0..ULZMABase.kNumStates-1] of smallint;
         _isRep0Long:array [0..ULZMABase.kNumStates shl ULZMABase.kNumPosStatesBitsMax-1]of smallint;

         _posSlotEncoder:array [0..ULZMABase.kNumLenToPosStates-1] of TBitTreeEncoder; // kNumPosSlotBits

         _posEncoders:array [0..ULZMABase.kNumFullDistances-ULZMABase.kEndPosModelIndex-1]of smallint;
         _posAlignEncoder:TBitTreeEncoder;

         _lenEncoder:TLZMALenPriceTableEncoder;
         _repMatchLenEncoder:TLZMALenPriceTableEncoder;

         _literalEncoder:TLZMALiteralEncoder;

         _matchDistances:array [0..ULZMABase.kMatchMaxLen*2+1] of integer;

         _numFastBytes:integer;
         _longestMatchLength:integer;
         _numDistancePairs:integer;

         _additionalOffset:integer;

         _optimumEndIndex:integer;
         _optimumCurrentIndex:integer;

         _longestMatchWasFound:boolean;

         _posSlotPrices:array [0..1 shl (ULZMABase.kNumPosSlotBits+ULZMABase.kNumLenToPosStatesBits)-1] of integer;
         _distancesPrices:array [0..ULZMABase.kNumFullDistances shl ULZMABase.kNumLenToPosStatesBits-1] of integer;
         _alignPrices:array [0..ULZMABase.kAlignTableSize-1] of integer;
         _alignPriceCount:integer;

         _distTableSize:integer;

         _posStateBits:integer;
         _posStateMask:integer;
         _numLiteralPosStateBits:integer;
         _numLiteralContextBits:integer;

         _dictionarySize:integer;
         _dictionarySizePrev:integer;
         _numFastBytesPrev:integer;

         nowPos64:int64;
         _finished:boolean;
         _inStream:TStream;

         _matchFinderType:integer;
         _writeEndMark:boolean;

         _needReleaseMFStream:boolean;

         reps:array [0..ULZMABase.kNumRepDistances-1]of integer;
         repLens:array [0..ULZMABase.kNumRepDistances-1] of integer;
         backRes:integer;
         processedInSize:int64;
         processedOutSize:int64;
         finished:boolean;
         properties:array [0..kPropSize] of byte;
         tempPrices:array [0..ULZMABase.kNumFullDistances-1]of integer;
         _matchPriceCount:integer;
         constructor Create;
         destructor Destroy;override;
         function GetPosSlot(const pos:integer):integer;
         function GetPosSlot2(const pos:integer):integer;
         procedure BaseInit;
         procedure _Create;
         procedure SetWriteEndMarkerMode(const writeEndMarker:boolean);
         procedure Init;
         function ReadMatchDistances:integer;
         procedure MovePos(const num:integer);
         function GetRepLen1Price(const state,posState:integer):integer;
         function GetPureRepPrice(const repIndex, state, posState:integer):integer;
         function GetRepPrice(const repIndex, len, state, posState:integer):integer;
         function GetPosLenPrice(const pos, len, posState:integer):integer;
         function Backward(cur:integer):integer;
         function GetOptimum(position:integer):integer;
         function ChangePair(const smallDist, bigDist:integer):boolean;
         procedure WriteEndMarker(const posState:integer);
         procedure Flush(const nowPos:integer);
         procedure ReleaseMFStream;
         procedure CodeOneBlock(var inSize,outSize:int64;var finished:boolean);
         procedure FillDistancesPrices;
         procedure FillAlignPrices;
         procedure SetOutStream(const outStream:TStream);
         procedure ReleaseOutStream;
         procedure ReleaseStreams;
         procedure SetStreams(const inStream, outStream:TStream;const inSize, outSize:int64);
         procedure Code(const inStream, outStream:TStream;const inSize, outSize:int64);
         procedure WriteCoderProperties(const outStream:TStream);
         function SetAlgorithm(const algorithm:integer):boolean;
         function SetDictionarySize(dictionarySize:integer):boolean;
         function SeNumFastBytes(const numFastBytes:integer):boolean;
         function SetMatchFinder(const matchFinderIndex:integer):boolean;
         function SetLcLpPb(const lc,lp,pb:integer):boolean;
         procedure SetEndMarkerMode(const endMarkerMode:boolean);
         property OnProgress:TLZMAProgress read FOnProgress write FOnProgress;
       end;

     TLZMALiteralEncoder=class
       public
         m_Coders: array of TLZMAEncoder2;
   m_NumPrevBits:integer;
   m_NumPosBits:integer;
   m_PosMask:integer;
         procedure _Create(const numPosBits,numPrevBits:integer);
         destructor Destroy;override;
         procedure Init;
         function GetSubCoder(const pos:integer;const prevByte:byte):TLZMAEncoder2;
       end;

     TLZMAEncoder2=class
       public
         m_Encoders: array[0..$300-1] of smallint;
         procedure Init;
         procedure Encode(const rangeEncoder:TRangeEncoder;const symbol:byte);
         procedure EncodeMatched(const rangeEncoder:TRangeEncoder;const matchByte,symbol:byte);
         function GetPrice(const matchMode:boolean;const matchByte,symbol:byte):integer;
       end;

     TLZMALenEncoder=class
       public
         _choice:array[0..1] of smallint;
         _lowCoder: array [0..ULZMABase.kNumPosStatesEncodingMax-1] of TBitTreeEncoder;
         _midCoder: array [0..ULZMABase.kNumPosStatesEncodingMax-1] of TBitTreeEncoder;
         _highCoder:TBitTreeEncoder;
         constructor Create;
         destructor Destroy;override;
         procedure Init(const numPosStates:integer);
         procedure Encode(const rangeEncoder:TRangeEncoder;symbol:integer;const posState:integer);virtual;
         procedure SetPrices(const posState,numSymbols:integer;var prices:array of integer;const st:integer);
       end;

     TLZMALenPriceTableEncoder=class(TLZMALenEncoder)
       public
         _prices: array [0..ULZMABase.kNumLenSymbols shl ULZMABase.kNumPosStatesBitsEncodingMax-1] of integer;
         _tableSize:integer;
         _counters: array [0..ULZMABase.kNumPosStatesEncodingMax-1] of integer;
         procedure SetTableSize(const tableSize:integer);
         function GetPrice(const symbol,posState:integer):integer;
         procedure UpdateTable(const posState:integer);
         procedure UpdateTables(const numPosStates:integer);
         procedure Encode(const rangeEncoder:TRangeEncoder;symbol:integer;const posState:integer);override;
       end;

     TLZMAOptimal=class
       public
         State:integer;

         Prev1IsChar:boolean;
         Prev2:boolean;

         PosPrev2:integer;
         BackPrev2:integer;

         Price:integer;
         PosPrev:integer;
         BackPrev:integer;

         Backs0:integer;
         Backs1:integer;
         Backs2:integer;
         Backs3:integer;

         procedure MakeAsChar;
         procedure MakeAsShortRep;
         function IsShortRep:boolean;
       end;

implementation

constructor TLZMAEncoder.Create;
var kFastSlots,c,slotFast,j,k:integer;
begin
kFastSlots := 22;
c := 2;
g_FastPos[0] := 0;
g_FastPos[1] := 1;
for slotFast := 2 to kFastSlots -1 do begin
    k := (1 shl ((slotFast shr 1) - 1));
    for j := 0 to k -1 do begin
        g_FastPos[c] := slotFast;
        inc(c);
        end;
    end;
_state := ULZMABase.StateInit();
_matchFinder:=nil;
_rangeEncoder:=TRangeEncoder.Create;
_posAlignEncoder:=TBitTreeEncoder.Create(ULZMABase.kNumAlignBits);
_lenEncoder:=TLZMALenPriceTableEncoder.Create;
_repMatchLenEncoder:=TLZMALenPriceTableEncoder.Create;
_literalEncoder:=TLZMALiteralEncoder.Create;
_numFastBytes:= kNumFastBytesDefault;
_distTableSize:= (kDefaultDictionaryLogSize * 2);
_posStateBits:= 2;
_posStateMask:= (4 - 1);
_numLiteralPosStateBits:= 0;
_numLiteralContextBits:= 3;

_dictionarySize:= (1 shl kDefaultDictionaryLogSize);
_dictionarySizePrev:= -1;
_numFastBytesPrev:= -1;
_matchFinderType:= EMatchFinderTypeBT4;
_writeEndMark:= false;

_needReleaseMFStream:= false;
end;

destructor TLZMAEncoder.Destroy;
var i:integer;
begin
_rangeEncoder.Free;
_posAlignEncoder.Free;
_lenEncoder.Free;
_repMatchLenEncoder.Free;
_literalEncoder.Free;
if _matchFinder<>nil then _matchFinder.Free;
for i := 0 to kNumOpts -1 do
    _optimum[i].Free;
for i := 0 to ULZMABase.kNumLenToPosStates -1 do
    _posSlotEncoder[i].Free;
end;

procedure TLZMAEncoder._Create;
var bt:TLZBinTree;
    numHashBytes,i:integer;
begin
if _matchFinder = nil then begin
   bt := TLZBinTree.Create;
   numHashBytes:= 4;
   if _matchFinderType = EMatchFinderTypeBT2 then
      numHashBytes := 2;
   bt.SetType(numHashBytes);
   _matchFinder := bt;
   end;
_literalEncoder._Create(_numLiteralPosStateBits, _numLiteralContextBits);

if (_dictionarySize = _dictionarySizePrev) and (_numFastBytesPrev = _numFastBytes) then
   exit;
_matchFinder._Create(_dictionarySize, kNumOpts, _numFastBytes, ULZMABase.kMatchMaxLen + 1);
_dictionarySizePrev := _dictionarySize;
_numFastBytesPrev := _numFastBytes;

for i := 0 to kNumOpts -1 do
    _optimum[i]:=TLZMAOptimal.Create;
for i := 0 to ULZMABase.kNumLenToPosStates -1 do
    _posSlotEncoder[i] :=TBitTreeEncoder.Create(ULZMABase.kNumPosSlotBits);
end;

function TLZMAEncoder.GetPosSlot(const pos:integer):integer;
begin
if (pos < (1 shl 11)) then
   result:=g_FastPos[pos]
else if (pos < (1 shl 21)) then
     result:=(g_FastPos[pos shr 10] + 20)
else result:=(g_FastPos[pos shr 20] + 40);
end;

function TLZMAEncoder.GetPosSlot2(const pos:integer):integer;
begin
if (pos < (1 shl 17)) then
   result:=(g_FastPos[pos shr 6] + 12)
else if (pos < (1 shl 27)) then
     result:=(g_FastPos[pos shr 16] + 32)
else result:=(g_FastPos[pos shr 26] + 52);
end;

procedure TLZMAEncoder.BaseInit;
var i:integer;
begin
_state := ulzmaBase.StateInit;
_previousByte := 0;
for i := 0 to ULZMABase.kNumRepDistances -1 do
    _repDistances[i] := 0;
end;

procedure TLZMAEncoder.SetWriteEndMarkerMode(const writeEndMarker:boolean);
begin
_writeEndMark := writeEndMarker;
end;

procedure TLZMAEncoder.Init;
var i:integer;
begin
BaseInit;
_rangeEncoder.Init;

URangeEncoder.InitBitModels(_isMatch);
URangeEncoder.InitBitModels(_isRep0Long);
URangeEncoder.InitBitModels(_isRep);
URangeEncoder.InitBitModels(_isRepG0);
URangeEncoder.InitBitModels(_isRepG1);
URangeEncoder.InitBitModels(_isRepG2);
URangeEncoder.InitBitModels(_posEncoders);


_literalEncoder.Init();
for i := 0 to ULZMABase.kNumLenToPosStates -1 do
    _posSlotEncoder[i].Init;

_lenEncoder.Init(1 shl _posStateBits);
_repMatchLenEncoder.Init(1 shl _posStateBits);

_posAlignEncoder.Init;

_longestMatchWasFound := false;
_optimumEndIndex := 0;
_optimumCurrentIndex := 0;
_additionalOffset := 0;
end;

function TLZMAEncoder.ReadMatchDistances:integer;
var lenRes:integer;
begin
lenRes := 0;
_numDistancePairs := _matchFinder.GetMatches(_matchDistances);

if _numDistancePairs > 0 then begin
   lenRes := _matchDistances[_numDistancePairs - 2];
   if lenRes = _numFastBytes then
      lenRes := lenRes + _matchFinder.GetMatchLen(lenRes - 1, _matchDistances[_numDistancePairs - 1], ULZMABase.kMatchMaxLen - lenRes);
   end;
inc(_additionalOffset);
result:=lenRes;
end;

procedure TLZMAEncoder.MovePos(const num:integer);
begin
if num > 0 then begin
   _matchFinder.Skip(num);
   _additionalOffset := _additionalOffset + num;
   end;
end;

function TLZMAEncoder.GetRepLen1Price(const state,posState:integer):integer;
begin
result:=RangeEncoder.GetPrice0(_isRepG0[state]) +
        RangeEncoder.GetPrice0(_isRep0Long[(state shl ULZMABase.kNumPosStatesBitsMax) + posState]);
end;