ulzmaencoder.pas

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

    inputsize:int64;
begin
if insize=-1 then
   inputsize:=instream.Size-instream.Position
   else inputsize:=insize;
progint:=inputsize div CodeProgressInterval;
lpos:=progint;

_needReleaseMFStream := false;
DoProgress(LPAMax,inputsize);
try
   SetStreams(inStream, outStream, inSize, outSize);
   while true do begin
         CodeOneBlock(processedInSize, processedOutSize, finished);
         if finished then begin
            DoProgress(LPAPos,inputsize);
            exit;
            end;
         if (processedInSize>=lpos) then begin
            DoProgress(LPAPos,processedInSize);
            lpos:=lpos+progint;
            end;
         end;
   finally
     ReleaseStreams();
   end;
end;

procedure TLZMAEncoder.WriteCoderProperties(const outStream:TStream);
var i:integer;
begin
properties[0] := (_posStateBits * 5 + _numLiteralPosStateBits) * 9 + _numLiteralContextBits;
for i := 0 to 3 do
    properties[1 + i] := (_dictionarySize shr (8 * i));
outStream.write(properties, kPropSize);
end;

procedure TLZMAEncoder.FillDistancesPrices;
var i,posSlot,footerBits,baseVal,lenToPosState,st,st2:integer;
    encoder:TBitTreeEncoder;
begin
for i := ULZMABase.kStartPosModelIndex to ULZMABase.kNumFullDistances -1 do begin
    posSlot := GetPosSlot(i);
    footerBits := integer((posSlot shr 1) - 1);
    baseVal := (2 or (posSlot and 1)) shl footerBits;
    tempPrices[i] := ReverseGetPrice(_posEncoders,
        baseVal - posSlot - 1, footerBits, i - baseVal);
    end;

for lenToPosState := 0 to ULZMABase.kNumLenToPosStates -1  do begin
    encoder := _posSlotEncoder[lenToPosState];

    st := (lenToPosState shl ULZMABase.kNumPosSlotBits);
    for posSlot := 0 to _distTableSize -1 do
        _posSlotPrices[st + posSlot] := encoder.GetPrice(posSlot);
    for posSlot := ULZMABase.kEndPosModelIndex to _distTableSize -1 do
        _posSlotPrices[st + posSlot] := _posSlotPrices[st + posSlot] + ((((posSlot shr 1) - 1) - ULZMABase.kNumAlignBits) shl kNumBitPriceShiftBits);

    st2 := lenToPosState * ULZMABase.kNumFullDistances;
    for i := 0 to ULZMABase.kStartPosModelIndex -1 do
        _distancesPrices[st2 + i] := _posSlotPrices[st + i];
    for i := ULZMABase.kStartPosModelIndex to ULZMABase.kNumFullDistances-1 do
        _distancesPrices[st2 + i] := _posSlotPrices[st + GetPosSlot(i)] + tempPrices[i];
    end;
_matchPriceCount := 0;
end;

procedure TLZMAEncoder.FillAlignPrices;
var i:integer;
begin
for i := 0 to ULZMABase.kAlignTableSize -1 do
    _alignPrices[i] := _posAlignEncoder.ReverseGetPrice(i);
_alignPriceCount := 0;
end;

function TLZMAEncoder.SetAlgorithm(const algorithm:integer):boolean;
begin
{
    _fastMode = (algorithm == 0);
    _maxMode = (algorithm >= 2);
}
result:=true;
end;

function TLZMAEncoder.SetDictionarySize(dictionarySize:integer):boolean;
var kDicLogSizeMaxCompress,dicLogSize:integer;
begin
kDicLogSizeMaxCompress := 29;
if (dictionarySize < (1 shl ULZMABase.kDicLogSizeMin)) or (dictionarySize > (1 shl kDicLogSizeMaxCompress)) then begin
   result:=false;
   exit;
   end;
_dictionarySize := dictionarySize;
dicLogSize := 0;
while dictionarySize > (1 shl dicLogSize) do
      inc(dicLogSize);
_distTableSize := dicLogSize * 2;
result:=true;
end;

function TLZMAEncoder.SeNumFastBytes(const numFastBytes:integer):boolean;
begin
if (numFastBytes < 5) or (numFastBytes > ULZMABase.kMatchMaxLen) then begin
   result:=false;
   exit;
   end;
_numFastBytes := numFastBytes;
result:=true;
end;

function TLZMAEncoder.SetMatchFinder(const matchFinderIndex:integer):boolean;
var matchFinderIndexPrev:integer;
begin
if (matchFinderIndex < 0) or (matchFinderIndex > 2) then begin
   result:=false;
   exit;
   end;
