ulzmaencoder.pas

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

function TLZMAEncoder.GetPureRepPrice(const repIndex, state, posState:integer):integer;
var price:integer;
begin
if repIndex = 0 then begin
   price := RangeEncoder.GetPrice0(_isRepG0[state]);
   price := price + RangeEncoder.GetPrice1(_isRep0Long[(state shl ULZMABase.kNumPosStatesBitsMax) + posState]);
   end else begin
       price := RangeEncoder.GetPrice1(_isRepG0[state]);
       if repIndex = 1 then
          price := price + RangeEncoder.GetPrice0(_isRepG1[state])
          else begin
               price := price + RangeEncoder.GetPrice1(_isRepG1[state]);
               price := price + RangeEncoder.GetPrice(_isRepG2[state], repIndex - 2);
               end;
       end;
result:=price;
end;

function TLZMAEncoder.GetRepPrice(const repIndex, len, state, posState:integer):integer;
var price:integer;
begin
price := _repMatchLenEncoder.GetPrice(len - ULZMABase.kMatchMinLen, posState);
result := price + GetPureRepPrice(repIndex, state, posState);
end;

function TLZMAEncoder.GetPosLenPrice(const pos, len, posState:integer):integer;
var price,lenToPosState:integer;
begin
lenToPosState := ULZMABase.GetLenToPosState(len);
if pos < ULZMABase.kNumFullDistances then
   price := _distancesPrices[(lenToPosState * ULZMABase.kNumFullDistances) + pos]
   else price := _posSlotPrices[(lenToPosState shl ULZMABase.kNumPosSlotBits) + GetPosSlot2(pos)] +
           _alignPrices[pos and ULZMABase.kAlignMask];
result := price + _lenEncoder.GetPrice(len - ULZMABase.kMatchMinLen, posState);
end;

function TLZMAEncoder.Backward(cur:integer):integer;
var posMem,backMem,posPrev,backCur:integer;
begin
_optimumEndIndex := cur;
posMem := _optimum[cur].PosPrev;
backMem := _optimum[cur].BackPrev;
repeat
  if _optimum[cur].Prev1IsChar then begin
     _optimum[posMem].MakeAsChar;
     _optimum[posMem].PosPrev := posMem - 1;
     if _optimum[cur].Prev2 then begin
        _optimum[posMem - 1].Prev1IsChar := false;
        _optimum[posMem - 1].PosPrev := _optimum[cur].PosPrev2;
        _optimum[posMem - 1].BackPrev := _optimum[cur].BackPrev2;
        end;
     end;
  posPrev := posMem;
  backCur := backMem;

  backMem := _optimum[posPrev].BackPrev;
  posMem := _optimum[posPrev].PosPrev;

  _optimum[posPrev].BackPrev := backCur;
  _optimum[posPrev].PosPrev := cur;
  cur := posPrev;
  until not (cur > 0);
backRes := _optimum[0].BackPrev;
_optimumCurrentIndex := _optimum[0].PosPrev;
result:=_optimumCurrentIndex;
end;

function TLZMAEncoder.GetOptimum(position:integer):integer;
var lenRes,lenMain,numDistancePairs,numAvailableBytes,repMaxIndex,i:integer;
    matchPrice,repMatchPrice,shortRepPrice,lenEnd,len,repLen,price:integer;
    curAndLenPrice,normalMatchPrice,Offs,distance,cur,newLen:integer;
    posPrev,state,pos,curPrice,curAnd1Price,numAvailableBytesFull:integer;
    lenTest2,t,state2,posStateNext,nextRepMatchPrice,offset:integer;
    startLen,repIndex,lenTest,lenTestTemp,curAndLenCharPrice:integer;
    nextMatchPrice,curBack:integer;
    optimum,opt,nextOptimum:TLZMAOptimal;
    currentByte,matchByte,posState:byte;
    nextIsChar:boolean;
begin
if (_optimumEndIndex <> _optimumCurrentIndex) then begin
   lenRes := _optimum[_optimumCurrentIndex].PosPrev - _optimumCurrentIndex;
   backRes := _optimum[_optimumCurrentIndex].BackPrev;
   _optimumCurrentIndex := _optimum[_optimumCurrentIndex].PosPrev;
   result:=lenRes;
   exit;
   end;//if optimumendindex
