数据压缩 -- 源码

implementation

TYPE
{$IFDEF WIN32}
TwoByteInt = SmallInt;
{$ELSE}
TwoByteInt = Integer;
{$ENDIF}
PWord=^TWord;
TWord=ARRAY[0..32759]OF TwoByteInt;
PByte=^TByte;
TByte=ARRAY[0..65519]OF Byte;

CONST
(*
NOTE :
The following constants are set to the values used by LHArc.
You can change three of them as follows :

DICBIT : Lempel-Ziv dictionnary size.
Lowering this constant can lower the compression efficiency a lot !
But increasing it (on a 32 bit platform only, i.e. Delphi 2) will not yield
noticeably better results.
If you set DICBIT to 15 or more, set PBIT to 5; and if you set DICBIT to 19
or more, set NPT to NP, too.

WINBIT : Sliding window size.
The compression ratio depends a lot of this value.
You can increase it to 15 to get better results on large files.
I recommend doing this if you have enough memory, except if you want that
your compressed data remain compatible with LHArc.
On a 32 bit platform, you can increase it to 16. Using a larger value will
only waste time and memory.

BUFBIT : I/O Buffer size. You can lower it to save memory, or increase it
to reduce disk access.
*)

BITBUFSIZ=16;
UCHARMAX=255;

DICBIT=13;
DICSIZ=1 SHL DICBIT;

MATCHBIT=8;
MAXMATCH=1 SHL MATCHBIT;
THRESHOLD=3;
PERCFLAG=$8000;

NC=(UCHARMAX MAXMATCH 2-THRESHOLD);
CBIT=9;
CODEBIT=16;

NP=DICBIT 1;
NT=CODEBIT 3;
PBIT=4; {Log2(NP)}
TBIT=5; {Log2(NT)}
NPT=NT; {Greater from NP and NT}

NUL=0;
MAXHASHVAL=(3*DICSIZ (DICSIZ SHR 9 1)*UCHARMAX);

WINBIT=14;
WINDOWSIZE=1 SHL WINBIT;

BUFBIT=13;
BUFSIZE=1 SHL BUFBIT;

TYPE
BufferArray = ARRAY[0..PRED(BUFSIZE)]OF Byte;
LeftRightArray = ARRAY[0..2*(NC-1)]OF Word;
CTableArray = ARRAY[0..4095]OF Word;
CLenArray = ARRAY[0..PRED(NC)]OF Byte;
HeapArray = ARRAY[0..NC]OF Word;

VAR
OrigSize,CompSize:Longint;
InFile,OutFile:TStream;

BitBuf:Word;
n,HeapSize:TwoByteInt;
SubBitBuf,BitCount:Word;

Buffer:^BufferArray;
BufPtr:Word;

Left,Right:^LeftRightArray;

PtTable:ARRAY[0..255]OF Word;
PtLen:ARRAY[0..PRED(NPT)]OF Byte;
CTable:^CTableArray;
CLen:^CLenArray;

BlockSize:Word;

{ The following variables are used by the compression engine only }

Heap:^HeapArray;
LenCnt:ARRAY[0..16]OF Word;

Freq,SortPtr:PWord;
Len:PByte;
Depth:Word;

Buf:PByte;

CFreq:ARRAY[0..2*(NC-1)]OF Word;
PFreq:ARRAY[0..2*(NP-1)]OF Word;
TFreq:ARRAY[0..2*(NT-1)]OF Word;

CCode:ARRAY[0..PRED(NC)]OF Word;
PtCode:ARRAY[0..PRED(NPT)]OF Word;

CPos,OutputPos,OutputMask:Word;
Text,ChildCount:PByte;

Pos,MatchPos,Avail:Word;
Position,Parent,Prev,Next:PWord;

Remainder,MatchLen:TwoByteInt;
Level:PByte;

{********************************** File I/O **********************************}

FUNCTION GetC:Byte;
BEGIN
IF BufPtr=0 THEN
InFile.Read(Buffer^,BUFSIZE);
GetC:=Buffer^[BufPtr];BufPtr:=SUCC(BufPtr)AND PRED(BUFSIZE);
END;

PROCEDURE PutC(c:Byte);
BEGIN
IF BufPtr=BUFSIZE THEN
BEGIN
OutFile.Write(Buffer^,BUFSIZE);BufPtr:=0;
END;
Buffer^[BufPtr]:=C;INC(BufPtr);
END;

FUNCTION BRead(p:POINTER;n:TwoByteInt):TwoByteInt;
BEGIN
BRead := InFile.Read(p^,n);
END;

PROCEDURE BWrite(p:POINTER;n:TwoByteInt);
BEGIN
OutFile.Write(p^,n);
END;

{**************************** Bit handling routines ***************************}

PROCEDURE FillBuf(n:TwoByteInt);
BEGIN
BitBuf:=(BitBuf SHL n);
WHILE n>BitCount DO BEGIN
DEC(n,BitCount);
BitBuf:=BitBuf OR (SubBitBuf SHL n);
IF (CompSize<>0) THEN