您现在的位置:首页 >> 基础算法 >> window基础 >> 内容

Delphi采用LZ77算法的一段压缩代码

时间:2011/9/3 15:32:19 点击:

  核心提示:const MAX_WND_SIZE=1024;procedure Write12BitStream(pbuffer: pchar; bitoffset: ULONG);var bytebound,...
const MAX_WND_SIZE=1024;procedure Write12BitStream(pbuffer: pchar; bitoffset: ULONG);
var
  bytebound, bitinbyte: ULONG;
begin
  bytebound := bitoffset shr 3;
  bitinbyte := bitoffset and $7;
  PByte(ULONG(pbuffer) + bytebound)^ := PByte(ULONG(pbuffer) + bytebound)^ or (1 shl bitinbyte);
end;

procedure Write02BitStream(pbuffer: pchar; bitoffset: ULONG);
var
  bytebound, bitinbyte: ULONG;
begin
  bytebound := bitoffset shr 3;
  bitinbyte := bitoffset and $7;
  PByte(ULONG(pbuffer) + bytebound)^ := PByte(ULONG(pbuffer) + bytebound)^ and not (1 shl bitinbyte);
end;

function ReadBitFromBitStream(pbuffer: pchar; bitoffset: ULONG): ULONG;
var
  bytebound, bitinbyte: ULONG;
begin
  result := 0;
  bytebound := bitoffset shr 3;
  bitinbyte := bitoffset and $7;
  if (PByte(ULONG(pbuffer) + bytebound)^ and (1 shl bitinbyte)) = (1 shl bitinbyte) then
    result := 1;
end;

function CompareStrings(pSrc: PChar; SrcLen: ULONG; pComp: PChar; CompLen: ULONG): ULONG;
var
  step, MinLen: ULONG;
  pStr1, pStr2: PChar;
begin
  step := 0; result := 0;
  if (pSrc = nil) or (pComp = nil) then exit;
  pStr1 := pSrc; pStr2 := pComp;
  if CompLen > SrcLen then
    MinLen := SrcLen
  else
    MinLen := CompLen;
  while (step < MinLen) do
  begin
    ULONG(pStr1) := ULONG(pSrc) + step;
    ULONG(pStr2) := ULONG(pComp) + step;
    if pStr1^ <> pStr2^ then break;
    step := step + 1;
  end;
  result := step;
end;

function FindLongestSubString(pSrc: PChar; SrcLen: ULONG; pComp: PChar; Offset: PULONG): ULONG;
var
  len, MaxLen, step, tmplen: ULONG;
  pTmp: PChar;
begin
  Result := 0; Offset^ := 0; len := 0; MaxLen := 0; step := 0; tmplen := SrcLen; pTmp := pSrc;
  while tmplen > 0 do
  begin
    len := CompareStrings(pTmp, tmplen, pComp, tmplen);
    if len > MaxLen then
    begin
      MaxLen := len;
      Offset^ := step;
    end;
    tmplen := tmplen - 1;
    ULONG(pTmp) := ULONG(pTmp) + 1;
    step := step + 1;
  end;
  result := MaxLen;
end;

function ReadLengthInfo(pBuffer: PChar; bitoffset: ULONG; Offset: PULONG): ULONG;
var
  {  offset          length
    +-------+-------+-------+
    |   8     4 | 4     8   |
    +-------+-------+-------+
  }
  b1, b2, b3: Byte; i: integer;
  bytebound, bitinbyte, tmp1, tmp2: ULONG;
begin
  //////////
  bytebound := bitoffset shr 3;
  bitinbyte := bitoffset and 7;
  b1 := 0; b2 := 0; b3 := 0;
  for i := 0 to 7 do
  begin
    b1 := b1 or (ReadbitFromBitStream(pchar(ULONG(pBuffer) + bytebound), i + bitinbyte) shl i);
  end;
  for i := 0 to 7 do
  begin
    b2 := b2 or (ReadbitFromBitStream(pchar(ULONG(pBuffer) + bytebound), i + 8 + bitinbyte) shl i);
  end;
  for i := 0 to 7 do
  begin
    b3 := b3 or (ReadbitFromBitStream(pchar(ULONG(pBuffer) + bytebound), i + 16 + bitinbyte) shl i);
  end;
  tmp1 := b2 and $F;
  tmp1 := b1 or (tmp1 shl 8);
  tmp2 := (b2 and $F0) shr 4;
  tmp2 := (b3 shl 4) or tmp2;
  result := tmp2;
  offset^ := tmp1;
end;

procedure WriteLengthInfo(pBuffer: PChar; bitoffset: ULONG; Offset: ULONG; Leng: ULONG);
var
  b1, b2, b3: Byte;
  bytebound, bitinbyte: ULONG;
  i: integer;