matchFinderIndexPrev := _matchFinderType;
_matchFinderType := matchFinderIndex;
if (_matchFinder <> nil) and (matchFinderIndexPrev <> _matchFinderType) then begin
   _dictionarySizePrev := -1;
   _matchFinder := nil;
   end;
result:=true;
end;

function TLZMAEncoder.SetLcLpPb(const lc,lp,pb:integer):boolean;
begin
if (lp < 0) or (lp > ULZMABase.kNumLitPosStatesBitsEncodingMax) or
   (lc < 0) or (lc > ULZMABase.kNumLitContextBitsMax) or
   (pb < 0) or (pb > ULZMABase.kNumPosStatesBitsEncodingMax) then begin
   result:=false;
   exit;
   end;
_numLiteralPosStateBits := lp;
_numLiteralContextBits := lc;
_posStateBits := pb;
_posStateMask := ((1) shl _posStateBits) - 1;
result:=true;
end;

procedure TLZMAEncoder.SetEndMarkerMode(const endMarkerMode:boolean);
begin
_writeEndMark := endMarkerMode;
end;

procedure TLZMAEncoder2.Init;
begin
URangeEncoder.InitBitModels(m_Encoders);
end;

procedure TLZMAEncoder2.Encode(const rangeEncoder:TRangeEncoder;const symbol:byte);
var context:integer;
    bit,i:integer;
begin
context := 1;
for i := 7 downto 0 do begin
    bit := ((symbol shr i) and 1);
    rangeEncoder.Encode(m_Encoders, context, bit);
    context := (context shl 1) or bit;
    end;
end;

procedure TLZMAEncoder2.EncodeMatched(const rangeEncoder:TRangeEncoder;const matchByte,symbol:byte);
var context,i,bit,state,matchbit:integer;
    same:boolean;
begin
context := 1;
same := true;
for i := 7 downto 0 do begin
    bit := ((symbol shr i) and 1);
    state := context;
    if same then begin
       matchBit := ((matchByte shr i) and 1);
       state :=state + ((1 + matchBit) shl 8);
       same := (matchBit = bit);
       end;
    rangeEncoder.Encode(m_Encoders, state, bit);
    context := (context shl 1) or bit;
    end;
end;

function TLZMAEncoder2.GetPrice(const matchMode:boolean;const matchByte,symbol:byte):integer;
var price,context,i,matchbit,bit:integer;
begin
price := 0;
context := 1;
i := 7;
if matchMode then
   while i>=0 do begin
         matchBit := (matchByte shr i) and 1;
         bit := (symbol shr i) and 1;
         price := price + RangeEncoder.GetPrice(m_Encoders[((1 + matchBit) shl 8) + context], bit);
         context := (context shl 1) or bit;
         if (matchBit <> bit) then begin
            dec(i);
            break;
            end;
         dec(i);
         end;
while i>=0 do begin
      bit := (symbol shr i) and 1;
      price := price + RangeEncoder.GetPrice(m_Encoders[context], bit);
      context := (context shl 1) or bit;
      dec(i);
      end;
result:=price;
end;

procedure TLZMALiteralEncoder._Create(const numPosBits,numPrevBits:integer);
var numstates:integer;
    i:integer;
begin
if (length(m_Coders)<>0) and (m_NumPrevBits = numPrevBits) and (m_NumPosBits = numPosBits) then
   exit;
m_NumPosBits := numPosBits;
m_PosMask := (1 shl numPosBits) - 1;
m_NumPrevBits := numPrevBits;
numStates := 1 shl (m_NumPrevBits + m_NumPosBits);
setlength(m_coders,numStates);
for i := 0 to numStates-1 do
    m_Coders[i] := TLZMAEncoder2.Create;
end;

destructor TLZMALiteralEncoder.Destroy;
var i:integer;
begin
for i:=low(m_Coders) to high(m_Coders) do
    if m_Coders[i]<>nil then m_Coders[i].Free;
inherited;
end;

procedure TLZMALiteralEncoder.Init;
var numstates,i:integer;
begin
numStates := 1 shl (m_NumPrevBits + m_NumPosBits);
for i := 0 to numStates-1 do
    m_Coders[i].Init;
end;

function TLZMALiteralEncoder.GetSubCoder(const pos:integer;const prevByte:byte):TLZMAEncoder2;
begin
result:=m_Coders[((pos and m_PosMask) shl m_NumPrevBits) + ((prevByte and $FF) shr (8 - m_NumPrevBits))];
end;