_optimumCurrentIndex := 0;
_optimumEndIndex := 0;

if not _longestMatchWasFound then begin
   lenMain := ReadMatchDistances();
   end else begin //if not longest
       lenMain := _longestMatchLength;
       _longestMatchWasFound := false;
       end;//if not longest else
numDistancePairs := _numDistancePairs;

numAvailableBytes := _matchFinder.GetNumAvailableBytes + 1;
if numAvailableBytes < 2 then begin
   backRes := -1;
   result:=1;
   exit;
   end;//if numavailable
{if numAvailableBytes > ULZMABase.kMatchMaxLen then
   numAvailableBytes := ULZMABase.kMatchMaxLen;}

repMaxIndex := 0;
for i := 0 to ULZMABase.kNumRepDistances-1 do begin
    reps[i] := _repDistances[i];
    repLens[i] := _matchFinder.GetMatchLen(0 - 1, reps[i], ULZMABase.kMatchMaxLen);
    if repLens[i] > repLens[repMaxIndex] then
       repMaxIndex := i;
    end;//for i
if repLens[repMaxIndex] >= _numFastBytes then begin
   backRes := repMaxIndex;
   lenRes := repLens[repMaxIndex];
   MovePos(lenRes - 1);
   result:=lenRes;
   exit;
   end;//if replens[]

if lenMain >= _numFastBytes then begin
   backRes := _matchDistances[numDistancePairs - 1] + ULZMABase.kNumRepDistances;
   MovePos(lenMain - 1);
   result:=lenMain;
   exit;
   end;//if lenMain

currentByte := _matchFinder.GetIndexByte(0 - 1);
matchByte := _matchFinder.GetIndexByte(0 - _repDistances[0] - 1 - 1);

if (lenMain < 2) and (currentByte <> matchByte) and (repLens[repMaxIndex] < 2) then begin
   backRes := -1;
   result:=1;
   exit;
   end;//if lenmain<2

_optimum[0].State := _state;

posState := (position and _posStateMask);

_optimum[1].Price := RangeEncoder.GetPrice0(_isMatch[(_state shl ULZMABase.kNumPosStatesBitsMax) + posState]) +
        _literalEncoder.GetSubCoder(position, _previousByte).GetPrice(not ULZMABase.StateIsCharState(_state), matchByte, currentByte);
_optimum[1].MakeAsChar();

matchPrice := RangeEncoder.GetPrice1(_isMatch[(_state shl ULZMABase.kNumPosStatesBitsMax) + posState]);
repMatchPrice := matchPrice + RangeEncoder.GetPrice1(_isRep[_state]);

if matchByte = currentByte then begin
   shortRepPrice := repMatchPrice + GetRepLen1Price(_state, posState);
   if shortRepPrice < _optimum[1].Price then begin
      _optimum[1].Price := shortRepPrice;
      _optimum[1].MakeAsShortRep;
      end;//if shortrepprice
   end;//if matchbyte

if lenMain >= repLens[repMaxIndex] then lenEnd:=lenMain
   else lenEnd:=repLens[repMaxIndex];

if lenEnd < 2 then begin
   backRes := _optimum[1].BackPrev;
   result:=1;
   exit;
   end;//if lenend<2

_optimum[1].PosPrev := 0;

_optimum[0].Backs0 := reps[0];
_optimum[0].Backs1 := reps[1];
_optimum[0].Backs2 := reps[2];
_optimum[0].Backs3 := reps[3];

len := lenEnd;
repeat
  _optimum[len].Price := kIfinityPrice;
  dec(len);
  until not (len >= 2);

for i := 0 to ULZMABase.kNumRepDistances -1 do begin
    repLen := repLens[i];
    if repLen < 2 then
       continue;
    price := repMatchPrice + GetPureRepPrice(i, _state, posState);
    repeat
      curAndLenPrice := price + _repMatchLenEncoder.GetPrice(repLen - 2, posState);
      optimum := _optimum[repLen];
      if curAndLenPrice < optimum.Price then begin
         optimum.Price := curAndLenPrice;
         optimum.PosPrev := 0;
         optimum.BackPrev := i;
         optimum.Prev1IsChar := false;
         end;//if curandlenprice
      dec(replen);
      until not (repLen >= 2);
    end;//for i

