lz77.pas

多种算法压缩与解压缩方式

unit lz77;

interface

{*******************************************************************************
lz77压缩算法单元
源文件出自王咏刚先生的《笨笨数据压缩教程》中的lz77.c
参见  http://www.contextfree.net/wangyg/
由崔东伟修改为pascal单元  Email:[e-mail]

在原C程序中，使用了一个STIDXNODE的结构来保存滑动窗口中每一个2字节串排序结果
该结构的pascal声明为:
  STIDXNODE=record
    off:word;
    off2:word;
    next:word;
  end;

由于该结构要分配一个64K(65536)大小的数据，所以需要的内存数量有点大，所以在这里
我进行了一些简化，其中的off2域实际上只在有连续重复字符出现的时候临时用一下，所
以完全可以省去，只用一个全局变量代替一下即可，next域虽然比较重要，但实际也可以
省去，想一下文件系统的FAT表是怎么工作的就可以明白了。FAT的存储链不需要next，其
位置便是next,所以简化的结果便只剩下了一个off域，就是本文件中的SortFAT。

如果需要原始的算法，请参照lz77.c

*******************************************************************************}


uses
  Windows, Messages, SysUtils, Classes,math;

const
  _MAX_WINDOW_SIZE  =	65536;

type
  TCompress=class

  private

  protected
	/////////////////////////////////////////////////////////
	// CopyBitsInAByte : 在一个字节范围内复制位流
	// 参数含义同 CopyBits 的参数
	// 说明：
	//		此函数由 CopyBits 调用，不做错误检查，即
	//		假定要复制的位都在一个字节范围内
    procedure CopyBitsInAByte(memDest:PByte;nDestPos:integer;memSrc:PByte;nSrcPos, nBits:integer);

	////////////////////////////////////////////////////////
	// CopyBits : 复制内存中的位流
	//		memDest - 目标数据区
	//		nDestPos - 目标数据区第一个字节中的起始位
	//		memSrc - 源数据区
	//		nSrcPos - 源数据区第一个字节的中起始位
	//		nBits - 要复制的位数
	//	说明：
	//		起始位的表示约定为从字节的高位至低位（由左至右）
	//		依次为 0，1，... , 7
	//		要复制的两块数据区不能有重合
    procedure CopyBits(memDest:PChar;nDestPos:integer;memSrc:PChar;nSrcPos, nBits:integer);

	//////////////////////////////////////////////////////////////
	// 将DWORD值从高位字节到低位字节排列
    procedure InvertDWord(pDW:PDWord);

	/////////////////////////////////////////////////////////////
	// 设置Abyte的第iBit位为aBit
	//		iBit顺序为高位起从0记数（左起）
    procedure SetBit(var Abyte:Byte; iBit:integer; aBit:byte);

	////////////////////////////////////////////////////////////
	// 得到字节Abyte第pos位的值
	//		pos顺序为高位起从0记数（左起）
    function GetBit(Abyte:byte;pos:integer):byte;

	////////////////////////////////////////////////////////////
	// 将位指针*piByte(字节偏移), *piBit(字节内位偏移)后移num位
    procedure MovePos(var piByte, piBit:integer;num:integer);

	/////////////////////////////////////////////////////////
	// 取log2(n)的upper_bound
    function UpperLog2(n:integer):integer;

	/////////////////////////////////////////////////////////
	// 取log2(n)的lower_bound
    function LowerLog2(n:integer):integer;


  public

     function Compress(src:PChar;srclen:integer;dest:PChar):integer;virtual; abstract;
     function DeCompress(src:PChar;srclen:integer;dest:PChar):boolean;virtual; abstract;

  end;


  TLZ77Compress=class(TCompress)
  private
    pWnd:PChar;
	// 窗口大小最大为 64k ，并且不做滑动
	// 每次最多只压缩 64k 数据，这样可以方便从文件中间开始解压
	// 当前窗口的长度
    nWndSize:integer;

	// 对滑动窗口中每一个2字节串排序
	// 排序是为了进行快速术语匹配
	// 排序的方法是用一个64k大小的指针数组
	// 数组下标依次对应每一个2字节串：(00 00) (00 01) ... (01 00) (01 01) ...
	// 每一个指针指向一个链表，链表中的节点为该2字节串的每一个出现位置
    SortTable:array[0..65535] of WORD;  // 256 * 256 指向SortHeap中下标的指针

	// 因为窗口不滑动，没有删除节点的操作，所以
	// 节点可以在SortHeap 中连续分配
    SortFAT:array[0..65535] of word;

	// 当前输出位置(字节偏移及位偏移)
    CurByte, CurBit:integer;

    lastbyte:byte;




  protected

	////////////////////////////////////////
	// 输出压缩码
	// code - 要输出的数
	// bits - 要输出的位数(对isGamma=TRUE时无效)
	// isGamma - 是否输出为γ编码
	procedure _OutCode(dest:PChar;code:DWord;bits:integer;isGamma:boolean);

	///////////////////////////////////////////////////////////
	// 在滑动窗口中查找术语
	// nSeekStart - 从何处开始匹配
	// offset, len - 用于接收结果，表示在滑动窗口内的偏移和长度
	// 返回值- 是否查到长度为3或3以上的匹配字节串
	function _SeekPhase(src:PChar;srclen,nSeekStart:integer;var offset,len:Integer):boolean;

	///////////////////////////////////////////////////////////
	// 得到已经匹配了3个字节的窗口位置offset
	// 共能匹配多少个字节
        function _GetSameLen(src:PChar; srclen, nSeekStart, offset:integer):integer;register;

	//////////////////////////////////////////
	// 将窗口向右滑动n个字节
	procedure _ScrollWindow(n:integer);register;

	// 向索引中添加一个2字节串
	procedure _InsertIndexItem(off:integer);register;

	// 初始化索引表，释放上次压缩用的空间
	procedure _InitSortTable;


  public

	/////////////////////////////////////////////
	// 压缩一段字节流
	// src - 源数据区
	// srclen - 源数据区字节长度, srclen <= 65536
	// dest - 压缩数据区，调用前分配srclen字节内存
	// 返回值 > 0 压缩数据长度
	// 返回值 = 0 数据无法压缩
	// 返回值 < 0 压缩中异常错误
     function Compress(src:PChar;srclen:integer;dest:PChar):integer;override;

	/////////////////////////////////////////////
	// 解压缩一段字节流
	// src - 接收原始数据的内存区, srclen <= 65536
	// srclen - 源数据区字节长度
	// dest - 压缩数据区
	// 返回值 - 成功与否
     function DeCompress(src:PChar;srclen:integer;dest:PChar):boolean;override;


  end;


  procedure lz77Compress(InStr, OutStr: TStream);
  procedure lz77Expand(InStr, OutStr: TStream);