constructor TLZMALenEncoder.Create;
var posState:integer;
begin
_highCoder := TBitTreeEncoder.Create(ULZMABase.kNumHighLenBits);
for posState := 0 to ULZMABase.kNumPosStatesEncodingMax-1 do begin
    _lowCoder[posState] := TBitTreeEncoder.Create(ULZMABase.kNumLowLenBits);
    _midCoder[posState] := TBitTreeEncoder.Create(ULZMABase.kNumMidLenBits);
    end;
end;

destructor TLZMALenEncoder.Destroy;
var posState:integer;
begin
_highCoder.Free;
for posState := 0 to ULZMABase.kNumPosStatesEncodingMax-1 do begin
    _lowCoder[posState].Free;
    _midCoder[posState].Free;
    end;
inherited;
end;

procedure TLZMALenEncoder.Init(const numPosStates:integer);
var posState:integer;
begin
URangeEncoder.InitBitModels(_choice);

for posState := 0 to numPosStates -1 do begin
    _lowCoder[posState].Init;
    _midCoder[posState].Init;
    end;
_highCoder.Init;
end;

procedure TLZMALenEncoder.Encode(const rangeEncoder:TRangeEncoder;symbol:integer;const posState:integer);
begin
if (symbol < ULZMABase.kNumLowLenSymbols) then begin
   rangeEncoder.Encode(_choice, 0, 0);
   _lowCoder[posState].Encode(rangeEncoder, symbol);
   end else begin
       symbol := symbol - ULZMABase.kNumLowLenSymbols;
       rangeEncoder.Encode(_choice, 0, 1);
       if symbol < ULZMABase.kNumMidLenSymbols then begin
          rangeEncoder.Encode(_choice, 1, 0);
          _midCoder[posState].Encode(rangeEncoder, symbol);
          end else begin
              rangeEncoder.Encode(_choice, 1, 1);
              _highCoder.Encode(rangeEncoder, symbol - ULZMABase.kNumMidLenSymbols);
              end;
       end;
end;

procedure TLZMALenEncoder.SetPrices(const posState,numSymbols:integer;var prices:array of integer;const st:integer);
var a0,a1,b0,b1,i:integer;
begin
a0 := RangeEncoder.GetPrice0(_choice[0]);
a1 := RangeEncoder.GetPrice1(_choice[0]);
b0 := a1 + RangeEncoder.GetPrice0(_choice[1]);
b1 := a1 + RangeEncoder.GetPrice1(_choice[1]);
i:=0;
while i<ULZMABase.kNumLowLenSymbols do begin
    if i >= numSymbols then
       exit;
    prices[st + i] := a0 + _lowCoder[posState].GetPrice(i);
    inc(i);
    end;
while i < ULZMABase.kNumLowLenSymbols + ULZMABase.kNumMidLenSymbols do begin
      if i >= numSymbols then
         exit;
      prices[st + i] := b0 + _midCoder[posState].GetPrice(i - ULZMABase.kNumLowLenSymbols);
      inc(i);
      end;
while i < numSymbols do begin
      prices[st + i] := b1 + _highCoder.GetPrice(i - ULZMABase.kNumLowLenSymbols - ULZMABase.kNumMidLenSymbols);
      inc(i);
      end;
end;

procedure TLZMALenPriceTableEncoder.SetTableSize(const tableSize:integer);
begin
_tableSize := tableSize;
end;

function TLZMALenPriceTableEncoder.GetPrice(const symbol,posState:integer):integer;
begin
result:=_prices[posState * ULZMABase.kNumLenSymbols + symbol]
end;

procedure TLZMALenPriceTableEncoder.UpdateTable(const posState:integer);
begin
SetPrices(posState, _tableSize, _prices, posState * ULZMABase.kNumLenSymbols);
_counters[posState] := _tableSize;
end;

procedure TLZMALenPriceTableEncoder.UpdateTables(const numPosStates:integer);
var posState:integer;
begin
for posState := 0 to numPosStates -1 do
    UpdateTable(posState);
end;

procedure TLZMALenPriceTableEncoder.Encode(const rangeEncoder:TRangeEncoder;symbol:integer;const posState:integer);
begin
inherited Encode(rangeEncoder, symbol, posState);
dec(_counters[posState]);
if (_counters[posState] = 0) then
   UpdateTable(posState);
end;

procedure TLZMAOptimal.MakeAsChar;
begin
BackPrev := -1;
Prev1IsChar := false;
end;

procedure TLZMAOptimal.MakeAsShortRep;
begin
BackPrev := 0;
Prev1IsChar := false;
end;

function TLZMAOptimal.IsShortRep:boolean;
begin
result:=BackPrev = 0;
end;

procedure TLZMAEncoder.DoProgress(const Action:TLZMAProgressAction;const Value:integer);
begin
if assigned(fonprogress) then
   fonprogress(action,value);
end;

end.