begin
  if (Offset > MAX_WND_SIZE) or (Leng > MAX_WND_SIZE) then raise Exception.Create('Parameter is too long.');
   {  offset          length
    +-------+-------+-------+
    |   8     4 | 4     8   |
    +-------+-------+-------+
   }
  bytebound := bitoffset shr 3;
  bitinbyte := bitoffset and 7;
  b1 := Offset and $FF;
  b3 := (Leng and $FF0) shr 4;
  b2 := (Offset and $FF00) shr 8;
  b2 := b2 or ((Leng and $F) shl 4);
  for i := 0 to 7 do
  begin
    if (b1 shr i) and 1 = 1 then
      Write12bitStream(pchar(ULONG(pBuffer) + bytebound), i + bitinbyte)
    else
      Write02bitStream(pchar(ULONG(pBuffer) + bytebound), i + bitinbyte);
  end;
  for i := 0 to 7 do
  begin
    if (b2 shr i) and 1 = 1 then
      Write12bitStream(pchar(ULONG(pBuffer) + bytebound), i + 8 + bitinbyte)
    else
      Write02bitStream(pchar(ULONG(pBuffer) + bytebound), i + 8 + bitinbyte);
  end;
  for i := 0 to 7 do
  begin
    if (b3 shr i) and 1 = 1 then
      Write12bitStream(pchar(ULONG(pBuffer) + bytebound), i + 16 + bitinbyte)
    else
      Write02bitStream(pchar(ULONG(pBuffer) + bytebound), i + 16 + bitinbyte);
  end;
end;

//解压代码

procedure lz77DeCompress(pBuffer: PChar; BitLen: ULONG; pOutBuffer: PChar; OutByteLen: PULONG);
var
  offbit, leng, iSlideWndSize, offbyte, ipos, bytes: ULONG; b, d: byte;
  pSlideWndPtr, poutptr, pSrc: PChar;
  i: integer;
begin
  pSrc := pBuffer; poutptr := pOutBuffer; offbit := 0; bytes := (BitLen + 7) shr 3;
  while (offbit < BitLen) do
  begin
    if ULONG(poutptr) - MAX_WND_SIZE <= ULONG(pOutBuffer) then
    begin
      pSlideWndPtr := pOutBuffer;
      iSlideWndSize := ULONG(poutptr) - ULONG(pOutBuffer);
    end
    else
    begin
      ULONG(pSlideWndPtr) := ULONG(poutptr) - MAX_WND_SIZE;
      iSlideWndSize := MAX_WND_SIZE;
    end;
    b := ReadBitFromBitStream(pSrc, offbit);
    offbit := offbit + 1;
    if b = 1 then
    begin
      Leng := ReadLengthInfo(pSrc, offbit, @offbyte);
      CopyMemory(poutptr, PChar(ULONG(pSlideWndPtr) + offbyte), Leng);
      ULONG(poutptr) := ULONG(poutptr) + Leng;
      offbit := offbit + 24;
    end
    else
    begin
      d := 0;
      for i := 0 to 7 do
      begin
        d := d or (ReadBitFromBitStream(pSrc, offbit) shl i);
        offbit := offbit + 1;
      end;
      PByte(poutptr)^ := d;
      ULONG(poutptr) := ULONG(poutptr) + 1;
    end;
    ipos := (offbit + 7) shr 3;
    if assigned(callback) then
      callback(ipos, bytes);
  end;
  OutByteLen^ := ULONG(poutptr) - ULONG(pOutBuffer);
end;

//压缩代码

procedure lz77Compress(pBuffer: PChar; BufferLen: ULONG; pOutBuffer: PChar; OutBitLen: PULONG);
var
  offbit, leng, iSlideWndSize, offbyte, ipos: ULONG; b: byte;
  pSlideWndPtr, poutptr, pSrc: PChar;
  i, j: integer;
begin
  if (BufferLen > $FFFFFFFE shr 3) then raise Exception.Create('Input Stream is too long.');
  pSrc := pBuffer; poutptr := pOutBuffer; offbit := 0;
  while (ULONG(pSrc) - ULONG(pBuffer) < BufferLen) do
  begin
    if ULONG(pSrc) - MAX_WND_SIZE <= ULONG(pBuffer) then
    begin
      pSlideWndPtr := pBuffer;
      iSlideWndSize := ULONG(pSrc) - ULONG(pBuffer);
    end
    else
    begin
      ULONG(pSlideWndPtr) := ULONG(pSrc) - MAX_WND_SIZE;
      iSlideWndSize := MAX_WND_SIZE;
    end;
    leng := FindLongestSubString(pSlideWndPtr, iSlideWndSize, pSrc, @offbyte);
    if leng > 3 then
    begin
      Write12BitStream(poutptr, offbit);
      offbit := offbit + 1;
      WriteLengthInfo(poutptr, offbit, offbyte, leng);
      offbit := offbit + 24;
      ULONG(PSrc) := ULONG(PSrc) + leng;
    end
    else
    begin
      repeat
       b := PByte(PSrc)^;
       Write02BitStream(poutptr, offbit);
       offbit := offbit + 1;
       for i := 0 to 7 do
       begin
         if (b shr i) and 1 = 1 then
         begin
           Write12BitStream(poutptr, offbit);
           offbit := offbit + 1;
         end
         else
         begin
           Write02BitStream(poutptr, offbit);
           offbit := offbit + 1;
         end;
       end;
       ULONG(PSrc) := ULONG(PSrc) + 1;
       leng := leng - 1;
      until (leng > 0);
    end;
    ipos := ULONG(PSrc) - ULONG(pBuffer);
    if assigned(callback) then
      callback(ipos, BufferLen);
  end;
  OutBitLen^ := offbit;
end;

以上是新写的一个“压缩/解压缩”程序的核心代码,还有很大的提升空间,下面是使用它压缩一个BMP文件的图示,可以达到95%的压缩率(对于一般的DOC文件可以达到60-90%的压缩率,对于已经压缩的文件,反而会增大文件^_^),还不错。

作者:网络 来源:转载
共有评论 0相关评论
发表我的评论
  • 大名:
  • 内容:
  • 盒子文章(www.2ccc.com) © 2022 版权所有 All Rights Reserved.
  • 沪ICP备05001939号