implementation

{ TCompress }

  procedure lz77Compress(InStr, OutStr: TStream);
  var
    Compresser:TLZ77Compress;
    soulen,last,act,destlen:integer;
    flag1, flag2:word;
    soubuf:array[0..65535] of byte;
    destbuf:array[0..65535+16] of byte;
  begin
    Compresser:=TLZ77Compress.Create;
    try
      soulen:=InStr.Size;
      last := soulen;
      while ( last > 0 ) do
      begin
        act := min(65536, last);
        InStr.ReadBuffer(soubuf,act);
        dec(last, act);
        if (act = 65536) then			// out 65536 bytes
          flag1 := 0
        else					// out last blocks
          flag1 := act;
        OutStr.WriteBuffer(flag1,sizeof(WORD));
        destlen := Compresser.Compress(pchar(@soubuf[0]), act,pchar(@destbuf[0]));
        if (destlen = 0) then		// can't compress the block
        begin
          flag2 := flag1;
          OutStr.WriteBuffer(flag2, sizeof(WORD));
          OutStr.WriteBuffer(soubuf, act);
        end else
        begin
          flag2 := destlen;
          OutStr.WriteBuffer(flag2, sizeof(WORD));
          OutStr.WriteBuffer(destbuf, destlen);
        end;
      end;
    finally
      Compresser.free;
    end;
  end;

  procedure lz77Expand(InStr, OutStr: TStream);
  var
    Compresser:TLZ77Compress;
    soulen,last,act:integer;
    flag1, flag2:word;
    soubuf:array[0..65535] of byte;
    destbuf:array[0..65535+16] of byte;
  begin
    Compresser:=TLZ77Compress.Create;
    try
      soulen:=InStr.Size;
      last := soulen;
      while (last > 0) do
      begin
        InStr.ReadBuffer(flag1, sizeof(WORD));
        InStr.ReadBuffer(flag2, sizeof(WORD));
        dec(last,2 * sizeof(WORD));
        if (flag1 = 0) then
          act := 65536
        else
          act := flag1;
        if flag2>0 then
          dec(last,flag2)
        else
          dec(last,act);

        if (flag2 = flag1) then
        begin
          InStr.ReadBuffer(soubuf, act);
        end else
        begin
          InStr.ReadBuffer(destbuf, flag2);
          if (not Compresser.Decompress(pchar(@soubuf[0]), act, pchar(@destbuf[0]))) then
          begin
            raise exception.Create('解压缩错误!');
          end;

        end;
        OutStr.WriteBuffer(soubuf, act);

      end;

    finally
      Compresser.free;
    end;

  end;



