请问那位仁兄有关于压缩算法的Delphi中文资料?100分送上!!!!!!!!

[Putao]

要求:
1.压缩率高
2.速度中等
3.中文资料

[w102272]

在程序中包含这个LZW压缩单元，和压缩类
//------------------------------------------------------------------------------------------
//LZW压缩支持单元读写函数 编号:0300
//(LZRW1/KH 压缩逻辑，长于压缩RLE类编码，没有LZH好，但是可以和Lempel-Ziff比较，速度很快)
{$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);
type
HashTable = ARRAY [0..4095] OF Int16; //窗口越大越有效，默认是4K
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 INC(Size);
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 INC(Size);
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;

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
SaveY:=0;
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 Dest^[Y+K] := Source^[X+3];
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 }

//0300lzw压缩类，对上面的LZW压缩算法进行封装，如果你愿意，也可以做成VCL类
type
TLZWCompressStream = class(TObject)
private
FSignature: array[0..2] of Char; {= 'PMCS10' }
public
constructor Create; virtual;
procedure Compress(InStream, OutStream: TStream; InSize: LongInt);
procedure DeCompress(InStream, OutStream: TStream);
end;
constructor TLZWCompressStream.Create;
begin
FSignature := 'WLS'; //压缩流标志,随意指定，不重复就可以了
end;
procedure TLZWCompressStream.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 TLZWCompressStream.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('非LZW压缩串');
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;

-----------------------------------------------------------------------------
最后记得在单元开始的地方初始化HASH表，由于HASH表的空间不大，你可以不释放它，把它做成全局变量
如果是在别的程序里头调用，要记得释放HASH表占用的资源。


//0300压缩单元支持，初始化HASH表。
Hash := Nil;
try
Getmem(Hash,Sizeof(Hashtable));
except
Raise ELzrw1KHCompressor.Create('LZW压缩支持报告：无法为HASH表分配内存！');
end;

---------------------------------------------------------------------------------
至此，完成LZW压缩算法，最好不要直接调用COMPRESS函数，
使用压缩类可以对任意流进行压缩，比如文件流、内存流、等等，不限制你的程序能力



---------------------------------------------------------------------------------
---------------------------------------------------------------------------------
---------------------------------------------------------------------------------
由于我对数据的处理总是在字符串上进行的，所以写了下面两个函数，
利用压缩类对字符串进行操作，目的是为了简化调用，并不是必须使用的，你也可以完全不使用它们
或者封装自己的函数，比如压缩文件的函数。

//0300lzw压缩输出函数
function _LZWCompress(Instr:string):String; //压缩输入字符串返回被压缩字符串
var inStream: TStringStream;
var outStream:Tmemorystream;
var retstr:string;
var charArray:Array[0..0] of char; //must be a single char
begin
retstr:='';
inStream :=Tstringstream.Create(Instr);
OUTStream:=Tmemorystream.Create;
try
with TLZWCompressStream.Create do
try Compress(InStream, OutStream, inStream.Size);
finally Free;
end;
OutStream.Position:=0;
while OutStream.Position<outstream.Size do begin
outstream.ReadBuffer(chararray,sizeof(chararray));
retstr:=retstr+chararray[0];
end;
finally
InStream.Free;
OUtStream.Free;
end;
result:=retstr;
end;

function _LZWDECompress(Instr:string):String; //解压缩输入字符串返回解压缩字符串
var inStream: TStringStream;
var outStream:Tmemorystream;
var retstr:string;
var charArray:Array[0..0] of char; //must be a single char
begin
inStream :=Tstringstream.Create(Instr);
OUTStream:=Tmemorystream.Create;
try
with TLZWCompressStream.Create do
try DeCompress(INStream,OUTStream);
finally Free;
end;
OutStream.Position:=0;
while OutStream.Position<outstream.Size do begin
outstream.ReadBuffer(chararray,sizeof(chararray));
retstr:=retstr+chararray[0];
end;
finally
inStream.Free;
OutStream.Free;
end;
result:=retstr;
end;

[Putao]

有其它算法吗?压缩率要高一些的.

[Putao]

[gigi2000]

在你的邮箱里