907 lines
30 KiB
ObjectPascal
907 lines
30 KiB
ObjectPascal
(* ***** BEGIN LICENSE BLOCK *****
|
|
* Version: MPL 1.1
|
|
*
|
|
* The contents of this file are subject to the Mozilla Public License Version
|
|
* 1.1 (the "License"); you may not use this file except in compliance with
|
|
* the License. You may obtain a copy of the License at
|
|
* http://www.mozilla.org/MPL/
|
|
*
|
|
* Software distributed under the License is distributed on an "AS IS" basis,
|
|
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
|
* for the specific language governing rights and limitations under the
|
|
* License.
|
|
*
|
|
* The Original Code is TurboPower Abbrevia
|
|
*
|
|
* The Initial Developer of the Original Code is
|
|
* TurboPower Software
|
|
*
|
|
* Portions created by the Initial Developer are Copyright (C) 1997-2002
|
|
* the Initial Developer. All Rights Reserved.
|
|
*
|
|
* Contributor(s):
|
|
*
|
|
* ***** END LICENSE BLOCK ***** *)
|
|
|
|
{*********************************************************}
|
|
{* ABBREVIA: AbDfEnc.pas *}
|
|
{*********************************************************}
|
|
{* Deflate encoding unit *}
|
|
{*********************************************************}
|
|
|
|
unit AbDfEnc;
|
|
|
|
{$I AbDefine.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes,
|
|
AbDfBase;
|
|
|
|
function Deflate(aSource : TStream; aDest : TStream;
|
|
aHelper : TAbDeflateHelper) : longint;
|
|
|
|
implementation
|
|
|
|
uses
|
|
AbDfInW,
|
|
AbDfHufD,
|
|
AbDfStrm,
|
|
AbDfCryS,
|
|
AbDfPkMg;
|
|
|
|
{====================================================================}
|
|
function CalcDynamicBitCount(aUseDeflate64: boolean;
|
|
aLitBuckets : PAbDfLitBuckets;
|
|
aDistBuckets : PAbDfDistBuckets;
|
|
aCodeBuckets : PAbDfCodeLenBuckets;
|
|
const aCodeLens : array of integer;
|
|
const aCLCodeLens : array of integer;
|
|
aLitCount : integer;
|
|
aDistCount : integer;
|
|
aCodeCount : integer) : longint;
|
|
var
|
|
Symbol : integer;
|
|
LastSymbol : integer;
|
|
Inx : integer;
|
|
begin
|
|
{note: this routine calculates the number of bits required to
|
|
compress a given block}
|
|
|
|
{a dynamic block starts off with 5 bits of literal symbol count, 5
|
|
bits of distance symbol count, 4 bits of codelength symbol count,
|
|
and then 3 bits for every codelength symbol used}
|
|
Result := 5 + 5 + 4 +
|
|
(aCodeCount * 3);
|
|
|
|
{add in the bits needed to compress the literal and distance trees}
|
|
inc(Result, aCodeBuckets^[16] * (aCLCodeLens[16] + 2));
|
|
inc(Result, aCodeBuckets^[17] * (aCLCodeLens[16] + 3));
|
|
inc(Result, aCodeBuckets^[18] * (aCLCodeLens[16] + 7));
|
|
for Symbol := 3 to pred(aCodeCount) do begin
|
|
Inx := dfc_CodeLengthIndex[Symbol];
|
|
Assert(Inx <=15,
|
|
'CalcDynamicBitCount: the index array of codelengths is corrupted');
|
|
inc(Result, aCodeBuckets^[Inx] * aCLCodeLens[Inx])
|
|
end;
|
|
|
|
{make the literal symbol 285 a special case}
|
|
LastSymbol := pred(aLitCount);
|
|
if (LastSymbol = 285) then
|
|
LastSymbol := 284;
|
|
|
|
{add in all the bits needed to compress the literals (except 285)}
|
|
for Symbol := 0 to LastSymbol do
|
|
if (Symbol < dfc_LitExtraOffset) then
|
|
inc(Result, aLitBuckets^[Symbol] * aCodeLens[Symbol])
|
|
else
|
|
inc(Result, aLitBuckets^[Symbol] *
|
|
(aCodeLens[Symbol] +
|
|
dfc_LitExtraBits[Symbol - dfc_LitExtraOffset]));
|
|
|
|
{add in all the bits needed to compress the literal symbol 285}
|
|
if (pred(aLitCount) = 285) then
|
|
if (not aUseDeflate64) then
|
|
inc(Result, aLitBuckets^[285] * aCodeLens[285])
|
|
else
|
|
inc(Result, aLitBuckets^[285] * (aCodeLens[285] + 16));
|
|
|
|
{add in all the bits needed to compress the distances}
|
|
for Symbol := 0 to pred(aDistCount) do
|
|
inc(Result, aDistBuckets^[Symbol] *
|
|
(aCodeLens[aLitCount + Symbol] +
|
|
dfc_DistExtraBits[Symbol]));
|
|
end;
|
|
{====================================================================}
|
|
|
|
|
|
{====================================================================}
|
|
procedure OutputEndOfBlock(aBitStrm : TAbDfOutBitStream;
|
|
aLitTree : TAbDfDecodeHuffmanTree);
|
|
var
|
|
Code : longint;
|
|
begin
|
|
{note: this routine encodes the end-of-block character (symbol 256)
|
|
and then writes out the code to the bit stream}
|
|
|
|
{encode the end-of-block character as a symbol}
|
|
{$IFOPT C+} {if Assertions are on }
|
|
Code := aLitTree.Encode(256);
|
|
{$ELSE}
|
|
Code := aLitTree.Encodes^[256];
|
|
{$ENDIF}
|
|
|
|
{write the code out to the bit stream}
|
|
aBitStrm.WriteBits(Code and $FFFF, (Code shr 16) and $FF);
|
|
end;
|
|
{--------}
|
|
procedure EncodeLZStreamStored(aFinalBlock : boolean;
|
|
aStream : TAbDfLZStream;
|
|
aBitStrm : TAbDfOutBitStream;
|
|
aDataSize : integer;
|
|
aLog : TAbLogger);
|
|
var
|
|
BlockHeader : packed record
|
|
bhSize : word;
|
|
bhNotSize : word;
|
|
end;
|
|
Buffer : pointer;
|
|
Code : integer;
|
|
BlockSize : integer;
|
|
begin
|
|
{note: this routine writes out an incompressible block to the bit
|
|
stream (the store algorithm)}
|
|
|
|
{allocate the maximum buffer we can write at once}
|
|
GetMem(Buffer, 64 * 1024);
|
|
try
|
|
|
|
{while there's more incompressible data to store...}
|
|
while (aDataSize <> 0) do begin
|
|
|
|
{calculate the block size to write this time}
|
|
if (aDataSize > $FFFF) then begin
|
|
BlockSize := $FFFF;
|
|
dec(aDataSize, $FFFF);
|
|
end
|
|
else begin
|
|
BlockSize := aDataSize;
|
|
aDataSize := 0;
|
|
end;
|
|
|
|
{$IFDEF UseLogging}
|
|
{log it}
|
|
if (aLog <> nil) then begin
|
|
aLog.WriteLine('..Writing new block...');
|
|
aLog.WriteLine(Format('..final block? %d', [ord(aFinalBlock)]));
|
|
aLog.WriteLine('..block type? 0');
|
|
aLog.WriteLine(Format('..block size: %d', [BlockSize]));
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{output the block information to the bit stream}
|
|
if aFinalBlock then
|
|
Code := 1 + (0 shl 1)
|
|
else
|
|
Code := 0 + (0 shl 1);
|
|
aBitStrm.WriteBits(Code, 3);
|
|
|
|
{align the bit stream to the nearest byte}
|
|
aBitStrm.AlignToByte;
|
|
|
|
{write the stored block header}
|
|
BlockHeader.bhSize := BlockSize;
|
|
BlockHeader.bhNotSize := not BlockHeader.bhSize;
|
|
aBitStrm.WriteBuffer(BlockHeader, sizeof(BlockHeader));
|
|
|
|
{get and write this block}
|
|
aStream.ReadStoredBuffer(Buffer^, BlockSize);
|
|
aBitStrm.WriteBuffer(Buffer^, BlockSize);
|
|
end;
|
|
finally
|
|
FreeMem(Buffer);
|
|
end;
|
|
|
|
{clear the stream, ready for the next block}
|
|
aStream.Clear;
|
|
end;
|
|
{--------}
|
|
procedure EncodeLZStreamStatic(aFinalBlock : boolean;
|
|
aUseDeflate64 : boolean;
|
|
aStream : TAbDfLZStream;
|
|
aBitStrm : TAbDfOutBitStream;
|
|
aLog : TAbLogger);
|
|
var
|
|
Code : integer;
|
|
begin
|
|
{note: this routine writes out the stream of LZ77 tokens for the
|
|
current block to the bit stream, using the static huffman
|
|
trees to encode the token symbols}
|
|
|
|
{$IFDEF UseLogging}
|
|
{log it}
|
|
if (aLog <> nil) then begin
|
|
aLog.WriteLine('..Writing new block...');
|
|
aLog.WriteLine(Format('..final block? %d', [ord(aFinalBlock)]));
|
|
aLog.WriteLine('..block type? 1');
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{output the block information to the bit stream}
|
|
if aFinalBlock then
|
|
Code := 1 + (1 shl 1)
|
|
else
|
|
Code := 0 + (1 shl 1);
|
|
aBitStrm.WriteBits(Code, 3);
|
|
|
|
{encode the LZ77 stream}
|
|
aStream.Encode(aBitStrm,
|
|
AbStaticLiteralTree, AbStaticDistanceTree,
|
|
aUseDeflate64);
|
|
|
|
{output the end-of-block marker to the bit stream}
|
|
OutputEndOfBlock(aBitStrm, AbStaticLiteralTree);
|
|
{$IFDEF UseLogging}
|
|
if (aLog <> nil) then
|
|
aLog.WriteLine('Char: end-of-block marker (#256)');
|
|
{$ENDIF}
|
|
end;
|
|
{--------}
|
|
procedure EncodeLZStreamDynamic(aFinalBlock : boolean;
|
|
aUseDeflate64 : boolean;
|
|
aUseBest : boolean;
|
|
aStream : TAbDfLZStream;
|
|
aBitStrm : TAbDfOutBitStream;
|
|
aLog : TAbLogger);
|
|
var
|
|
i : integer;
|
|
LitTree : TAbDfDecodeHuffmanTree;
|
|
DistTree : TAbDfDecodeHuffmanTree;
|
|
CodeLenTree : TAbDfDecodeHuffmanTree;
|
|
CodeLenStream : TAbDfCodeLenStream;
|
|
CodeLens : array [0..285+32] of integer;
|
|
CLCodeLens : array [0..18] of integer;
|
|
LitCodeCount : integer;
|
|
DistCodeCount : integer;
|
|
LenCodeCount : integer;
|
|
BitCount : integer;
|
|
Code : integer;
|
|
StaticSize : integer;
|
|
StoredSize : integer;
|
|
begin
|
|
{note: this routine writes out the stream of LZ77 tokens for the
|
|
current block to the bit stream, using the dynamic huffman
|
|
trees to encode the token symbols; if the routine determines
|
|
that the data can better be compressed using the static
|
|
huffman trees or should be stored as is, it'll switch
|
|
algorithms}
|
|
|
|
{prepare for the try..finally}
|
|
LitTree := nil;
|
|
DistTree := nil;
|
|
CodeLenTree := nil;
|
|
CodeLenStream := nil;
|
|
|
|
try
|
|
|
|
{calculate the code lengths for the literal symbols}
|
|
GenerateCodeLengths(15, aStream.LitBuckets^, CodeLens, 0, aLog);
|
|
|
|
{calculate the number of the used codelengths for the literals}
|
|
LitCodeCount := 286;
|
|
repeat
|
|
dec(LitCodeCount);
|
|
until (CodeLens[LitCodeCount] <> 0);
|
|
inc(LitCodeCount);
|
|
|
|
{calculate the code lengths for the distance symbols}
|
|
GenerateCodeLengths(15, aStream.DistBuckets^, CodeLens,
|
|
LitCodeCount, aLog);
|
|
|
|
{calculate the number of the used codelengths for the distances}
|
|
DistCodeCount := 32;
|
|
repeat
|
|
dec(DistCodeCount);
|
|
until (CodeLens[DistCodeCount + LitCodeCount] <> 0);
|
|
inc(DistCodeCount);
|
|
|
|
{calculate the code lengths array as a stream of items}
|
|
CodeLenStream := TAbDfCodeLenStream.Create(aLog);
|
|
CodeLenStream.Build(CodeLens, LitCodeCount + DistCodeCount);
|
|
|
|
{calculate the codelengths for the code lengths}
|
|
GenerateCodeLengths(7, CodeLenStream.Buckets^, CLCodeLens, 0, nil);
|
|
|
|
{calculate the number of the used codelengths for the code lengths}
|
|
LenCodeCount := 19;
|
|
repeat
|
|
dec(LenCodeCount);
|
|
until (CLCodeLens[dfc_CodeLengthIndex[LenCodeCount]] <> 0);
|
|
inc(LenCodeCount);
|
|
{..there's a minimum of four, though}
|
|
if (LenCodeCount < 4) then
|
|
LenCodeCount := 4;
|
|
|
|
{if we have to work out and use the best method...}
|
|
if aUseBest then begin
|
|
|
|
{calculate the number of bits required for the compressed data
|
|
using dynamic huffman trees}
|
|
BitCount := CalcDynamicBitCount(aUseDeflate64,
|
|
aStream.LitBuckets,
|
|
aStream.DistBuckets,
|
|
CodeLenStream.Buckets,
|
|
CodeLens,
|
|
CLCodeLens,
|
|
LitCodeCount,
|
|
DistCodeCount,
|
|
LenCodeCount);
|
|
|
|
{choose the algorithm with the smallest size}
|
|
StaticSize := aStream.StaticSize;
|
|
StoredSize := (aStream.StoredSize + 4) * 8;
|
|
if (StaticSize < BitCount) then begin
|
|
if (StoredSize < StaticSize) then
|
|
EncodeLZStreamStored(aFinalBlock, aStream, aBitStrm,
|
|
(StoredSize div 8) - 4, aLog)
|
|
else
|
|
EncodeLZStreamStatic(aFinalBlock, aUseDeflate64,
|
|
aStream, aBitStrm, aLog);
|
|
Exit;
|
|
end
|
|
else if (StoredSize < BitCount) then begin
|
|
EncodeLZStreamStored(aFinalBlock, aStream, aBitStrm,
|
|
(StoredSize div 8) - 4, aLog);
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
{create the code lengths tree}
|
|
CodeLenTree := TAbDfDecodeHuffmanTree.Create(19, 7, huEncoding);
|
|
CodeLenTree.Build(CLCodeLens, 0, 19, [0], $FFFF);
|
|
|
|
{$IFDEF UseLogging}
|
|
{log the tree}
|
|
if (aLog <> nil) then begin
|
|
aLog.WriteLine('Code lengths tree');
|
|
CodeLenTree.DebugPrint(aLog);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{calculate the literal encoding tree}
|
|
LitTree := TAbDfDecodeHuffmanTree.Create(286, 15, huEncoding);
|
|
LitTree.Build(CodeLens, 0, LitCodeCount,
|
|
dfc_LitExtraBits, dfc_LitExtraOffset);
|
|
|
|
{$IFDEF UseLogging}
|
|
{log the tree}
|
|
if (aLog <> nil) then begin
|
|
aLog.WriteLine('Literal/length tree');
|
|
LitTree.DebugPrint(aLog);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{calculate the distance tree}
|
|
if aUseDeflate64 then
|
|
DistTree := TAbDfDecodeHuffmanTree.Create(32, 15, huEncoding)
|
|
else
|
|
DistTree := TAbDfDecodeHuffmanTree.Create(30, 15, huEncoding);
|
|
DistTree.Build(CodeLens, LitCodeCount, DistCodeCount,
|
|
dfc_DistExtraBits, dfc_DistExtraOffset);
|
|
|
|
{$IFDEF UseLogging}
|
|
if (aLog <> nil) then begin
|
|
{log the tree}
|
|
aLog.WriteLine('Distance tree');
|
|
DistTree.DebugPrint(aLog);
|
|
|
|
{log the new block}
|
|
aLog.WriteLine('..Writing new block...');
|
|
aLog.WriteLine(Format('..final block? %d', [ord(aFinalBlock)]));
|
|
aLog.WriteLine('..block type? 2');
|
|
aLog.WriteLine(Format('Count of literals: %d', [LitCodeCount]));
|
|
aLog.WriteLine(Format('Count of distances: %d', [DistCodeCount]));
|
|
aLog.WriteLine(Format('Count of code lengths: %d', [LenCodeCount]));
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{output the block information to the bit stream}
|
|
if aFinalBlock then
|
|
Code := 1 + (2 shl 1)
|
|
else
|
|
Code := 0 + (2 shl 1);
|
|
aBitStrm.WriteBits(Code, 3);
|
|
|
|
{output the various counts to the bit stream}
|
|
Code := (LitCodeCount - 257) +
|
|
((DistCodeCount - 1) shl 5) +
|
|
((LenCodeCount - 4) shl 10);
|
|
aBitStrm.WriteBits(Code, 14);
|
|
|
|
{output the code length codelengths to the bit stream}
|
|
for i := 0 to pred(LenCodeCount) do
|
|
aBitStrm.WriteBits(CLCodeLens[dfc_CodeLengthIndex[i]], 3);
|
|
|
|
{encode and write the codelength stream to the bit stream}
|
|
CodeLenStream.Encode(aBitStrm, CodeLenTree);
|
|
|
|
{encode and write the LZ77 stream to the bit stream}
|
|
aStream.Encode(aBitStrm, LitTree, DistTree, aUseDeflate64);
|
|
|
|
{output the end-of-block marker to the bit stream}
|
|
OutputEndOfBlock(aBitStrm, LitTree);
|
|
{$IFDEF UseLogging}
|
|
if (aLog <> nil) then
|
|
aLog.WriteLine('Char: end-of-block marker (#256)');
|
|
{$ENDIF}
|
|
|
|
finally
|
|
LitTree.Free;
|
|
DistTree.Free;
|
|
CodeLenTree.Free;
|
|
CodeLenStream.Free;
|
|
end;
|
|
end;
|
|
{====================================================================}
|
|
|
|
|
|
{===Single algorithm Static/Dynamic Huffman tree deflate=============}
|
|
function DeflateStaticDynamic(aStatic : boolean;
|
|
aUseBest: boolean;
|
|
aSource : TStream; aDest : TStream;
|
|
aHelper : TAbDeflateHelper;
|
|
aLog : TAbLogger) : longint;
|
|
var
|
|
i : integer;
|
|
SlideWin : TAbDfInputWindow;
|
|
BitStrm : TAbDfOutBitStream;
|
|
LZ77Stream : TAbDfLZStream;
|
|
KeyLen : integer;
|
|
Match : TAbDfMatch;
|
|
PrevMatch : TAbDfMatch;
|
|
UseDeflate64 : boolean;
|
|
UseCRC32 : boolean;
|
|
GotMatch : boolean;
|
|
LZStrmIsFull : boolean;
|
|
TestForBinary: boolean;
|
|
begin
|
|
{note: turn on the following define to see when and how the lazy
|
|
matching algorithm works}
|
|
{$IFDEF UseLogging}
|
|
{$DEFINE UseLazyMatchLogging}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF UseLogging}
|
|
if (aLog <> nil) then
|
|
if aStatic then
|
|
aLog.WriteLine('..compressing source data with static huffman trees')
|
|
else
|
|
aLog.WriteLine('..compressing source data with dynamic huffman trees');
|
|
{$ENDIF}
|
|
|
|
{prepare for the try..finally}
|
|
SlideWin := nil;
|
|
BitStrm := nil;
|
|
LZ77Stream := nil;
|
|
try
|
|
|
|
{create the sliding window}
|
|
UseDeflate64 := (aHelper.Options and dfc_UseDeflate64) <> 0;
|
|
UseCRC32 := (aHelper.Options and dfc_UseAdler32) = 0;
|
|
SlideWin := TAbDfInputWindow.Create(aSource,
|
|
aHelper.StreamSize,
|
|
aHelper.WindowSize,
|
|
aHelper.ChainLength,
|
|
UseDeflate64, UseCRC32);
|
|
SlideWin.OnProgress := aHelper.OnProgressStep;
|
|
|
|
{create the bit stream}
|
|
BitStrm := TAbDfOutBitStream.Create(aDest);
|
|
|
|
{create the LZ77 stream}
|
|
LZ77Stream := TAbDfLZStream.Create(SlideWin, UseDeflate64, aLog);
|
|
LZStrmIsFull := false;
|
|
TestForBinary := true;
|
|
|
|
{set the previous match to be a literal character: this will
|
|
ensure that no lazy matching goes on with the first key read}
|
|
PrevMatch.maLen := 0;
|
|
|
|
{get the first key length}
|
|
KeyLen := SlideWin.GetNextKeyLength;
|
|
|
|
{while the current key is three characters long...}
|
|
while (KeyLen = 3) do begin
|
|
|
|
{tweak for binary/text}
|
|
{note: the test for whether a stream is binary or not is to
|
|
check whether there are any #0 characters in the first
|
|
1024 bytes: if there are the stream is binary.
|
|
this test and tweaking is based on experimentation
|
|
compression ratios for binary and text files based on the
|
|
PKZIP 'n' option.}
|
|
if TestForBinary and (LZ77Stream.StoredSize = 1024) then begin
|
|
if (aHelper.PKZipOption = 'n') then
|
|
if (LZ77Stream.LitBuckets^[0] = 0) then begin
|
|
aHelper.AmpleLength := aHelper.AmpleLength * 2;
|
|
aHelper.MaxLazyLength := aHelper.MaxLazyLength * 2;
|
|
aHelper.ChainLength := aHelper.ChainLength * 2;
|
|
SlideWin.ChainLen := aHelper.ChainLength;
|
|
end;
|
|
TestForBinary := false;
|
|
end;
|
|
|
|
{if the LZ77 stream is full, empty it}
|
|
if LZStrmIsFull then begin
|
|
if aStatic then
|
|
EncodeLZStreamStatic(false, UseDeflate64,
|
|
LZ77Stream, BitStrm, aLog)
|
|
else
|
|
EncodeLZStreamDynamic(false, UseDeflate64, aUseBest,
|
|
LZ77Stream, BitStrm, aLog);
|
|
LZ77Stream.Clear;
|
|
LZStrmIsFull := false;
|
|
end;
|
|
|
|
{try and find a match of three or more characters (note: this
|
|
has the side effect of adding the current key to the internal
|
|
hash table); this routine will only return true if it finds a
|
|
match greater than the previous match}
|
|
GotMatch := SlideWin.FindLongestMatch(aHelper.AmpleLength,
|
|
Match, PrevMatch);
|
|
|
|
{if the maximum match length were three and the distance exceeds
|
|
4096 bytes, it's most likely that we'll get better compression
|
|
by outputting the three literal bytes rather than by outputting
|
|
a length symbol, a distance symbol, and at least ten extra
|
|
bits for the extra distance value}
|
|
if (Match.maLen = 3) and (Match.maDist > 4096) then
|
|
GotMatch := false;
|
|
|
|
{if we found a match...}
|
|
if GotMatch then begin
|
|
|
|
{if there were no previous match, we can't do any lazy match
|
|
processing now, so save the current match details ready for
|
|
lazy matching the next time through, and advance the sliding
|
|
window}
|
|
if (PrevMatch.maLen = 0) then begin
|
|
PrevMatch.maLen := Match.maLen;
|
|
PrevMatch.maDist := Match.maDist;
|
|
PrevMatch.maLit := Match.maLit;
|
|
SlideWin.AdvanceByOne;
|
|
end
|
|
|
|
{otherwise the previous match is smaller than this one, so
|
|
we're going to accept this match in preference; throw away
|
|
the previous match, output the previous literal character
|
|
instead and save these match details}
|
|
else begin
|
|
{$IFDEF UseLazyMatchLogging}
|
|
if (aLog <> nil) then
|
|
aLog.WriteLine(
|
|
Format(
|
|
'..this match longer, rejecting previous one (%d,%d)',
|
|
[PrevMatch.maLen, PrevMatch.maDist]));
|
|
{$ENDIF}
|
|
LZStrmIsFull := LZ77Stream.AddLiteral(PrevMatch.maLit);
|
|
PrevMatch.maLen := Match.maLen;
|
|
PrevMatch.maDist := Match.maDist;
|
|
PrevMatch.maLit := Match.maLit;
|
|
SlideWin.AdvanceByOne;
|
|
end;
|
|
|
|
{if, by this point, we're storing up a match, check to see
|
|
if it equals or exceeds the maximum lazy match length; if
|
|
it does then output the match right now and avoid checking
|
|
for a lazy match}
|
|
if (PrevMatch.maLen >= aHelper.MaxLazyLength) then begin
|
|
{$IFDEF UseLazyMatchLogging}
|
|
if (aLog <> nil) then
|
|
if ((aHelper.Options and dfc_UseLazyMatch) <> 0) then
|
|
aLog.WriteLine('..match longer than max lazy match, using it');
|
|
{$ENDIF}
|
|
LZStrmIsFull :=
|
|
LZ77Stream.AddLenDist(PrevMatch.maLen, PrevMatch.maDist);
|
|
SlideWin.Advance(PrevMatch.maLen - 1, PrevMatch.maLen - 1);
|
|
PrevMatch.maLen := 0;
|
|
end;
|
|
end
|
|
|
|
{otherwise, we don't have a match at all: so we possibly just
|
|
need to output a literal character}
|
|
else begin
|
|
{if there was a previous match, output it and discard the
|
|
results of this match}
|
|
if (PrevMatch.maLen <> 0) then begin
|
|
LZStrmIsFull :=
|
|
LZ77Stream.AddLenDist(PrevMatch.maLen, PrevMatch.maDist);
|
|
SlideWin.Advance(PrevMatch.maLen - 1, PrevMatch.maLen - 2);
|
|
PrevMatch.maLen := 0;
|
|
end
|
|
|
|
{otherwise there was no previous match or it's already been
|
|
output, so output this literal}
|
|
else begin
|
|
LZStrmIsFull := LZ77Stream.AddLiteral(Match.maLit);
|
|
SlideWin.AdvanceByOne;
|
|
PrevMatch.maLen := 0;
|
|
end;
|
|
end;
|
|
|
|
{get the next key}
|
|
KeyLen := SlideWin.GetNextKeyLength;
|
|
end;
|
|
|
|
{if the last key read were one or two characters in length, save
|
|
them as literal character encodings}
|
|
if (KeyLen > 0) then begin
|
|
{if there's a match pending, it'll be of length 3: output it}
|
|
if (PrevMatch.maLen <> 0) then begin
|
|
Assert(PrevMatch.maLen = 3,
|
|
'DeflateStaticDynamic: previous match should be length 3');
|
|
LZ77Stream.AddLenDist(PrevMatch.maLen, PrevMatch.maDist);
|
|
end
|
|
{otherwise, output the one or two final literals}
|
|
else
|
|
for i := 1 to KeyLen do
|
|
LZ77Stream.AddLiteral(SlideWin.GetNextChar);
|
|
end;
|
|
|
|
{empty the LZ77 stream}
|
|
if aStatic then
|
|
EncodeLZStreamStatic(true, UseDeflate64,
|
|
LZ77Stream, BitStrm, aLog)
|
|
else
|
|
EncodeLZStreamDynamic(true, UseDeflate64, aUseBest,
|
|
LZ77Stream, BitStrm, aLog);
|
|
|
|
{calculate the checksum of the input stream}
|
|
Result := SlideWin.Checksum;
|
|
finally
|
|
{free the objects}
|
|
SlideWin.Free;
|
|
BitStrm.Free;
|
|
LZ77Stream.Free;
|
|
end;{try..finally}
|
|
|
|
{$IFDEF UseLogging}
|
|
{log it}
|
|
if (aLog <> nil) then
|
|
aLog.WriteLine(Format('..checksum: %8x', [Result]))
|
|
{$ENDIF}
|
|
end;
|
|
{====================================================================}
|
|
|
|
|
|
{===Simple storing===================================================}
|
|
function DeflateStored(aSource : TStream; aDest : TStream;
|
|
aHelper : TAbDeflateHelper;
|
|
aLog : TAbLogger) : longint;
|
|
const
|
|
StoredBlockSize = $FFFF;
|
|
var
|
|
Buffer : PAnsiChar;
|
|
BytesRead : LongWord;
|
|
ByteCount : Int64;
|
|
BytesToGo : Int64;
|
|
CurPos : Int64;
|
|
Size : Int64;
|
|
Percent : longint;
|
|
CheckSum : longint;
|
|
UseCRC32 : boolean;
|
|
BlockHeader : packed record
|
|
bhInfo : byte;
|
|
bhSize : word;
|
|
bhNotSize : word;
|
|
end;
|
|
begin
|
|
{note: this routine merely stores the aSource stream data, no
|
|
compression is attempted or done}
|
|
{$IFDEF UseLogging}
|
|
if (aLog <> nil) then
|
|
aLog.WriteLine('..storing source data to destination, no compression');
|
|
{$ENDIF}
|
|
|
|
{initialize}
|
|
ByteCount := 0;
|
|
UseCRC32 := (aHelper.Options and dfc_UseAdler32) = 0;
|
|
if UseCRC32 then
|
|
Checksum := -1 { CRC32 starts off with all bits set}
|
|
else
|
|
CheckSum := 1; { Adler32 starts off with a value of 1}
|
|
if (aHelper.StreamSize > 0) then
|
|
BytesToGo := aHelper.StreamSize
|
|
else begin
|
|
CurPos := aSource.Seek(0, soCurrent);
|
|
Size := aSource.Seek(0, soEnd);
|
|
aSource.Seek(CurPos, soBeginning);
|
|
BytesToGo := Size - CurPos;
|
|
end;
|
|
|
|
{get a buffer}
|
|
GetMem(Buffer, StoredBlockSize);
|
|
try
|
|
|
|
{while there is still data to be stored...}
|
|
while (BytesToGo <> 0) do begin
|
|
|
|
{read the next block}
|
|
BytesRead := aSource.Read(Buffer^, StoredBlockSize);
|
|
|
|
{fire the progress event}
|
|
if Assigned(aHelper.OnProgressStep) then begin
|
|
inc(ByteCount, BytesRead);
|
|
Percent := Round((100.0 * ByteCount) / aHelper.StreamSize);
|
|
aHelper.OnProgressStep(Percent);
|
|
end;
|
|
|
|
{update the checksum}
|
|
if UseCRC32 then
|
|
AbUpdateCRCBuffer(Checksum, Buffer^, BytesRead)
|
|
else
|
|
AbUpdateAdlerBuffer(Checksum, Buffer^, BytesRead);
|
|
|
|
{write the block header}
|
|
if (BytesRead = BytesToGo) then
|
|
BlockHeader.bhInfo := 1 {ie, final block, stored}
|
|
else
|
|
BlockHeader.bhInfo := 0; {ie, not final block, stored}
|
|
BlockHeader.bhSize := BytesRead;
|
|
BlockHeader.bhNotSize := not BlockHeader.bhSize;
|
|
aDest.WriteBuffer(BlockHeader, sizeof(BlockHeader));
|
|
|
|
{write the block of data}
|
|
aDest.WriteBuffer(Buffer^, BytesRead);
|
|
|
|
{$IFDEF UseLogging}
|
|
{log it}
|
|
if (aLog <> nil) then begin
|
|
if (BlockHeader.bhInfo = 0) then
|
|
aLog.WriteLine(Format('..block size: %d', [BytesRead]))
|
|
else
|
|
aLog.WriteLine(Format('..block size: %d (final block)',
|
|
[BytesRead]));
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{decrement the number of bytes to go}
|
|
dec(BytesToGo, BytesRead);
|
|
end;
|
|
finally
|
|
FreeMem(Buffer);
|
|
end;
|
|
|
|
{return the checksum}
|
|
{note: the CRC32 checksum algorithm requires a post-conditioning
|
|
step after being calculated (the result is NOTted), whereas
|
|
Adler32 does not}
|
|
if UseCRC32 then
|
|
Result := not Checksum
|
|
else
|
|
Result := Checksum;
|
|
|
|
{$IFDEF UseLogging}
|
|
{log it}
|
|
if (aLog <> nil) then
|
|
aLog.WriteLine(Format('..checksum: %8x', [Result]))
|
|
{$ENDIF}
|
|
end;
|
|
{====================================================================}
|
|
|
|
|
|
{===Interfaced routine===============================================}
|
|
function Deflate(aSource : TStream; aDest : TStream;
|
|
aHelper : TAbDeflateHelper) : longint;
|
|
var
|
|
Helper : TAbDeflateHelper;
|
|
Log : TAbLogger;
|
|
SourceStartPos : longint;
|
|
DestStartPos : longint;
|
|
begin
|
|
{pre-conditions: streams are allocated,
|
|
options enable some kind of archiving}
|
|
Assert(aSource <> nil, 'Deflate: aSource stream cannot be nil');
|
|
Assert(aDest <> nil, 'Deflate: aDest stream cannot be nil');
|
|
Assert((aHelper = nil) or ((aHelper.Options and $07) <> 0),
|
|
'Deflate: aHelper.Options must enable some kind of archiving');
|
|
|
|
{$IFDEF DefeatWarnings}
|
|
Result := 0;
|
|
{$ENDIF}
|
|
|
|
{prepare for the try..finally}
|
|
Helper := nil;
|
|
Log := nil;
|
|
|
|
try {finally}
|
|
try {except}
|
|
{create our helper; assign the passed one to it}
|
|
Helper := TAbDeflateHelper.Create;
|
|
if (aHelper <> nil) then
|
|
Helper.Assign(aHelper);
|
|
|
|
{save the current positions of both streams}
|
|
SourceStartPos := aSource.Position;
|
|
DestStartPos := aDest.Position;
|
|
|
|
{if the helper's stream size is -1, and it has a progress event
|
|
handler, calculate the stream size from the stream itself}
|
|
if Assigned(Helper.OnProgressStep) then begin
|
|
if (Helper.StreamSize = -1) then
|
|
Helper.StreamSize := aSource.Size;
|
|
end
|
|
|
|
{otherwise we certainly can't do any progress reporting}
|
|
else begin
|
|
Helper.OnProgressStep := nil;
|
|
Helper.StreamSize := 0;
|
|
end;
|
|
|
|
{if lazy matching is not requested, ensure the maximum lazy
|
|
match length is zero: this make the LZ77 code a little easier
|
|
to understand}
|
|
if ((Helper.Options and dfc_UseLazyMatch) = 0) then
|
|
Helper.MaxLazyLength := 0;
|
|
|
|
{patch up the various lengths in the helper if they specify the
|
|
maximum (that is, are equal to -1)}
|
|
if (Helper.AmpleLength = -1) then
|
|
Helper.AmpleLength := MaxLongInt;
|
|
if (Helper.MaxLazyLength = -1) then
|
|
Helper.MaxLazyLength := MaxLongInt;
|
|
if (Helper.ChainLength = -1) then
|
|
Helper.ChainLength := MaxLongInt;
|
|
|
|
{create the logger, if requested}
|
|
if (Helper.LogFile <> '') then begin
|
|
Log := TAbLogger.Create(Helper.LogFile);
|
|
Log.WriteLine('DEFLATING STREAM...');
|
|
{$IFNDEF UseLogging}
|
|
Log.WriteLine('Need to recompile the app with UseLogging turned on');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{use the helper's options property to decide what to do}
|
|
case (Helper.Options and $07) of
|
|
dfc_CanUseStored :
|
|
Result := DeflateStored(aSource, aDest, Helper, Log);
|
|
dfc_CanUseStatic :
|
|
Result := DeflateStaticDynamic(true, false, aSource, aDest, Helper, Log);
|
|
dfc_CanUseDynamic :
|
|
Result := DeflateStaticDynamic(false, false, aSource, aDest, Helper, Log);
|
|
else
|
|
Result := DeflateStaticDynamic(false, true, aSource, aDest, Helper, Log);
|
|
end;
|
|
|
|
{save the uncompressed and compressed sizes}
|
|
if (aHelper <> nil) then begin
|
|
aHelper.NormalSize := aSource.Position - SourceStartPos;
|
|
aHelper.CompressedSize := aDest.Position - DestStartPos;
|
|
end;
|
|
except
|
|
on E : EAbInternalDeflateError do begin
|
|
{$IFDEF UseLogging}
|
|
if (Log <> nil) then
|
|
Log.WriteLine(Format('Internal exception raised: %s',
|
|
[E.Message]));
|
|
{$ENDIF}
|
|
raise EAbDeflateError.Create(E.Message);
|
|
end;
|
|
end;
|
|
finally
|
|
Helper.Free;
|
|
Log.Free;
|
|
end;
|
|
{WARNING NOTE: the compiler will warn that the return value of this
|
|
function might be undefined. However, it is wrong: it
|
|
has been fooled by the code. If you don't want to see
|
|
this warning again, enable the DefeatWarnings
|
|
compiler define in AbDefine.inc.}
|
|
end;
|
|
{====================================================================}
|
|
|
|
end.
|
|
|