procedure TCompress.CopyBits(memDest: PChar; nDestPos: integer;
  memSrc: PChar; nSrcPos, nBits: integer);
  function cquestion(a,b,c:integer):integer;
  begin
    if a>0 then result:=b else result:=c;

  end;
var
  iByteDest, iBitDest,iByteSrc, iBitSrc,nBitsToFill, nBitsCanFill:integer;
begin
  iByteDest := 0;
  iByteSrc:= 0;
  iBitSrc := nSrcPos;
  while (nBits > 0) do
  begin
          // 计算要在目标区当前字节填充的位数
    nBitsToFill := min(nBits, cquestion(iByteDest , 8 , 8 - nDestPos));
          // 目标区当前字节要填充的起始位
    iBitDest := cquestion(iByteDest , 0 , nDestPos);
          // 计算可以一次从源数据区中复制的位数
    nBitsCanFill := min(nBitsToFill, 8 - iBitSrc);
          // 字节内复制
    CopyBitsInAByte(pbyte(memDest + iByteDest), iBitDest,
                  pbyte(memSrc + iByteSrc), iBitSrc, nBitsCanFill);
          // 如果还没有复制完 nBitsToFill 个
    if (nBitsToFill > nBitsCanFill) then
    begin
      inc(iByteSrc);
      iBitSrc := 0;
      iBitDest := iBitDest+nBitsCanFill;
      CopyBitsInAByte(pbyte(memDest + iByteDest), iBitDest,
                                  pbyte(memSrc + iByteSrc), iBitSrc,
                                  nBitsToFill - nBitsCanFill);
      iBitSrc := iBitSrc+nBitsToFill - nBitsCanFill;

    end else
    begin
      iBitSrc := iBitSrc+nBitsCanFill;

      if (iBitSrc >= 8) then
      begin
        inc(iByteSrc); iBitSrc := 0;
      end;
    end;
    nBits :=nBits - nBitsToFill;	// 已经填充了nBitsToFill位
    inc(iByteDest);
  end;


end;

procedure TCompress.CopyBitsInAByte(memDest: PByte; nDestPos: integer;
  memSrc: PByte; nSrcPos, nBits: integer);
var
  b1, b2:byte;
begin
  b1 := memSrc^;
  b1 :=b1 shl nSrcPos;
  b1 :=b1 shr (8 - nBits);	// 将不用复制的位清0
  b1 :=b1 shl (8 - nBits - nDestPos);		// 将源和目的字节对齐
  memDest^ :=memDest^ or b1;		// 复制值为1的位

  b2 := $ff;
  b2 :=b2 shl (8 - nDestPos);		// 将不用复制的位置1
  b1 := b1 or b2;
  b2 := $ff;
  b2 :=b2 shr (nDestPos + nBits);
  b1:=b1 or b2;
  memDest^ :=memDest^ and b1;		// 复制值为0的位

end;


function TCompress.GetBit(Abyte: byte; pos: integer): byte;
var
  j:byte;
begin
  j := 1;
  j:=j shl (7 - pos);

  if (Abyte and j)>0 then
	result:=1
  else
	result:=0;

end;

type
  PUDWORD=^UDWORD;
  UDWORD=packed record
    case boolean of
    false:(b:array[0..3] of byte;);
    true:(dw:DWORD);
  end;

procedure TCompress.InvertDWord(pDW: PDWord);
var
  pudw:PUDWORD;
  b:byte;
begin
  pudw:=PUDWORD(pDW);
  b := pUDW^.b[0];	pUDW^.b[0] := pUDW^.b[3]; pUDW^.b[3] := b;
  b := pUDW^.b[1];	pUDW^.b[1] := pUDW^.b[2]; pUDW^.b[2] := b;