normalMatchPrice := matchPrice + RangeEncoder.GetPrice0(_isRep[_state]);

if repLens[0] >= 2 then len:=repLens[0] + 1
   else len:=2;

if len <= lenMain then begin
   offs := 0;
   while len > _matchDistances[offs] do
         offs := offs + 2;
   while (true) do begin
         distance := _matchDistances[offs + 1];
         curAndLenPrice := normalMatchPrice + GetPosLenPrice(distance, len, posState);
         optimum := _optimum[len];
         if curAndLenPrice < optimum.Price then begin
            optimum.Price := curAndLenPrice;
            optimum.PosPrev := 0;
            optimum.BackPrev := distance + ULZMABase.kNumRepDistances;
            optimum.Prev1IsChar := false;
            end;//if curlenandprice
         if len = _matchDistances[offs] then begin
            offs := offs + 2;
            if offs = numDistancePairs then
               break;
            end;//if len=_match
         inc(len);
         end;//while (true)
   end;//if len<=lenmain

cur := 0;

while (true) do begin
      inc(cur);
      if cur = lenEnd then begin
         result:=Backward(cur);
         exit;
         end;//if cur=lenEnd
      newLen := ReadMatchDistances;
      numDistancePairs := _numDistancePairs;
      if newLen >= _numFastBytes then begin
         _longestMatchLength := newLen;
         _longestMatchWasFound := true;
         result:=Backward(cur);
         exit;
         end;//if newlen=_numfast
      inc(position);
      posPrev := _optimum[cur].PosPrev;
      if _optimum[cur].Prev1IsChar then begin
         dec(posPrev);
         if _optimum[cur].Prev2 then begin
            state := _optimum[_optimum[cur].PosPrev2].State;
            if _optimum[cur].BackPrev2 < ULZMABase.kNumRepDistances then
               state := ULZMABase.StateUpdateRep(state)
               else state := ULZMABase.StateUpdateMatch(state);
            end//if _optimum[cur].Prev2
            else state := _optimum[posPrev].State;
         state := ULZMABase.StateUpdateChar(state);
         end//if _optimum[cur].Prev1IsChar
         else state := _optimum[posPrev].State;
      if posPrev = cur - 1 then begin
         if _optimum[cur].IsShortRep then
            state := ULZMABase.StateUpdateShortRep(state)
            else state := ULZMABase.StateUpdateChar(state);
         end //if posPrev = cur - 1
         else begin
              if _optimum[cur].Prev1IsChar and _optimum[cur].Prev2 then begin
                 posPrev := _optimum[cur].PosPrev2;
                 pos := _optimum[cur].BackPrev2;
                 state := ULZMABase.StateUpdateRep(state);
                 end//if _optimum[cur].Prev1IsChar
                 else begin
                      pos := _optimum[cur].BackPrev;
                      if pos < ULZMABase.kNumRepDistances then
                         state := ULZMABase.StateUpdateRep(state)
                         else state := ULZMABase.StateUpdateMatch(state);
                      end;//if else  _optimum[cur].Prev1IsChar
              opt := _optimum[posPrev];
              if pos < ULZMABase.kNumRepDistances then begin
                 if pos = 0 then begin
                    reps[0] := opt.Backs0;
                    reps[1] := opt.Backs1;
                    reps[2] := opt.Backs2;
                    reps[3] := opt.Backs3;
                    end//if pos=0
                    else if pos = 1 then begin
                         reps[0] := opt.Backs1;
                         reps[1] := opt.Backs0;
                         reps[2] := opt.Backs2;
                         reps[3] := opt.Backs3;
                         end //if pos=1
                    else if pos = 2 then begin
                         reps[0] := opt.Backs2;
                         reps[1] := opt.Backs0;
                         reps[2] := opt.Backs1;
                         reps[3] := opt.Backs3;
                         end//if pos=2
                    else begin
                         reps[0] := opt.Backs3;
                         reps[1] := opt.Backs0;
                         reps[2] := opt.Backs1;
                         reps[3] := opt.Backs2;
                         end;//else if pos=
                 end// if pos < ULZMABase.kNumRepDistances
                 else begin
                      reps[0] := (pos - ULZMABase.kNumRepDistances);
                      reps[1] := opt.Backs0;
                      reps[2] := opt.Backs1;
                      reps[3] := opt.Backs2;
                      end;//if else pos < ULZMABase.kNumRepDistances
              end;//if else posPrev = cur - 1
      _optimum[cur].State := state;
      _optimum[cur].Backs0 := reps[0];
      _optimum[cur].Backs1 := reps[1];
      _optimum[cur].Backs2 := reps[2];
      _optimum[cur].Backs3 := reps[3];
      curPrice := _optimum[cur].Price;

      currentByte := _matchFinder.GetIndexByte(0 - 1);
      matchByte := _matchFinder.GetIndexByte(0 - reps[0] - 1 - 1);

      posState := (position and _posStateMask);

      curAnd1Price := curPrice +
        RangeEncoder.GetPrice0(_isMatch[(state shl ULZMABase.kNumPosStatesBitsMax) + posState]) +
        _literalEncoder.GetSubCoder(position, _matchFinder.GetIndexByte(0 - 2)).
        GetPrice(not ULZMABase.StateIsCharState(state), matchByte, currentByte);

      nextOptimum := _optimum[cur + 1];

      nextIsChar := false;
      if curAnd1Price < nextOptimum.Price then begin
         nextOptimum.Price := curAnd1Price;
         nextOptimum.PosPrev := cur;
         nextOptimum.MakeAsChar;
         nextIsChar := true;
         end;//if curand1price

      matchPrice := curPrice + RangeEncoder.GetPrice1(_isMatch[(state shl ULZMABase.kNumPosStatesBitsMax) + posState]);
      repMatchPrice := matchPrice + RangeEncoder.GetPrice1(_isRep[state]);

      if (matchByte = currentByte) and
           (not ((nextOptimum.PosPrev < cur) and (nextOptimum.BackPrev = 0))) then begin
         shortRepPrice := repMatchPrice + GetRepLen1Price(state, posState);
         if shortRepPrice <= nextOptimum.Price then begin
            nextOptimum.Price := shortRepPrice;
            nextOptimum.PosPrev := cur;
            nextOptimum.MakeAsShortRep;
            nextIsChar := true;
            end;//if shortRepPrice <= nextOptimum.Price
         end;//if (matchByte = currentByte) and

      numAvailableBytesFull := _matchFinder.GetNumAvailableBytes + 1;
      numAvailableBytesFull := min(kNumOpts - 1 - cur, numAvailableBytesFull);
      numAvailableBytes := numAvailableBytesFull;

      if numAvailableBytes < 2 then
         continue;
      if numAvailableBytes > _numFastBytes then
         numAvailableBytes := _numFastBytes;
      if (not nextIsChar) and (matchByte <> currentByte) then begin
         // try Literal + rep0
         t := min(numAvailableBytesFull - 1, _numFastBytes);
         lenTest2 := _matchFinder.GetMatchLen(0, reps[0], t);
         if lenTest2 >= 2 then begin
            state2 := ULZMABase.StateUpdateChar(state);

            posStateNext := (position + 1) and _posStateMask;
            nextRepMatchPrice := curAnd1Price +
               RangeEncoder.GetPrice1(_isMatch[(state2 shl ULZMABase.kNumPosStatesBitsMax) + posStateNext]) +
               RangeEncoder.GetPrice1(_isRep[state2]);
            begin
              offset := cur + 1 + lenTest2;
              while lenEnd < offset do begin
                    inc(lenEnd);
                    _optimum[lenEnd].Price := kIfinityPrice;
                    end;//while lenend
              curAndLenPrice := nextRepMatchPrice + GetRepPrice(
                   0, lenTest2, state2, posStateNext);
              optimum := _optimum[offset];
              if curAndLenPrice < optimum.Price then begin
                 optimum.Price := curAndLenPrice;
                 optimum.PosPrev := cur + 1;
                 optimum.BackPrev := 0;
                 optimum.Prev1IsChar := true;