数据压缩 -- 源码

IF c<=2 THEN
BEGIN
IF c=1 THEN
c:=2 GetBits(4)
ELSE
IF c=2 THEN
c:=19 GetBits(CBIT);
WHILE c>=0 DO BEGIN
CLen^[i]:=0;INC(i);DEC(c);
END;
END ELSE BEGIN
CLen^[i]:=c-2;INC(i);
END;
END;
WHILE i<NC DO BEGIN
CLen^[i]:=0;INC(i);
END;
MakeTable(NC,PByte(CLen),12,PWord(CTable));
END;
END;

FUNCTION DecodeC:Word;
VAR
j,mask:Word;
BEGIN
IF BlockSize=0 THEN
BEGIN
BlockSize:=GetBits(16);
ReadPtLen(NT,TBIT,3);
ReadCLen;
ReadPtLen(NP,PBIT,-1);
END;
DEC(BlockSize);
j:=CTable^[BitBuf SHR (BITBUFSIZ-12)];
IF j>=NC THEN
BEGIN
mask:=1 SHL (BITBUFSIZ-13);
REPEAT
IF (BitBuf AND mask)<>0 THEN
j:=right^[j]
ELSE
j:=left^[j];
mask:=mask SHR 1;
UNTIL j<NC;
END;
FillBuf(CLen^[j]);
DecodeC:=j;
END;

FUNCTION DecodeP:Word;
VAR
j,mask:Word;
BEGIN
j:=PtTable[BitBuf SHR (BITBUFSIZ-8)];
IF j>=NP THEN
BEGIN
mask:=1 SHL (BITBUFSIZ-9);
REPEAT
IF (BitBuf AND mask)<>0 THEN
j:=right^[j]
ELSE
j:=left^[j];
mask:=mask SHR 1;
UNTIL j<NP;
END;
FillBuf(PtLen[j]);
IF j<>0 THEN
BEGIN
DEC(j);j:=(1 SHL j) GetBits(j);
END;
DecodeP:=j;
END;

{declared as static vars}
VAR
decode_i:Word;
decode_j:TwoByteInt;

PROCEDURE DecodeBuffer(count:Word;Buffer:PByte);
VAR
c,r:Word;
BEGIN
r:=0;DEC(decode_j);
WHILE (decode_j>=0) DO BEGIN
Buffer^[r]:=Buffer^[decode_i];decode_i:=SUCC(decode_i) AND PRED(DICSIZ);
INC(r);
IF r=count THEN
EXIT;
DEC(decode_j);
END;
WHILE TRUE DO BEGIN
c:=DecodeC;
IF c<=UCHARMAX THEN
BEGIN
Buffer^[r]:=c;INC(r);
IF r=count THEN
EXIT;
END ELSE BEGIN
decode_j:=c-(UCHARMAX 1-THRESHOLD);
decode_i:=(LongInt(r)-DecodeP-1)AND PRED(DICSIZ);
DEC(decode_j);
WHILE decode_j>=0 DO BEGIN
Buffer^[r]:=Buffer^[decode_i];
decode_i:=SUCC(decode_i) AND PRED(DICSIZ);
INC(r);
IF r=count THEN
EXIT;
DEC(decode_j);
END;
END;
END;
END;

PROCEDURE Decode;
VAR
p:PByte;
l:Longint;
a:Word;
BEGIN
{Initialize decoder variables}
GetMem(p,DICSIZ);
InitGetBits;BlockSize:=0;
decode_j:=0;
{skip file size}
l:=OrigSize;DEC(compSize,4);
{unpacks the file}
WHILE l>0 DO BEGIN
IF l>DICSIZ THEN
a:=DICSIZ
ELSE
a:=l;
DecodeBuffer(a,p);
OutFile.Write(p^,a);DEC(l,a);
END;
FreeMem(p,DICSIZ);
END;

{********************************* Compression ********************************}

{-------------------------------- Huffman part --------------------------------}

PROCEDURE CountLen(i:TwoByteInt);
BEGIN
IF i<n THEN
BEGIN
IF Depth<16 THEN
INC(LenCnt[Depth])
ELSE
INC(LenCnt[16]);
END ELSE BEGIN
INC(Depth);
CountLen(Left^[i]);CountLen(Right^[i]);
DEC(Depth);
END;
END;

PROCEDURE MakeLen(root:TwoByteInt);
VAR
i,k:TwoByteInt;
cum:word;
BEGIN
FOR i:=0 TO 16 DO
LenCnt[i]:=0;
CountLen(root);cum:=0;
FOR i:=16 DOWNTO 1 DO
INC(cum,LenCnt[i] SHL (16-i));
WHILE cum<>0 DO BEGIN
DEC(LenCnt[16]);
FOR i:=15 DOWNTO 1 DO
IF LenCnt[i]<>0 THEN
BEGIN
DEC(LenCnt[i]);INC(LenCnt[SUCC(i)],2);
BREAK;
END;
DEC(cum);
END;
FOR i:=16 DOWNTO 1 DO BEGIN
k:=PRED(Longint(LenCnt[i]));
WHILE k>=0 DO BEGIN
DEC(k);Len^[SortPtr^[0]]:=i;
ASM
ADD WORD PTR SortPtr,2; {SortPtr:=addr(SortPtr^[1]);}
END;
END;
END;
END;

PROCEDURE DownHeap(i:TwoByteInt);
VAR
j,k:TwoByteInt;
BEGIN
k:=Heap^[i];j:=i SHL 1;
WHILE (j<=HeapSize) DO BEGIN
IF (j<HeapSize)AND(Freq^[Heap^[j]]>Freq^[Heap^[SUCC(j)]]) THEN INC(j);
IF Freq^[k]<=Freq^[Heap^[j]] THEN break;
Heap^[i]:=Heap^[j];i:=j;j:=i SHL 1;
END;
Heap^[i]:=k;
END;

PROCEDURE MakeCode(n:TwoByteInt;Len:PByte;Code:PWord);

文章整理：西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!