我使用中发现压缩一切正常，但解压缩时释放建立的实例时即内存越界，不知何故？这是超级猛料中的LZW压缩单元：unit Lzw;interfaceuses
Windows, SysUtils, Classes;const
NOCODE = -1; // 空编码
LZWBITS = 8; // 字对处理位
LZWBUFFER = $FFFF; // 编码处理缓存容量（输入缓存容量。经实践，该值能达到较好的效率）
LZWMAXBITS = 12; // 最大的编码位（增加该值会增加编码表的内存空间）
LZWSTACKBUFFERSIZE = $FFFF; // 栈缓存容量（要保证它足够大）
LZWEXPORTBLOCKSIZE = $FFFF; // 输出缓存容量
LZWMAXCODES = 1 shl LZWMAXBITS; // 最大编码（4096）
LZWTABLESIZE = 1 shl (LZWBITS + LZWMAXBITS); // 编码表容量（2MB空间）type
TLZWEncode = class(TObject)
private
EncodeTable: array [0..LZWTABLESIZE - 1] of Word; // 编码表
EncodePointer: array [0..LZWMAXCODES - 1] of LongWord; // 经过编码的缓存
ExportBlock: Pointer; // 存放编码后的数据指针（输出缓存块指针）
ExportBlockPtr: array of Byte; // 该指针指向 ExportBlock ，用于访问数组
InitBits: Integer; // 压缩数据的起始位数
ClearCode: Integer; // 清除码
EofCode: Integer; // 结束码
PrefixCode: Integer; // 字头码
SuffixCode: Integer; // 字尾码
Encode: Integer; // 压缩编码
RunBits: Integer; // 当前处理位
MaxCodeSize: Integer; // 当前处理最大编码
FBegin: Boolean; // 开始处理标志
FExportSize: Integer; // 输出数据块大小
FExportIndex: Integer; // 输出数据块索引
FExportTotalSize: Integer; // 记录输出缓存块大小
ShiftBits: Integer; // 用于位处理，作临时位
ShiftCode: Integer; // 用于位处理，作临时代码
protected
procedure ExportData(AData: Integer); virtual; // 输出数据（虚方法）
public
function GetExportPointer: Pointer; // 返回输出指针
function GetExportSize: Integer; // 返回输出大小
procedure GetBegin; // 置开始编码标志
procedure GetEnd; // 置结束编码标志
procedure Execute(Data: array of Byte; DataSize: Integer); virtual; // 执行编码过程（虚方法）
constructor Create;
destructor Destroy; override;
end; TLZWUnencode = class(TObject)
private
InitBits: Integer; // 压缩数据的起始位数
ClearCode: Integer; // 清除码
EofCode: Integer; // 结束码
PrefixCode: Integer; // 字头码
SuffixCode: Integer; // 字尾码
Encode: Integer; // 压缩编码
RunBits: Integer; // 当前处理位
MaxCodeSize: Integer; // 当前处理最大编码
ExportBlock: Pointer; // 存放编码后的数据指针（输出缓存块指针）
ExportBlockPtr: array of Byte; // 该指针指向 ExportBlock ，用于访问数组
StackIndex: Integer; // 栈索引
StackTable: array [0..LZWSTACKBUFFERSIZE - 1] of Byte; // 栈表
PrefixTable: array [0..LZWMAXCODES - 1] of Word; // 字头表
SuffixTable: array [0..LZWMAXCODES - 1] of Byte; // 字尾表
FExportSize: Integer; // 输出数据块大小
FExportIndex: Integer; // 输出数据块索引
FExportTotalSize: Integer; // 记录输出缓存块大小
ShiftBits: Integer; // 用于位处理，作临时位
ShiftCode: Integer; // 用于位处理，作临时代码
protected
procedure ExportData(AData: Integer); virtual; // 输出数据（虚方法）
public
function GetExportPointer: Pointer; // 返回输出指针
function GetExportSize: Integer; // 返回输出大小
procedure GetBegin; // 开始解码（分配输出内存空间）
procedure GetEnd; // 结束解码（释放输出内存空间）
procedure Execute(Data: array of Byte; DataSize: Integer); virtual; // 执行解码过程（虚方法）
constructor Create;
destructor Destroy; override;
end;implementation{ TLZWEncode }constructor TLZWEncode.Create;
begin
InitBits := LZWBITS;
ClearCode := 1 shl InitBits;
EofCode := ClearCode + 1;
Encode := EofCode + 1;
RunBits := InitBits + 1;
MaxCodeSize := 1 shl RunBits;
FBegin := False;
FExportSize := 0;
FExportIndex := 0;
FExportTotalSize := 0;
ShiftBits := 0;
ShiftCode := 0;
end;destructor TLZWEncode.Destroy;
begin
FreeMem(ExportBlock);
inherited;
end;procedure TLZWEncode.Execute(Data: array of Byte; DataSize: Integer);
var
AIndex: Integer;
ArrayIndex: Integer;
Vi: Integer;
begin
AIndex := 0;
FExportIndex := 0;
FExportTotalSize := LZWEXPORTBLOCKSIZE;
{ 处理文件首字节，赋值给字头码 }
if FBegin then
begin
FBegin := False;
ExportData(ClearCode);
PrefixCode := Data[AIndex];
Inc(AIndex);
end;
{ 编码过程 }
while AIndex < DataSize do
begin
{ 取出数据，赋值给字尾码 }
SuffixCode := Data[AIndex];
Inc(AIndex);
{ 构造地址 }
ArrayIndex := (PrefixCode shl LZWBITS) + SuffixCode;
{ 无可编码字对的情况 }
if EncodeTable[ArrayIndex] = 0 then
begin
ExportData(PrefixCode); // 输出字头
{ 当前编码等于最大编码值的情况，作初始化工作 }
if Encode = LZWMAXCODES then
begin
ExportData(ClearCode); // 输出清除码
Encode := EofCode + 1;
RunBits := InitBits + 1;
MaxCodeSize := 1 shl RunBits;
{ 只需初始化编码过的内存区 }
for Vi := Encode to LZWMAXCODES - 1 do
EncodeTable[EncodePointer[Vi]] := 0;
end
else begin
{ 当前编码等于最大处理编码的情况 }
if Encode = MaxCodeSize then
begin
Inc(RunBits); // 当前处理位增加
MaxCodeSize := 1 shl RunBits; // 相应最大编码增加
end;
EncodeTable[ArrayIndex] := Encode; // 加入编码表
EncodePointer[Encode] := ArrayIndex;
Inc(Encode);
end;
PrefixCode := SuffixCode;
end
{ 编码可匹配的情况 }
else begin
PrefixCode := EncodeTable[ArrayIndex];
end;
end;
end;procedure TLZWEncode.ExportData(AData: Integer);
{ 输出过程 }
procedure ExportProcedure;
begin
while ShiftBits >= LZWBITS do
begin
ExportBlockPtr[FExportIndex] := ShiftCode and $00FF;
Inc(FExportIndex);
if FExportIndex = FExportTotalSize then
begin
{ 重新分配内存后首地址可能改变 }
ReallocMem(ExportBlock, FExportIndex + LZWEXPORTBLOCKSIZE);
Pointer(ExportBlockPtr) := ExportBlock;
Inc(FExportTotalSize, LZWEXPORTBLOCKSIZE);
end;
ShiftCode := ShiftCode shr LZWBITS;
Dec(ShiftBits, LZWBITS);
end;
end;
begin
{ 输出位总是大于 LZWBITS 的 }
ShiftCode := AData shl ShiftBits + ShiftCode;
Inc(ShiftBits, RunBits);
ExportProcedure;
end;function TLZWEncode.GetExportPointer: Pointer;
begin
Result := ExportBlock;
end;function TLZWEncode.GetExportSize: Integer;
begin
FExportSize := FExportIndex;
Result := FExportSize;
end;
Windows, SysUtils, Classes;const
NOCODE = -1; // 空编码
LZWBITS = 8; // 字对处理位
LZWBUFFER = $FFFF; // 编码处理缓存容量（输入缓存容量。经实践，该值能达到较好的效率）
LZWMAXBITS = 12; // 最大的编码位（增加该值会增加编码表的内存空间）
LZWSTACKBUFFERSIZE = $FFFF; // 栈缓存容量（要保证它足够大）
LZWEXPORTBLOCKSIZE = $FFFF; // 输出缓存容量
LZWMAXCODES = 1 shl LZWMAXBITS; // 最大编码（4096）
LZWTABLESIZE = 1 shl (LZWBITS + LZWMAXBITS); // 编码表容量（2MB空间）type
TLZWEncode = class(TObject)
private
EncodeTable: array [0..LZWTABLESIZE - 1] of Word; // 编码表
EncodePointer: array [0..LZWMAXCODES - 1] of LongWord; // 经过编码的缓存
ExportBlock: Pointer; // 存放编码后的数据指针（输出缓存块指针）
ExportBlockPtr: array of Byte; // 该指针指向 ExportBlock ，用于访问数组
InitBits: Integer; // 压缩数据的起始位数
ClearCode: Integer; // 清除码
EofCode: Integer; // 结束码
PrefixCode: Integer; // 字头码
SuffixCode: Integer; // 字尾码
Encode: Integer; // 压缩编码
RunBits: Integer; // 当前处理位
MaxCodeSize: Integer; // 当前处理最大编码
FBegin: Boolean; // 开始处理标志
FExportSize: Integer; // 输出数据块大小
FExportIndex: Integer; // 输出数据块索引
FExportTotalSize: Integer; // 记录输出缓存块大小
ShiftBits: Integer; // 用于位处理，作临时位
ShiftCode: Integer; // 用于位处理，作临时代码
protected
procedure ExportData(AData: Integer); virtual; // 输出数据（虚方法）
public
function GetExportPointer: Pointer; // 返回输出指针
function GetExportSize: Integer; // 返回输出大小
procedure GetBegin; // 置开始编码标志
procedure GetEnd; // 置结束编码标志
procedure Execute(Data: array of Byte; DataSize: Integer); virtual; // 执行编码过程（虚方法）
constructor Create;
destructor Destroy; override;
end; TLZWUnencode = class(TObject)
private
InitBits: Integer; // 压缩数据的起始位数
ClearCode: Integer; // 清除码
EofCode: Integer; // 结束码
PrefixCode: Integer; // 字头码
SuffixCode: Integer; // 字尾码
Encode: Integer; // 压缩编码
RunBits: Integer; // 当前处理位
MaxCodeSize: Integer; // 当前处理最大编码
ExportBlock: Pointer; // 存放编码后的数据指针（输出缓存块指针）
ExportBlockPtr: array of Byte; // 该指针指向 ExportBlock ，用于访问数组
StackIndex: Integer; // 栈索引
StackTable: array [0..LZWSTACKBUFFERSIZE - 1] of Byte; // 栈表
PrefixTable: array [0..LZWMAXCODES - 1] of Word; // 字头表
SuffixTable: array [0..LZWMAXCODES - 1] of Byte; // 字尾表
FExportSize: Integer; // 输出数据块大小
FExportIndex: Integer; // 输出数据块索引
FExportTotalSize: Integer; // 记录输出缓存块大小
ShiftBits: Integer; // 用于位处理，作临时位
ShiftCode: Integer; // 用于位处理，作临时代码
protected
procedure ExportData(AData: Integer); virtual; // 输出数据（虚方法）
public
function GetExportPointer: Pointer; // 返回输出指针
function GetExportSize: Integer; // 返回输出大小
procedure GetBegin; // 开始解码（分配输出内存空间）
procedure GetEnd; // 结束解码（释放输出内存空间）
procedure Execute(Data: array of Byte; DataSize: Integer); virtual; // 执行解码过程（虚方法）
constructor Create;
destructor Destroy; override;
end;implementation{ TLZWEncode }constructor TLZWEncode.Create;
begin
InitBits := LZWBITS;
ClearCode := 1 shl InitBits;
EofCode := ClearCode + 1;
Encode := EofCode + 1;
RunBits := InitBits + 1;
MaxCodeSize := 1 shl RunBits;
FBegin := False;
FExportSize := 0;
FExportIndex := 0;
FExportTotalSize := 0;
ShiftBits := 0;
ShiftCode := 0;
end;destructor TLZWEncode.Destroy;
begin
FreeMem(ExportBlock);
inherited;
end;procedure TLZWEncode.Execute(Data: array of Byte; DataSize: Integer);
var
AIndex: Integer;
ArrayIndex: Integer;
Vi: Integer;
begin
AIndex := 0;
FExportIndex := 0;
FExportTotalSize := LZWEXPORTBLOCKSIZE;
{ 处理文件首字节，赋值给字头码 }
if FBegin then
begin
FBegin := False;
ExportData(ClearCode);
PrefixCode := Data[AIndex];
Inc(AIndex);
end;
{ 编码过程 }
while AIndex < DataSize do
begin
{ 取出数据，赋值给字尾码 }
SuffixCode := Data[AIndex];
Inc(AIndex);
{ 构造地址 }
ArrayIndex := (PrefixCode shl LZWBITS) + SuffixCode;
{ 无可编码字对的情况 }
if EncodeTable[ArrayIndex] = 0 then
begin
ExportData(PrefixCode); // 输出字头
{ 当前编码等于最大编码值的情况，作初始化工作 }
if Encode = LZWMAXCODES then
begin
ExportData(ClearCode); // 输出清除码
Encode := EofCode + 1;
RunBits := InitBits + 1;
MaxCodeSize := 1 shl RunBits;
{ 只需初始化编码过的内存区 }
for Vi := Encode to LZWMAXCODES - 1 do
EncodeTable[EncodePointer[Vi]] := 0;
end
else begin
{ 当前编码等于最大处理编码的情况 }
if Encode = MaxCodeSize then
begin
Inc(RunBits); // 当前处理位增加
MaxCodeSize := 1 shl RunBits; // 相应最大编码增加
end;
EncodeTable[ArrayIndex] := Encode; // 加入编码表
EncodePointer[Encode] := ArrayIndex;
Inc(Encode);
end;
PrefixCode := SuffixCode;
end
{ 编码可匹配的情况 }
else begin
PrefixCode := EncodeTable[ArrayIndex];
end;
end;
end;procedure TLZWEncode.ExportData(AData: Integer);
{ 输出过程 }
procedure ExportProcedure;
begin
while ShiftBits >= LZWBITS do
begin
ExportBlockPtr[FExportIndex] := ShiftCode and $00FF;
Inc(FExportIndex);
if FExportIndex = FExportTotalSize then
begin
{ 重新分配内存后首地址可能改变 }
ReallocMem(ExportBlock, FExportIndex + LZWEXPORTBLOCKSIZE);
Pointer(ExportBlockPtr) := ExportBlock;
Inc(FExportTotalSize, LZWEXPORTBLOCKSIZE);
end;
ShiftCode := ShiftCode shr LZWBITS;
Dec(ShiftBits, LZWBITS);
end;
end;
begin
{ 输出位总是大于 LZWBITS 的 }
ShiftCode := AData shl ShiftBits + ShiftCode;
Inc(ShiftBits, RunBits);
ExportProcedure;
end;function TLZWEncode.GetExportPointer: Pointer;
begin
Result := ExportBlock;
end;function TLZWEncode.GetExportSize: Integer;
begin
FExportSize := FExportIndex;
Result := FExportSize;
end;
解决方案 »
- 请教如何用DELPHI做个监听程序判断机器是否打开某个网页呢?
- 如何从下向上平滑滚动一个文本文件,AAfont自动换行有bug.
- 求问这种组件（伸缩面板，抽屉面板，窗体拖放融合）？ 谢谢
- 这样的语句是不是导致CPU占用100%的原因
- 请教dll问题，已经完成并通过测试的mdi程序能否整个做成dll？
- 在win2k/xp/2003下面开发、编译的程序，为什么不能在win98下面运行？？？一点击，就出现一个错误，大概意思是：不是合法的win32应用程序
- 100分提问:如何将DELPHI源程序制作成.DLL文件!高手指点!在线等.................
- 批量打印问题，在线等
- delphi高手！请问如何取得表里的关键字段？？？？
- 关于计时问题
- 如何把当前WebBrowser1.Navigate(ExtractFilePath(paramstr(0))+'a.xml');
- 请问如何在fastreport中设置某个band的绝对位置？
procedure TLZWEncode.GetBegin;
begin
FBegin := True;
{ 有可能输出缓存大于输入缓存，如果发生，到时再重新分配内存 }
ExportBlock := AllocMem(LZWEXPORTBLOCKSIZE);
Pointer(ExportBlockPtr) := ExportBlock;
end;procedure TLZWEncode.GetEnd;
begin
ExportData(PrefixCode);
EXportData(EofCode);
{ 最后的处理是看看有没有没处理的位 }
while ShiftBits > 0 do
begin
ExportBlockPtr[FExportIndex] := ShiftCode and $00FF;
Inc(FExportIndex);
if FExportIndex = FExportTotalSize then
begin
ReallocMem(ExportBlock, FExportIndex + LZWEXPORTBLOCKSIZE);
Pointer(ExportBlockPtr) := ExportBlock;
Inc(FExportTotalSize, LZWEXPORTBLOCKSIZE);
end;
ShiftCode := ShiftCode shr LZWBITS;
Dec(ShiftBits, LZWBITS);
end;
end;{ TLZWUnencode }constructor TLZWUnencode.Create;
begin
InitBits := LZWBITS;
ClearCode := 1 shl InitBits;
EofCode := ClearCode + 1;
Encode := EofCode + 1;
RunBits := InitBits + 1;
MaxCodeSize := 1 shl RunBits;
ShiftBits := 0;
ShiftCode := 0;
FExportSize := 0;
FExportIndex := 0;
FExportTotalSize := 0;
end;destructor TLZWUnencode.Destroy;
begin
inherited;
end;procedure TLZWUnencode.Execute(Data: array of Byte; DataSize: Integer);
const
MaskCode: array [0..LZWMAXBITS] of Word = (
$0000, $0001, $0003, $0007,
$000F, $001F, $003F, $007F,
$00FF, $01FF, $03FF, $07FF,
$0FFF);
var
AIndex: Integer;
CurrentCode, ACode: Integer;
begin
AIndex := 0;
FExportIndex := 0;
FExportTotalSize := LZWSTACKBUFFERSIZE;
{ 解码过程 }
while AIndex < DataSize do
begin
{ 取出数据 }
while (ShiftBits < RunBits) and (AIndex < DataSize) do
begin
ShiftCode := Data[AIndex] shl ShiftBits + ShiftCode;
Inc(AIndex);
Inc(ShiftBits, LZWBITS);
end; if AIndex >= DataSize then
Exit;
CurrentCode := ShiftCode and MaskCode[RunBits];
ShiftCode := ShiftCode shr RunBits;
Dec(ShiftBits, RunBits);
{ 遇到结束码则退出 }
if CurrentCode = EofCode then
Exit;
{ 遇到清除码则初始化 }
if CurrentCode = ClearCode then
begin
RunBits := InitBits + 1;
Encode := EofCode + 1;
MaxCodeSize := 1 shl RunBits;
PrefixCode := NOCODE;
SuffixCode := NOCODE;
end
else
begin
ACode := CurrentCode;
StackIndex := 0;
{ 当前代码正好与当前编码值相等的情况 }
if ACode = Encode then
begin
StackTable[StackIndex] := SuffixCode;
Inc(StackIndex);
ACode := PrefixCode;
end;
{ 当前代码大于当前编码值的情况，递归取值 }
while ACode > EofCode do
begin
StackTable[StackIndex] := SuffixTable[ACode];
Inc(StackIndex);
ACode := PrefixTable[ACode];
end;
SuffixCode := ACode;
{ 输出数据 }
ExportData(ACode);
while StackIndex > 0 do
begin
Dec(StackIndex);
ExportData(StackTable[StackIndex]);
end;
{ 加入字典 }
if (Encode < LZWMAXCODES) and (PrefixCode <> NOCODE) then
begin
PrefixTable[Encode] := PrefixCode;
SuffixTable[Encode] := SuffixCode;
Inc(Encode);
if (Encode >= MaxCodeSize) and (RunBits < LZWMAXBITS) then
begin
MaxCodeSize := MaxCodeSize shl 1;
Inc(RunBits);
end;
end;
PrefixCode := CurrentCode;
end;
end;
end;procedure TLZWUnencode.ExportData(AData: Integer);
begin
ExportBlockPtr[FExportIndex] := AData;
Inc(FExportIndex);
if FExportIndex = FExportTotalSize then
begin
ReallocMem(ExportBlock, FExportIndex + LZWSTACKBUFFERSIZE);
Pointer(ExportBlockPtr) := ExportBlock;
Inc(FExportTotalSize, LZWSTACKBUFFERSIZE);
end;
end;procedure TLZWUnencode.GetBegin;
begin
ExportBlock := AllocMem(LZWSTACKBUFFERSIZE);
Pointer(ExportBlockPtr) := ExportBlock;
end;procedure TLZWUnencode.GetEnd;
begin
FreeMem(ExportBlock);
end;function TLZWUnencode.GetExportPointer: Pointer;
begin
Result := ExportBlock;
end;function TLZWUnencode.GetExportSize: Integer;
begin
FExportSize := FExportIndex;
Result := FExportSize;
end;end. =================================================================我的代码：
procedure TForm1.Button1Click(Sender: TObject); //压缩过程，正常
var
L: TLZWEncode;
Ms: TMemoryStream;
Buf: array of Byte;
Fs: TFileStream;
begin
Ms := TMemoryStream.Create;
Ms.LoadFromFile('C:\Codetest\Dictionary.txt');
SetLength(Buf, Ms.Size);
Ms.Read(Buf[0], Ms.Size);
L := TLZWEncode.Create;
L.GetBegin;
L.Execute(Buf, Ms.Size);
L.GetEnd;
Fs := TFileStream.Create('C:\Codetest\Dictionary.lzw', fmCreate);
Fs.Write(L.GetExportPointer^, L.GetExportSize);
FreeAndNil(Fs);
FreeAndNil(L);
FreeAndNil(Ms);
end;procedure TForm1.Button2Click(Sender: TObject); //解压缩过程
var
L: TLZWUnencode;
Ms: TMemoryStream;
Buf: array of Byte;
Fs: TFileStream;
begin
Ms := TMemoryStream.Create;
Ms.LoadFromFile('C:\Codetest\Dictionary.lzw');
SetLength(Buf, Ms.Size);
Ms.Read(Buf[0], Ms.Size);
L := TLZWUnencode.Create;
L.GetBegin;
L.Execute(Buf, Ms.Size);
Fs := TFileStream.Create('C:\Codetest\Dict.txt', fmCreate);
Fs.Write(L.GetExportPointer^, L.GetExportSize);
L.GetEnd;
FreeAndNil(Fs);
FreeAndNil(L); // 只要一释放，立即出错！
FreeAndNil(Ms);
end;我调试了几个小时也没有发现哪里出错，而这个等着要用，望列位高人救我于水深火热之中！感谢！！
begin
inherited;
end;
这个有什么意义呢？不要override这个试试，不好意思喔，我也不是很懂的
FreeAndNil(L); // 只要一释放，立即出错！
FreeAndNil(Ms);//把语句的调用次序改一改看看 ～～
比如：
FreeAndNil(Fs);
FreeAndNil(Ms);
FreeAndNil(L); // 只要一释放，立即出错！ 再比如：
FreeAndNil(L); // 只要一释放，立即出错！
FreeAndNil(Fs);
FreeAndNil(Ms);
不同的是我Delphi6～～
手里没有Delphi5帮你调试～～再测试下如下代码～～
FreeAndNil(Fs);
Application.ProcessMessages;
FreeAndNil(L); // 只要一释放，立即出错！
Application.ProcessMessages;
FreeAndNil(Ms);在不然就把L: TLZWUnencode声明成字段，只创建一次，减少内存泄漏～～
begin
FreeMem(ExportBlock);
inherited;
end;你試試修改為:
destructor TLZWEncode.Destroy;
begin
ZeroMemory(ExportBlock^, sizeOf(....);
FreeMem(ExportBlock);
inherited;
end;看有沒有用!
//不明白按照逻辑上写怎么会少些字节～～
//通过记录文件大小截取解决，请做测试～～procedure TForm1.Button1Click(Sender: TObject); //压缩过程，正常
var
L: TLZWEncode;
Ms: TMemoryStream;
Buf: array[0..LZWBUFFER - 1] of Byte;
Fs: TFileStream;
I, J: Integer;
begin
Fs := TFileStream.Create('C:\temp\TestApp.lzw', fmCreate);
Ms := TMemoryStream.Create;
Ms.LoadFromFile('C:\temp\TestApp.exe');
J := Ms.Size;
Fs.Write(J, SizeOf(I));
L := TLZWEncode.Create;
L.GetBegin;
for I := 1 to Ms.Size div LZWBUFFER + 1 do begin
FillChar(Buf, SizeOf(Buf), 0);
Ms.Read(Buf, LZWBUFFER);
L.Execute(Buf, LZWBUFFER);
Fs.Write(L.GetExportPointer^, L.GetExportSize);
end;
L.GetEnd; FreeAndNil(Fs);
FreeAndNil(L);
FreeAndNil(Ms);
end;procedure TForm1.Button2Click(Sender: TObject); //解压缩过程
var
L: TLZWUnencode;
Ms: TMemoryStream;
Buf: array[0..LZWBUFFER - 1] of Byte;
Fs: TFileStream;
I, J: Integer;
begin
Fs := TFileStream.Create('C:\temp\TestApp~.exe', fmCreate);
Ms := TMemoryStream.Create;
Ms.LoadFromFile('C:\temp\TestApp.lzw');
Ms.Read(J, SizeOf(J));
L := TLZWUnencode.Create;
L.GetBegin;
repeat
I := Ms.Read(Buf, LZWBUFFER);
L.Execute(Buf, I);
Dec(J, L.GetExportSize);
if J <= 0 then begin
Fs.Write(L.GetExportPointer^, L.GetExportSize + J);
Break;
end else Fs.Write(L.GetExportPointer^, L.GetExportSize);
until I = 0;
L.GetEnd;
FreeAndNil(Fs);
FreeAndNil(L);
FreeAndNil(Ms);
end;
标题:压缩和解压目录
说明:利用ZLib单元;不处理空目录
设计:Zswang
日期:2003-09-06
支持:[email protected]
//*)///////Begin Source
uses ZLib, FileCtrl;const cBufferSize = $4096;function FileCompression(mFileName: TFileName; mStream: TStream): Integer;
var
vFileStream: TFileStream;
vBuffer: array[0..cBufferSize]of Char;
vPosition: Integer;
I: Integer;
begin
Result := -1;
if not FileExists(mFileName) then Exit;
if not Assigned(mStream) then Exit;
vPosition := mStream.Position;
vFileStream := TFileStream.Create(mFileName, fmOpenRead or fmShareDenyNone);
with TCompressionStream.Create(clMax, mStream) do try
for I := 1 to vFileStream.Size div cBufferSize do begin
vFileStream.Read(vBuffer, cBufferSize);
Write(vBuffer, cBufferSize);
end;
I := vFileStream.Size mod cBufferSize;
if I > 0 then begin
vFileStream.Read(vBuffer, I);
Write(vBuffer, I);
end;
finally
Free;
vFileStream.Free;
end;
Result := mStream.Size - vPosition; //增量
end; { FileCompression }function FileDecompression(mFileName: TFileName; mStream: TStream): Integer;
var
vFileStream: TFileStream;
vBuffer: array[0..cBufferSize]of Char;
I: Integer;
begin
Result := -1;
if not Assigned(mStream) then Exit;
ForceDirectories(ExtractFilePath(mFileName)); //创建目录
vFileStream := TFileStream.Create(mFileName, fmCreate or fmShareDenyWrite); with TDecompressionStream.Create(mStream) do try
repeat
I := Read(vBuffer, cBufferSize);
vFileStream.Write(vBuffer, I);
until I = 0;
Result := vFileStream.Size;
finally
Free;
vFileStream.Free;
end;
end; { FileDecompression }function StrLeft(const mStr: string; mDelimiter: string): string;
begin
Result := Copy(mStr, 1, Pos(mDelimiter, mStr) - 1);
end; { StrLeft }function StrRight(const mStr: string; mDelimiter: string): string;
begin
if Pos(mDelimiter, mStr) > 0 then
Result := Copy(mStr, Pos(mDelimiter, mStr) + Length(mDelimiter), MaxInt)
else Result := '';
end; { StrRight }type
TFileHead = packed record
rIdent: string[3]; //标识
rVersion: Byte; //版本
end;const
cIdent: string[3] = 'zsf';
cVersion = $01;
cErrorIdent = -1;
cErrorVersion = -2;function DirectoryCompression(mDirectory, mFileName: TFileName): Integer;
var
vFileInfo: TStrings;
vFileInfoSize: Integer;
vFileInfoBuffer: PChar;
vFileHead: TFileHead; vMemoryStream: TMemoryStream;
vFileStream: TFileStream; procedure pAppendFile(mSubFile: TFileName);
begin
vFileInfo.Append(Format('%s|%d',
[StringReplace(mSubFile, mDirectory + '\', '', [rfReplaceAll, rfIgnoreCase]),
FileCompression(mSubFile, vMemoryStream)]));
Inc(Result);
end; { pAppendFile } procedure pSearchFile(mPath: TFileName);
var
vSearchRec: TSearchRec;
K: Integer;
begin
K := FindFirst(mPath + '\*.*', faAnyFile, vSearchRec);
while K = 0 do begin
if (vSearchRec.Attr and faDirectory > 0) and
(Pos(vSearchRec.Name, '..') = 0) then
pSearchFile(mPath + '\' + vSearchRec.Name)
else if Pos(vSearchRec.Name, '..') = 0 then
pAppendFile(mPath + '\' + vSearchRec.Name);
K := FindNext(vSearchRec);
end;
FindClose(vSearchRec);
end; { pSearchFile }
begin
Result := 0;
if not DirectoryExists(mDirectory) then Exit;
vFileInfo := TStringList.Create;
vMemoryStream := TMemoryStream.Create;
mDirectory := ExcludeTrailingPathDelimiter(mDirectory); vFileStream := TFileStream.Create(mFileName, fmCreate or fmShareDenyWrite);
try
pSearchFile(mDirectory);
vFileInfoBuffer := vFileInfo.GetText;
vFileInfoSize := StrLen(vFileInfoBuffer); { DONE -oZswang -c添加 : 写入头文件信息 }
vFileHead.rIdent := cIdent;
vFileHead.rVersion := cVersion;
vFileStream.Write(vFileHead, SizeOf(vFileHead)); vFileStream.Write(vFileInfoSize, SizeOf(vFileInfoSize));
vFileStream.Write(vFileInfoBuffer^, vFileInfoSize);
vMemoryStream.Position := 0;
vFileStream.CopyFrom(vMemoryStream, vMemoryStream.Size);
finally
vFileInfo.Free;
vMemoryStream.Free;
vFileStream.Free;
end;
end; { DirectoryCompression }function DirectoryDecompression(mDirectory, mFileName: TFileName): Integer;
var
vFileInfo: TStrings;
vFileInfoSize: Integer;
vFileHead: TFileHead; vMemoryStream: TMemoryStream;
vFileStream: TFileStream;
I: Integer;
begin
Result := 0;
if not FileExists(mFileName) then Exit;
vFileInfo := TStringList.Create;
vMemoryStream := TMemoryStream.Create;
mDirectory := ExcludeTrailingPathDelimiter(mDirectory);
vFileStream := TFileStream.Create(mFileName, fmOpenRead or fmShareDenyNone);
try
if vFileStream.Size < SizeOf(vFileHead) then Exit;
{ DONE -oZswang -c添加 : 读取头文件信息 }
vFileStream.Read(vFileHead, SizeOf(vFileHead));
if vFileHead.rIdent <> cIdent then Result := cErrorIdent;
if vFileHead.rVersion <> cVersion then Result := cErrorVersion;
if Result <> 0 then Exit; vFileStream.Read(vFileInfoSize, SizeOf(vFileInfoSize));
vMemoryStream.CopyFrom(vFileStream, vFileInfoSize);
vMemoryStream.Position := 0;
vFileInfo.LoadFromStream(vMemoryStream); for I := 0 to vFileInfo.Count - 1 do begin
vMemoryStream.Clear;
vMemoryStream.CopyFrom(vFileStream,
StrToIntDef(StrRight(vFileInfo[I], '|'), 0));
vMemoryStream.Position := 0;
FileDecompression(mDirectory + '\' + StrLeft(vFileInfo[I], '|'),
vMemoryStream);
end;
Result := vFileInfo.Count;
finally
vFileInfo.Free;
vMemoryStream.Free;
vFileStream.Free;
end;
end; { DirectoryDeompression }
///////End Source///////Begin Demo
procedure TForm1.ButtonCompressionClick(Sender: TObject);
begin
Caption := 'DirectoryCompression:' +
IntToStr(DirectoryCompression(EditDirectory.Text, EditFileName.Text));
end;procedure TForm1.ButtonDecompressionClick(Sender: TObject);
begin
Caption := 'DirectoryDecompression:' +
IntToStr(DirectoryDecompression(EditDirectory.Text, EditFileName.Text));
end;procedure TForm1.SpeedButtonFileNameClick(Sender: TObject);
begin
if not OpenDialog1.Execute then Exit;
EditFileName.Text := OpenDialog1.FileName;
end;procedure TForm1.SpeedButtonDirectoryClick(Sender: TObject);
var
vDirectory: string;
begin
vDirectory := EditDirectory.Text;
if not SelectDirectory('Select', '', vDirectory) then Exit;
EditDirectory.Text := vDirectory;
end;
///////End Demo
用这个保证没有问题的
我3年前写的UNIT LZRW;INTERFACEuses SysUtils;{$IFDEF WIN32}
type Int16 = SmallInt;
{$ELSE}
type Int16 = Integer;
{$ENDIF}CONST
BufferMaxSize = 32768;
BufferMax = BufferMaxSize-1;
FLAG_Copied = $80;
FLAG_Compress = $40;TYPE
BufferIndex = 0..BufferMax + 15;
BufferSize = 0..BufferMaxSize;
{ extra bytes needed here if compression fails *dh *}
BufferArray = ARRAY [BufferIndex] OF BYTE;
BufferPtr = ^BufferArray;
ELzrw1KHCompressor = Class(Exception);
FUNCTION Compression ( Source,Dest : BufferPtr;
SourceSize : BufferSize ) : BufferSize;FUNCTION Decompression ( Source,Dest : BufferPtr;
SourceSize : BufferSize ) : BufferSize;IMPLEMENTATIONtype
HashTable = ARRAY [0..4095] OF Int16;
HashTabPtr = ^Hashtable;VAR
Hash : HashTabPtr; { check if this string has already been seen }
{ in the current 4 KB window }
FUNCTION GetMatch ( Source : BufferPtr;
X : BufferIndex;
SourceSize : BufferSize;
Hash : HashTabPtr;
VAR Size : WORD;
VAR Pos : BufferIndex ) : BOOLEAN;
VAR
HashValue : WORD;
TmpHash : Int16;
BEGIN
HashValue := (40543*((((Source^[X] SHL 4) XOR Source^[X+1]) SHL 4) XOR
Source^[X+2]) SHR 4) AND $0FFF;
Result := FALSE;
TmpHash := Hash^[HashValue];
IF (TmpHash <> -1) and (X - TmpHash < 4096) THEN BEGIN
Pos := TmpHash;
Size := 0;
WHILE ((Size < 18) AND (Source^[X+Size] = Source^[Pos+Size])
AND (X+Size < SourceSize)) DO begin
INC(Size);
end;
Result := (Size >= 3)
END;
Hash^[HashValue] := X
END;
{ compress a buffer of max. 32 KB }
FUNCTION Compression(Source, Dest : BufferPtr;
SourceSize : BufferSize) :BufferSize;
VAR
Bit,Command,Size : WORD;
Key : Word;
X,Y,Z,Pos : BufferIndex;
BEGIN
FillChar(Hash^,SizeOf(Hashtable), $FF);
Dest^[0] := FLAG_Compress;
X := 0;
Y := 3;
Z := 1;
Bit := 0;
Command := 0;
WHILE (X < SourceSize) AND (Y <= SourceSize) DO BEGIN
IF (Bit > 15) THEN BEGIN
Dest^[Z] := HI(Command);
Dest^[Z+1] := LO(Command);
Z := Y;
Bit := 0;
INC(Y,2)
END;
Size := 1;
WHILE ((Source^[X] = Source^[X+Size]) AND (Size < $FFF)
AND (X+Size < SourceSize)) DO begin
INC(Size);
end;
IF (Size >= 16) THEN BEGIN
Dest^[Y] := 0;
Dest^[Y+1] := HI(Size-16);
Dest^[Y+2] := LO(Size-16);
Dest^[Y+3] := Source^[X];
INC(Y,4);
INC(X,Size);
Command := (Command SHL 1) + 1;
END
ELSE begin { not size >= 16 }
IF (GetMatch(Source,X,SourceSize,Hash,Size,Pos)) THEN BEGIN
Key := ((X-Pos) SHL 4) + (Size-3);
Dest^[Y] := HI(Key);
Dest^[Y+1] := LO(Key);
INC(Y,2);
INC(X,Size);
Command := (Command SHL 1) + 1
END
ELSE BEGIN
Dest^[Y] := Source^[X];
INC(Y);
INC(X);
Command := Command SHL 1
END;
end; { size <= 16 }
INC(Bit);
END; { while x < sourcesize ... }
Command := Command SHL (16-Bit);
Dest^[Z] := HI(Command);
Dest^[Z+1] := LO(Command);
IF (Y > SourceSize) THEN BEGIN
MOVE(Source^[0],Dest^[1],SourceSize);
Dest^[0] := FLAG_Copied;
Y := SUCC(SourceSize)
END;
Result := Y
END; { decompress a buffer of max 32 KB }
FUNCTION Decompression(Source,Dest : BufferPtr;
SourceSize : BufferSize) : BufferSize;
VAR
X,Y,Pos : BufferIndex;
Command,Size,K : WORD;
Bit : BYTE;
SaveY : BufferIndex; { * dh * unsafe for-loop variable Y }BEGIN
IF (Source^[0] = FLAG_Copied) THEN begin
FOR Y := 1 TO PRED(SourceSize) DO begin
Dest^[PRED(Y)] := Source^[Y];
SaveY := Y;
end;
Y := SaveY;
end
ELSE BEGIN
Y := 0;
X := 3;
Command := (Source^[1] SHL 8) + Source^[2];
Bit := 16;
WHILE (X < SourceSize) DO BEGIN
IF (Bit = 0) THEN BEGIN
Command := (Source^[X] SHL 8) + Source^[X+1];
Bit := 16;
INC(X,2)
END;
IF ((Command AND $8000) = 0) THEN BEGIN
Dest^[Y] := Source^[X];
INC(X);
INC(Y)
END
ELSE BEGIN { command and $8000 }
Pos := ((Source^[X] SHL 4)
+(Source^[X+1] SHR 4));
IF (Pos = 0) THEN BEGIN
Size := (Source^[X+1] SHL 8) + Source^[X+2] + 15;
FOR K := 0 TO Size DO begin
Dest^[Y+K] := Source^[X+3];
end;
INC(X,4);
INC(Y,Size+1)
END
ELSE BEGIN { pos = 0 }
Size := (Source^[X+1] AND $0F)+2;
FOR K := 0 TO Size DO
Dest^[Y+K] := Dest^[Y-Pos+K];
INC(X,2);
INC(Y,Size+1)
END; { pos = 0 }
END; { command and $8000 }
Command := Command SHL 1;
DEC(Bit)
END { while x < sourcesize }
END;
Result := Y
END; { decompression }{
Unit "Finalization" as Delphi 2.0 would have it
}var
ExitSave : Pointer;Procedure Cleanup; far;
begin
ExitProc := ExitSave;
if (Hash <> Nil) then
Freemem(Hash, Sizeof(HashTable));
end;
Initialization Hash := Nil;
try
Getmem(Hash,Sizeof(Hashtable));
except
Raise ELzrw1KHCompressor.Create('LZRW1KH : no memory for HASH table');
end;
ExitSave := ExitProc;
ExitProc := @Cleanup;
END.
uses
LZRW;{ TCompressStream }procedure TCompressStream.Compress(InStream, OutStream: TStream; InSize: LongInt);
var InBuffer, OutBuffer: BufferArray;
CompressedSize, BytesRead, FinalPos, SizePos, TotalSize: LongInt;
begin
TotalSize := 0;
OutStream.WriteBuffer(FSignature, SizeOf(FSignature));
SizePos := OutStream.Position;
OutStream.WriteBuffer(TotalSize, SizeOf(TotalSize));
while InSize > 0 do
begin
BytesRead := InStream.Read(InBuffer, SizeOf(InBuffer));
CompressedSize := Compression(@InBuffer, @OutBuffer, BytesRead);
OutStream.WriteBuffer(CompressedSize, SizeOf(CompressedSize));
OutStream.WriteBuffer(OutBuffer, CompressedSize);
TotalSize := TotalSize + CompressedSize + SizeOf(CompressedSize);
InSize := InSize - BytesRead;
end;
FinalPos := OutStream.Position;
OutStream.Position := SizePos;
OutStream.WriteBuffer(TotalSize, SizeOf(TotalSize));
OutStream.Position := FinalPos;
end;procedure TCompressStream.DeCompress(InStream, OutStream: TStream);
var InBuffer, OutBuffer: BufferArray;
CompressedSize, UnCompressedSize, InSize: LongInt;
Sig: array[0..SizeOf(FSignature)-1] of Char;
begin
InStream.ReadBuffer(Sig, SizeOf(FSignature));
if Sig <> FSignature then raise Exception.Create('Wrong file type');
InStream.ReadBuffer(InSize, SizeOf(InSize));
while InSize > 0 do
begin
InStream.ReadBuffer(CompressedSize, SizeOf(CompressedSize));
InStream.ReadBuffer(InBuffer, CompressedSize);
UnCompressedSize := DeCompression(@InBuffer, @OutBuffer, CompressedSize);
OutStream.WriteBuffer(OutBuffer, UnCompressedSize);
InSize := InSize - CompressedSize - SizeOf(CompressedSize);
end;
end;
unit zip;interfaceuses
Windows, Messages, SysUtils, Classes ;const maxt=2048;
bsize=4096;
isize=2048;
eof_code=256;
next_len=257;
start_len=258;
empty=259;type
Tzip = class(TComponent)
private
tabl:array[0..2049] of integer;
bbuf:array[0..bsize] of byte;
ibuf:array[0..isize] of integer;
tabl_count,bpos,ipos,blen:integer;
code_len:integer;
free_bits,full_bits:integer;
out_c:integer;
Foutstream:Tstream;
Finstream:tstream;
Fetime:integer;
Fpos:integer;
outstr:string;
firstchar:char;
FOnupdate: TNotifyEvent;
{ Private declarations }
procedure init;
procedure addtotable(str: integer);
procedure setfinstream(const Value: Tstream);
procedure setfoutstream(const Value: Tstream);
procedure open_unzip;
procedure open_zip;
procedure close_zip;
procedure close_unzip;
function getbyte: integer;
function indexof(str, ch: integer): integer;
procedure putcode(code: integer);
procedure put_str(ix: integer; first: boolean);
function read_code: integer; protected
public
procedure Zip;
procedure Unzip;
property instream:Tstream write setfinstream;
property outstream:Tstream write setfoutstream;
published
property Elapsed:integer read fetime;
property Onupdate:TNotifyEvent read fonupdate write fonupdate;
property Position:integer read fpos;
end;procedure Register;implementationprocedure Register;
begin
RegisterComponents( 'Custom', [Tzip]);
end;
procedure tzip.init;
var i:integer;
begin
code_len:=9;
tabl_count:=empty;
for i:=0 to 255 do tabl[i]:=$ffff00+i;
end;
procedure tzip.addtotable(str:integer);
begin
if tabl_count>=maxt then tabl_count:=empty
else
begin
tabl[tabl_count]:=str;
inc(tabl_count);
end;
end;
procedure tzip.open_zip;
begin
blen:=finstream.Read(bbuf,bsize);
bpos:=0;
ipos:=0;
out_c:=0;
free_bits:=32;
fpos:=0;
end;
procedure tzip.close_zip;
begin
if ipos>0 then foutstream.Write(ibuf,ipos*4);
end;
procedure tzip.close_unzip;
begin
if bpos>0 then foutstream.Write(bbuf,bpos);
end;
procedure tzip.open_unzip;
begin
full_bits:=0;
ipos:=0;
bpos:=0;
finstream.Read(ibuf,isize*4);
fpos:=0;
end;function tzip.getbyte:integer;
begin
if (bpos>=blen) then
begin
if blen<bsize then
begin
result:=eof_code;
exit;
end
else
begin
blen:=finstream.Read(bbuf,bsize);
bpos:=0;
fpos:=finstream.Position;
if assigned(fonupdate) then fonupdate(nil);
end;
end;
result:=bbuf[bpos];
inc(bpos);
end;function tzip.indexof(str,ch:integer):integer;
var cd,mn,mx:integer;
begin
cd:=(str shl 8) + ch;
mn:=str+1;if mn<empty then mn:=empty;
mx:=tabl_count-1;
for result:=mn to mx do if tabl[result]=cd then exit;
result:=-1;
end;
procedure tzip.putcode(code:integer);
var shift_bits,tc,tf:integer; procedure store_out_c;
begin
ibuf[ipos]:=out_c;
inc(ipos);
if ipos>=isize then
begin
foutstream.Write(ibuf,isize*4);
ipos:=0;
end;
out_c:=0;
free_bits:=32;
end;begin
shift_bits:=free_bits-code_len; if shift_bits<0 then
begin
tf:=free_bits;
shift_bits:=-shift_bits;
tc:=code shr shift_bits;
out_c:=out_c or tc;
store_out_c;
shift_bits:=32-shift_bits;
inc(free_bits,tf); //add alredy pushed bits
end; tc:=code shl shift_bits;
out_c:=out_c or tc;
dec(free_bits,code_len);
if (free_bits=0) or (code=eof_code) then store_out_c;
end;
procedure tzip.zip;
var str,ch,t:integer;
begin
init;
open_zip;
Fetime:=gettickcount;
str:=getbyte;
repeat
ch:=getbyte;
if ch=eof_code then break;
t:=indexof(str,ch);
if t<>-1 then str:=t else
begin
putcode(str);
if (tabl_count=512) or (tabl_count=1024) then
begin
putcode(next_len);
inc(code_len);
end;
if tabl_count=maxt then
begin
putcode(start_len);
code_len:=9;
end;
addtotable((str shl 8) +ch);
str:=ch;
end;
until false;
putcode(str);
putcode(eof_code);
fetime:=gettickcount-fetime;
close_zip;
end;
procedure tzip.put_str(ix:integer;first:boolean);
var i,l:integer;
begin
outstr:='';
repeat
i:=tabl[ix];
ix:=i shr 8;
outstr:=outstr+chr(i and $ff);
until ix=$ffff; l:=length(outstr); for i:=l downto 1 do
begin
bbuf[bpos]:=byte(outstr[i]);
inc(bpos);
if bpos>=bsize then
begin
foutstream.Write(bbuf,bsize);
bpos:=0;
end
end; firstchar:=outstr[l];
if first then
begin
bbuf[bpos]:=byte(firstchar);
inc(bpos);
if bpos>=bsize then
begin
foutstream.Write(bbuf,bsize);
bpos:=0;
end
end;
end;
function tzip.read_code:integer;
var mask,shift_bits,tf:integer;procedure get_out_c;
begin
out_c:=ibuf[ipos];
inc(ipos);
if ipos>=isize then
begin
finstream.Read(ibuf,isize*4);
ipos:=0;
fpos:=finstream.Position;
if assigned(fonupdate) then fonupdate(nil);
end;
full_bits:=32;
end;begin
if full_bits=0 then get_out_c; mask:=(1 shl code_len) -1; //0111111
result:=0; shift_bits:=full_bits-code_len; if shift_bits<0 then
begin
tf:=full_bits;
shift_bits:=-shift_bits;
result:=(out_c shl shift_bits) and mask;
get_out_c;
shift_bits:=32-shift_bits;
inc(full_bits,tf);
end;
result:=result or ((out_c shr shift_bits) and mask);
dec(full_bits,code_len);
end;procedure tzip.unzip;
var old,cod:integer;
begin
init;
open_unzip;
fetime:=gettickcount;
old:=read_code;
put_str(old,false);
while true do
begin
cod:=read_code;
if cod=eof_code then break;
if cod=next_len then begin inc(code_len);continue;end;
if cod=start_len then begin code_len:=9;continue;end;
if cod>=tabl_count then put_str(old,true) else put_str(cod,false);
addtotable(old shl 8 +byte(firstchar));
old:=cod;
end;
fetime:=gettickcount-fetime;
close_unzip;
end;procedure Tzip.setfinstream(const Value: Tstream);
begin
finstream := Value;
end;procedure Tzip.setfoutstream(const Value: Tstream);
begin
foutstream := Value;
end;
end.
http://expert.csdn.net/Expert/topic/2593/2593971.xml?temp=.7814752ly_liuyang(Liu Yang) 老大:
http://expert.csdn.net/Expert/topic/2593/2593979.xml?temp=.2123377
整条信息的熵也即表示整条信息所需的位数为：E = ∑En举个例子，对下面这条只出现了 a b c 三个字符的字符串：aabbaccbaa字符串长度为 10，字符 a b c 分别出现了 5 3 2 次，则 a b c 在信息中出现的概率分别为 0.5 0.3 0.2，他们的熵分别为：Ea = -log2(0.5) = 1
Eb = -log2(0.3) = 1.737
Ec = -log2(0.2) = 2.322
整条信息的熵也即表达整个字符串需要的位数为：E = Ea * 5 + Eb * 3 + Ec * 2 = 14.855 位
回想一下如果用计算机中常用的 ASCII 编码，表示上面的字符串我们需要整整 80 位呢！现在知道信息为什么能被压缩而不丢失原有的信息内容了吧。简单地讲，用较少的位数表示较频繁出现的符号，这就是数据压缩的基本准则。细心的读者马上会想到，我们该怎样用 0 1 这样的二进制数码表示零点几个二进制位呢？确实很困难，但不是没有办法。一旦我们找到了准确表示零点几个二进制位的方法，我们就有权利向无损压缩的极限挑战了。不要着急，看到第四章就明白了。模型从上面的描述，我们明白，要压缩一条信息，首先要分析清楚信息中每个符号出现的概率。不同的压缩程序通过不同的方法确定符号的出现概率，对符号的概率计算得越准确，也就越容易得到好的压缩效果。在压缩程序中，用来处理输入信息，计算符号的概率并决定输出哪个或哪些代码的模块叫做模型。难道对信息中字符的出现概率这么难以估计以至于有各种不同的压缩模型吗？对上面的字符串我们不是很容易就知道每个字符的概率了吗？是的是的，不过上面的字符串仅有 10 个字符长呀，那只是例子而已。考虑我们现实中要压缩的文件，大多数可是有几十 K 甚至几百 K 长，几 M 字节的文件不是也屡见不鲜吗？是的，我们可以预先扫描文件中的所有字符，统计出每个字符出现的概率，这种方法在压缩术语里叫做“静态统计模型”。但是，不同的文件中，字符有不同的分布概率，我们要么先花上大量的时间统计我们要压缩的所有文件中的字符概率，要么为每一个单独的文件保存一份概率表以备解压缩时需要。糟糕的是，不但扫描文件要消耗大量时间，而且保存一份概率表也使压缩后的文件增大了不少。所以，在实际应用中，“静态统计模型”应用的很少。真正的压缩程序中使用的大多是一种叫“自适应模型”的东西。自适应模型可以说是一台具有学习功能的自动机。他在信息被输入之前对信息内容一无所知并假定每个字符的出现概率均等，随着字符不断被输入和编码，他统计并纪录已经出现过的字符的概率并将这些概率应用于对后续字符的编码。也就是说，自适应模型在压缩开始时压缩效果并不理想，但随着压缩的进行，他会越来越接近字符概率的准确值，并达到理想的压缩效果。自适应模型还可以适应输入信息中字符分布的突然变化，可以适应不同的文件中的字符分布而不需要保存概率表。上面提到的模型可以统称为“统计模型”，因为他们都是基于对每个字符出现次数的统计得到字符概率的。另一大类模型叫做“字典模型”。实际上，当我们在生活中提到“工行”这个词的时候，我们都知道其意思是指“中国工商银行”，类似的例子还有不少，但共同的前提是我们心中都有一本约定俗成的缩写字典。字典模型也是如此，他并不直接计算字符出现的概率，而是使用一本字典，随着输入信息的读入，模型找出输入信息在字典中匹配的最长的字符串，然后输出该字符串在字典中的索引信息。匹配越长，压缩效果越好。事实上，字典模型本质上仍然是基于对字符概率的计算的，只不过，字典模型使用整个字符串的匹配代替了对某一字符重复次数的统计。可以证明，字典模型得到的压缩效果仍然无法突破熵的极限。当然，对通用的压缩程序来说，保存一本大字典所需的空间仍然是无法让人忍受的，况且，任何一本预先定义的字典都无法适应不同文件中数据的变化情况。对了，字典模型也有相应的“自适应”方案。我们可以随着信息的不断输入，从已经输入的信息中建立合适的字典，并不断更新这本字典，以适应数据的不断变化。让我们从另一个角度理解一下自适应模型。Cluade Shannon 曾试图通过一个“聚会游戏”(party game)来测定英语的真实信息容量。他每次向听众公布一条被他隐藏起一个字符的消息，让听众来猜下一个字符是什么，一次猜一个，直到猜对为止。然后，Shannon 使用猜测次数来确定整个信息的熵。在这个实验中，一种根据前面出现过的字符估计下一个字符概率的模型就存在于听众的头脑中，比计算机中使用的自适应模型更为高级的是，听众除了根据字符出现过的次数外，还可以根据他们对语言的经验进行猜测。编码通过模型，我们已经确定了对某一个符号该用多少位二进制数进行编码。现在的问题是，如何设计一种编码方案，使其尽量精确地用模型计算出来的位数表示某个符号。最先被考虑的问题是，如果对 a 用 3 个二进制位就可以表示，而对 b 用 4 个二进制位就可以表示，那么，在解码时，面对一连串的二进制流，我怎么知道哪三个位是 a，哪四个位是 b 呢？所以，必须设计出一种编码方式，使得解码程序可以方便地分离每个字符的编码部分。于是有了一种叫“前缀编码”的技术。该技术的主导思想是，任何一个字符的编码，都不是另一个字符编码的前缀。反过来说就是，任何一个字符的编码，都不是由另一个字符的编码加上若干位 0 或 1 组成。看一下前缀编码的一个最简单的例子：
符号 编码
A 0
B 10
C 110
D 1110
E 11110有了上面的码表，你一定可以轻松地从下面这串二进制流中分辨出真正的信息内容了：1110010101110110111100010 - DABBDCEAAB
下一个问题是：象上面这样的前缀编码只能表示整数位的符号，对几点几位的符号只能用近似的整数位输出，那么怎样输出小数位数呢？科学家们用算术编码解决了这个问题，我们将在第四章对算术编码作详细的讨论。总结一下不同的模型使用不同的方法计算字符的出现概率，由此概率可以得出字符的熵；然后使用不同的编码方法，尽量接近我们期望得到的熵值。所以，压缩效果的好坏一方面取决于模型能否准确地得到字符概率，另一方面也取决于编码方法能否准确地用期望的位数输出字符代码。换句话说，压缩 = 模型 + 编码。如下图所示：
--------- 符号 ---------- 概率 ---------- 代码 ----------
| 输入 |-------->| 模型 |-------->| 编码 |-------->| 输出 |
--------- ---------- ---------- ----------
资源我们已经知道，编写压缩程序往往不能对数据的整个字节进行处理，而是要按照二进制位来读写和处理数据，操作二进制位的函数也就成为了压缩程序中使用最为普遍的工具函数。我们在此提供两组函数集，使用它们可以有效的进行文件或内存中的二进制位操作。它们共有六个文件：bitio.h - 用于文件中二进制位操作的函数说明。bitio.cpp - 用于文件中二进制位操作的函数实现。errhand.h 和 errhand.cpp - bitio.cpp 中使用的错误处理函数。wm_bitio.h - 用于内存中二进制位操作的函数说明。wm_bitio.cpp - 用于内存中二进制位操作的函数实现。它们被共同包装在文件 bitio.zip 中。
0 | 1
+------+------+
0 | 1 0 | 1
+-----+-----+ +---+----+
| | | |
a | d e
0 | 1
+-----+-----+
| |
b c
要编码的字符总是出现在树叶上，假定从根向树叶行走的过程中，左转为0，右转为1，则一个字符的编码就是从根走到该字符所在树叶的路径。正因为字符只能出现在树叶上，任何一个字符的路径都不会是另一字符路径的前缀路径，符合要求的前缀编码也就构造成功了：a - 00 b - 010 c - 011 d - 10 e - 11
Shannon-Fano 编码进入 Huffman 先生构造的神奇二叉树之前，我们先来看一下它的前身，由 Claude Shannon 和 R.M.Fano 两人提出的 Shannon-Fano 编码。讨论之前，我们假定要编码字符的出现概率已经由某一模型统计出来，例如，对下面这串出现了五种字符的信息( 40 个字符长 ):cabcedeacacdeddaaabaababaaabbacdebaceada
五种字符的出现次数分别：a - 16，b - 7，c - 6，d - 6，e - 5。Shannon-Fano 编码的核心仍然是构造二叉树，构造的方式非常简单：1) 将给定符号按照其频率从大到小排序。对上面的例子，应该得到： a - 16
b - 7
c - 6
d - 6
e - 5
2) 将序列分成上下两部分，使得上部频率总和尽可能接近下部频率总和。我们有： a - 16
b - 7
-----------------
c - 6
d - 6
e - 5
3) 我们把第二步中划分出的上部作为二叉树的左子树，记 0，下部作为二叉树的右子树，记 1。4) 分别对左右子树重复 2 3 两步，直到所有的符号都成为二叉树的树叶为止。现在我们有如下的二叉树： 根(root)
0 | 1
+------+------+
0 | 1 0 | 1
+-----+-----+ +---+----+
| | | |
a b c |
0 | 1
+-----+-----+
| |
d e
于是我们得到了此信息的编码表：a - 00 b - 01 c - 10 d - 110 e - 111
可以将例子中的信息编码为：cabcedeacacdeddaaabaababaaabbacdebaceada
10 00 01 10 111 110 111 00 10 00 10 ......
码长共 91 位。考虑用 ASCII 码表示上述信息需要 8 * 40 = 240 位，我们确实实现了数据压缩。Huffman 编码Huffman 编码构造二叉树的方法和 Shannon-Fano 正好相反，不是自上而下，而是从树叶到树根生成二叉树。现在，我们仍然使用上面的例子来学习 Huffman 编码方法。1) 将各个符号及其出现频率分别作为不同的小二叉树（目前每棵树只有根节点）。 a(16) b(7) c(6) d(6) e(5)
2) 在 1 中得到的树林里找出频率值最小的两棵树，将他们分别作为左、右子树连成一棵大一些的二叉树，该二叉树的频率值为两棵子树频率值之和。对上面的例子，我们得到一个新的树林： | (11)
a(16) b(7) c(6) +---+---+
| |
d e
3) 对上面得到的树林重复 2 的做法，直到所有符号都连入树中为止。这一步完成后，我们有这样的二叉树： 根(root)
0 | 1
+------+----------------+
| 0 | 1
| +---------+-----------+
| 0 | 1 0 | 1
a +-------+------+ +-------+-------+
| | | |
b c d e
由此，我们可以建立和 Shannon-Fano 编码略微不同的编码表： a - 0 b - 100 c - 101 d - 110 e - 111
对例子中信息的编码为：
cabcedeacacdeddaaabaababaaabbacdebaceada
101 0 100 101 111 110 111 0 101 0 101 ......
码长共 88 位。这比使用 Shannon-Fano 编码要更短一点。让我们回顾一下熵的知识，使用我们在第二章学到的计算方法，上面的例子中，每个字符的熵为：Ea = - log2(16 / 40) = 1.322
Eb = - log2( 7 / 40) = 2.515
Ec = - log2( 6 / 40) = 2.737
Ed = - log2( 6 / 40) = 2.737
Ee = - log2( 5 / 40) = 3.000
信息的熵为：E = Ea * 16 + Eb * 7 + Ec * 6 + Ed * 6 + Ee * 5 = 86.601
也就是说，表示该条信息最少需要 86.601 位。我们看到，Shannon-Fano 编码和 Huffman 编码都已经比较接近该信息的熵值了。同时，我们也看出，无论是 Shannon-Fano 还是 Huffman，都只能用近似的整数位来表示单个符号，而不是理想的小数位。我们可以将它们做一个对比： 符号 理想位数 S-F 编码 Huffman 编码
( 熵 ) 需要位数 需要位数
----------------------------------------------------
a 1.322 2 1
b 2.515 2 3
c 2.737 2 3
d 2.737 3 3
e 3.000 3 3
----------------------------------------------------
总 计 86。601 91 88
这就是象 Huffman 这样的整数位编码方式无法达到最理想的压缩效果的原因。为 Huffman 编码选择模型（附范式 Huffman 编码）最简单，最容易被 Huffman 编码利用的模型是“静态统计模型”，也就是说在编码前统计要编码的信息中所有字符的出现频率，让后根据统计出的信息建立编码树，进行编码。这种模型的缺点是显而易见的：首先，对数据量较大的信息，静态统计要消耗大量的时间；其次，必须保存统计出的结果以便解码时构造相同的编码树，或者直接保存编码树本身，而且，对于每次静态统计，都有不同的结果，必须分别予以保存，这要消耗大量的空间（这意味着压缩效率的下降）；再次，事实上，即使不将编码树计算在内，对通常含有 0 - 255 字符集的计算机文件来说，静态统计模型统计出的频率是字符在整个文件中的出现频率，往往反映不出字符在文件中不同局部出现频率的变化情况，使用这一频率进行压缩，大多数情况下得不到太好压缩效果，文件有时甚至在压缩后反而增大了。所以，“静态统计模型”一般仅作为复杂算法的某一部分出现，在信息的某一局部完成压缩功能。我们很难将其用于独立的压缩系统。有一种有效的“静态统计模型”的替代方案，如果我们要压缩的所有信息具有某些共同的特性，也即在分布上存在着共同的特征，比如我们要压缩的是普通的英文文本，那么，字母 a 或者字母 e 的出现频率应当是大致稳定的。使用语言学家事先已经建立好的字母频率表来进行压缩和解压缩，不但不用保存多份统计信息，而且一般说来对该类文件有着较好的压缩效果。这种方案除了适应性不太强以外，偶尔还会有一些尴尬的时候。读一遍下面这段话：If Youth，throughout all history， had had a champion to stand up for it； to show a doubting world that a child can think；and， possibly， do it practically； you wouldn't constantly run across folks today who claim that "a child don't know anything." - Gadsby by E.V.Wright, 1939.发现什么问题了吗？哦，整段话中竟没有出现一次英文中出现频率最高的字母 e ！真让人惊讶，但没有办法，事先拟定的频率分布总有意外的时候。对英文或中文文本，有一种比较实用的静态模型：不是把字符而是把英文单词或中文词语作为统计频率和编码的单位进行压缩。也就是说，每次编码的不再是 a b c 这样的单个符号，而是 the look flower 这样的单词。这种压缩方式可以达到相当不错的压缩效果，并被广泛地用于全文检索系统。对基于词的编码方式，需要解决几个技术难点。首先是分词的问题，英文单词可以由词间空格分隔，但中文怎么办呢？其实，有很多中文分词算法可以解决这个问题，本书就不再详细介绍了。王笨笨就曾开发过一个不错的分词模块，但希望通过收取一定报酬的方式提供该模块，如有需要，请和王笨笨 E-Mail 联系。一旦我们将词语分离出来，我们就可以对每个词进行频率统计，然后建立 Huffman 编码树，输出编码时，一个编码将代替一个词语。但要注意，英文和汉语的单词数量都在几万到十几万左右，也就是说，我们的 Huffman 编码树将拥有十几万个叶子节点，这对于一棵树来说太大太大了，系统将无力承担所需要的资源，这怎么办呢？我们可以暂时抛开树结构，采用另一种构造 Huffman 编码的方式——范式 Huffman 编码。范式 Huffman 编码(Canonical Huffman Code)的基本思路是：并非只有使用二叉树建立的前缀编码才是 Huffman 编码，只要符合(1)是前缀编码(2)某一字符编码长度和使用二叉树建立的该字符的编码长度相同这两个条件的编码都可以叫做 Huffman 编码。考虑对下面六个单词的编码： 符号 出现次数 传统 Huffman 编码 范式 Huffman 编码
------------------------------------------------------------
单词1 10 000 000
单词2 11 001 001
单词3 12 100 010
单词4 13 101 011
单词5 22 01 10
单词6 23 11 11
注意到范式 Huffman 编码的独特之处了吗？你无法使用二叉树来建立这组编码，但这组编码确实能起到和 Huffman 编码相同的作用。而且，范式 Huffman 编码具有一个明显的特点：当我们把要编码的符号按照其频率从小到大排列时，如果把范式 Huffman 编码本身作为单词的话，也呈现出从小到大的字典顺序。构造范式 Huffman 编码的方法大致是：1) 统计每个要编码符号的频率。2) 根据这些频率信息求出该符号在传统 Huffman 编码树中的深度（也就是表示该符号所需要的位数 - 编码长度）。因为我们关心的仅仅是该符号在树中的深度，我们完全没有必要构造二叉树，仅用一个数组就可以模拟二叉树的创建过程并得到符号的深度，具体方法这里就不详述了。3) 分别统计从最大编码长度 maxlength 到 1 的每个长度对应了多少个符号。根据这一信息从 maxlength 个 0 开始以递增顺序为每个符号分配编码。例如，编码长度为 5 的符号有 4 个，长度为 3 的有 1 个，长度为 2 的有 3 个，则分配的编码依次为： 00000 00001 00010 00011 001 01 10 114) 编码输出压缩信息，并保存按照频率顺序排列的符号表，然后保存每组同样长度编码中的最前一个编码以及该组中的编码个数。现在完全可以不依赖任何树结构进行高速解压缩了。而且在整个压缩、解压缩过程中需要的空间比传统 Huffman 编码少得多。最后要提到的是，Huffman 编码可以采用自适应模型，根据已经编码的符号频率决定下一个符号的编码。这时，我们无需为解压缩预先保存任何信息，整个编码是在压缩和解压缩过程中动态创建的，而且自适应编码由于其符号频率是根据信息内容的变化动态得到的，更符合符号的局部分布规律，因此在压缩效果上比静态模型好许多。但是，采用自适应模型必须考虑编码表的动态特性，即编码表必须可以随时更新以适应符号频率的变化。对于 Huffman 编码来说，我们很难建立能够随时更新的二叉树，使用范式 Huffman 编码是个不错的选择，但依然存在不少技术上的难题。幸好，如果愿意的话，我们可以暂时不考虑自适应模型的 Huffman 编码，因为对于自适应模型我们还有许多更好的选择，下面几章将要谈到的算术编码、字典编码等更为适合采用自适应模型，我们将在其中深入探讨自适应模型的各种实现方法。
|
Pc = 1/3 |
|
+-- 0.6667
|
Pb = 1/3 |
|
+-- 0.3333
|
Pa = 1/3 |
|
+-- 0.0000
现在我们拿到第一个字符 b，让我们把目光投向 b 对应的区间 0.3333 - 0.6667。这时由于多了字符 b，三个字符的概率分布变成：Pa = 1/4，Pb = 2/4，Pc = 1/4。好，让我们按照新的概率分布比例划分 0.3333 - 0.6667 这一区间，划分的结果可以用图形表示为： +-- 0.6667
Pc = 1/4 |
+-- 0.5834
|
|
Pb = 2/4 |
|
|
+-- 0.4167
Pa = 1/4 |
+-- 0.3333
接着我们拿到字符 c，我们现在要关注上一步中得到的 c 的区间 0.5834 - 0.6667。新添了 c 以后，三个字符的概率分布变成 Pa = 1/5，Pb = 2/5，Pc = 2/5。我们用这个概率分布划分区间 0.5834 - 0.6667： +-- 0.6667
|
Pc = 2/5 |
|
+-- 0.6334
|
Pb = 2/5 |
|
+-- 0.6001
Pa = 1/5 |
+-- 0.5834
现在输入下一个字符 c，三个字符的概率分布为：Pa = 1/6，Pb = 2/6，Pc = 3/6。我们来划分 c 的区间 0.6334 - 0.6667：