数据压缩 -- 源码_Delphi程序_学习笔记★闵涛★计算机学习电脑编程软硬件技巧


	转至繁体中文版	\| 网站首页 \| 图文教程 \| 资源下载 \| 站长博客 \| 图片素材 \| 武汉seo \| 武汉网站优化 \|

数据压缩 -- 源码

作者：闵涛文章来源：闵涛的学习笔记点击数：4561 更新时间：2009/4/23 18:30:48

;     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);
VAR
i,k:TwoByteInt;
start:ARRAY[0..17] OF Word;
BEGIN
start[1]:=0;
FOR i:=1 TO 16 DO
    start[SUCC(i)]:=(start[i]+LenCnt[i])SHL 1;
FOR i:=0 TO PRED(n) DO BEGIN
    k:=Len^[i];
    Code^[i]:=start[k];
    INC(start[k]);
END;
END;

FUNCTION MakeTree(NParm:TwoByteInt;Freqparm:PWord;LenParm:PByte;Codeparm:PWord):TwoByteInt;
VAR
i,j,k,Avail:TwoByteInt;
BEGIN
n:=NParm;Freq:=Freqparm;Len:=LenParm;Avail:=n;HeapSize:=0;Heap^[1]:=0;
FOR i:=0 TO PRED(n) DO BEGIN
    Len^[i]:=0;
    IF Freq^[i]<>0 THEN
      BEGIN
        INC(HeapSize);Heap^[HeapSize]:=i;
      END;
END;
IF HeapSize<2 THEN
    BEGIN
      Codeparm^[Heap^[1]]:=0;MakeTree:=Heap^[1];
      EXIT;
    END;
FOR i:=(HeapSize div 2)DOWNTO 1 DO DownHeap(i);
SortPtr:=Codeparm;
REPEAT
    i:=Heap^[1];
    IF i<n THEN
      BEGIN
        SortPtr^[0]:=i;
        ASM
          ADD WORD PTR SortPtr,2; {SortPtr:=addr(SortPtr^[1]);}
        END;
      END;
    Heap^[1]:=Heap^[HeapSize];DEC(HeapSize);DownHeap(1);
    j:=Heap^[1];
    IF j<n THEN
      BEGIN
        SortPtr^[0]:=j;
        ASM
          ADD WORD PTR SortPtr,2; {SortPtr:=addr(SortPtr^[1]);}
        END;
      END;
    k:=Avail;INC(Avail);
    Freq^[k]:=Freq^[i]+Freq^[j];Heap^[1]:=k;DownHeap(1);
    Left^[k]:=i;Right^[k]:=j;
UNTIL HeapSize<=1;
SortPtr:=Codeparm;
MakeLen(k);MakeCode(NParm,LenParm,Codeparm);
MakeTree:=k;
END;

PROCEDURE CountTFreq;
VAR
i,k,n,Count:TwoByteInt;
BEGIN
FOR i:=0 TO PRED(NT) DO
    TFreq[i]:=0;n:=NC;
WHILE (n>0)AND(CLen^[PRED(n)]=0) DO
    DEC(n);
i:=0;
WHILE i<n DO BEGIN
    k:=CLen^[i];INC(i);
    IF k=0 THEN
      BEGIN
        Count:=1;
        WHILE (i<n)AND(CLen^[i]=0) DO BEGIN
          INC(i);INC(Count);
        END;
        IF Count<=2 THEN
          INC(TFreq[0],Count)
        ELSE
          IF Count<=18 THEN
            INC(TFreq[1])
          ELSE
            IF Count=19 THEN
              BEGIN
                INC(TFreq[0]);INC(TFreq[1]);
              END ELSE
                INC(TFreq[2]);
      END ELSE
        INC(TFreq[k+2]);
END;
END;

PROCEDURE WritePtLen(n,nBit,ispecial:TwoByteInt);
VAR
i,k:TwoByteInt;
BEGIN
WHILE (n>0)AND(PtLen[PRED(n)]=0) DO
    DEC(n);
PutBits(nBit,n);i:=0;
WHILE (i<n) DO BEGIN
    k:=PtLen[i];INC(i);
    IF k<=6 THEN
      PutBits(3,k)
    ELSE
      BEGIN
        DEC(k,3);
        PutBits(k,(1 SHL k)-2);
      END;
    IF i=ispecial THEN
      BEGIN
        WHILE (i<6)AND(PtLen[i]=0) DO
          INC(i);
        PutBits(2,(i-3)AND 3);
      END;
END;
END;