📄 compresslzw.pas
字号:
procedure TCustomCompressor.FlushOutBuffer;
begin
SetData( FOutBuffer, FOutPtr );
FOutPtr := 0;
end;
procedure TCustomCompressor.ResetInBuffer;
begin
FInCnt := 0;
FInPtr := 0;
end;
procedure TCustomCompressor.ResetOutBuffer;
begin
FOutPtr := 0;
end;
{ LZW Compressor }
const
LZW_NO_PREV = $7FFF;
LZW_END_LIST = -1;
LZW_EMPTY = -3;
constructor TLZWCompressor.Create;
begin
inherited Create;
FTblSize := LZW_DEF_TABLE;
FTblLim := FTblSize - 1;
end;
destructor TLZWCompressor.Destroy;
begin
if assigned( FStrTbl ) then FreeMem( FStrTbl );
inherited Destroy;
end;
function TLZWCompressor.GetHashCode(
PrevC, FollC : Integer) : integer;
assembler;
asm
push esi
push edi
mov esi, edx
shl esi, 5
xor esi, ecx
mov ecx, [ eax ].TLZWCompressor.FTblLim
mov eax, [ eax ].TLZWCompressor.FStrTbl
and esi, ecx
mov edi, esi
shl edi, 4
cmp [ eax + edi ].TLZWTableEntry.Used, 0
je @@1
@@3:
cmp [ eax + edi ].TLZWTableEntry.Next, LZW_END_LIST
je @@2
mov edi, [ eax + edi ].TLZWTableEntry.Next
shl edi, 4
jmp @@3
@@2:
shr edi, 4
mov esi, edi
add edi, 101
and edi, ecx
@@5:
mov edx, edi
shl edx, 4
cmp [ eax + edx ].TLZWTableEntry.Used, 0
je @@4
inc edi
and edi, ecx
jmp @@5
@@4:
xchg esi, edi
shl edi, 4
mov [ eax + edi ].TLZWTableEntry.Next, esi
@@1:
mov eax, esi
pop edi
pop esi
end;
procedure TLZWCompressor.DoCompress;
var PrevCode :Integer;
procedure PutCode( H : Integer );
begin
If ( PrevCode = LZW_EMPTY )
then begin
PutChar( ( H SHR 4 ) AND $FF );
PrevCode := H AND $0F;
end
else begin
PutChar((( PrevCode SHL 4 ) AND $FF0) + (( H SHR 8) AND $00F));
PutChar( H AND $FF );
PrevCode := LZW_EMPTY;
end;
end;
Var C, I, W : Integer;
begin
LZWReset;
PrevCode := LZW_EMPTY;
W := Lookup( LZW_NO_PREV, GetChar );
C := GetChar;
while ( C <> EOF_CHAR ) do
begin
I := Lookup( W, C );
If ( I = LZW_END_LIST ) then
begin
MakeTableEntry( W, C );
PutCode( W );
W := Lookup( LZW_NO_PREV, C );
end
else W := I;
C := GetChar;
end;
PutCode( W );
FlushOutBuffer;
FlushOutBuffer;
end;
procedure TLZWCompressor.MakeTableEntry( PrevC, FollC :Integer );
assembler;
asm
push esi
mov esi, [ eax ].TLZWCompressor.FTblUsed
cmp esi, [ eax ].TLZWCompressor.FTblLim
jge @@1
inc [ eax ].TLZWCompressor.FTblUsed
push edx
push ecx
push eax
call TLZWCompressor.GetHashCode
shl eax, 4
pop esi
add eax, [ esi ].TLZWCompressor.FStrTbl
mov [ eax ].TLZWTableEntry.Used, 1
mov [ eax ].TLZWTableEntry.Next, LZW_END_LIST
nop
pop [ eax ].TLZWTableEntry.FollChar
pop [ eax ].TLZWTableEntry.PrevChar
@@1:
pop esi
end;
procedure TLZWCompressor.LZWReset;
Var I : Integer;
begin
if FStrTbl = Nil then GetMem( FStrTbl, FTblSize * SizeOf( TLZWTableEntry ) );
ResetInBuffer;
ResetOutBuffer;
FTblUsed := 0;
For I := 0 to FTblLim Do
With FStrTbl^[I] Do
Begin
PrevChar := LZW_NO_PREV;
FollChar := LZW_NO_PREV;
Next := -1;
Used := False;
End;
For I := 0 to 255 Do MakeTableEntry(LZW_NO_PREV, I);
end;
function TLZWCompressor.Lookup(PrevC, FollC: Integer) : Integer;
assembler;
asm
push ebx
push esi
mov esi, edx
shl edx, 5
xor edx, ecx
and edx, [ eax ].TLZWCompressor.FTblLim
mov ebx, [ eax ].TLZWCompressor.FStrTbl
mov eax, LZW_END_LIST
@@2:
shl edx, 4
cmp [ edx + ebx ].TLZWTableEntry.PrevChar, esi
jne @@1
cmp [ edx + ebx ].TLZWTableEntry.FollChar, ecx
je @@3
@@1:
mov edx, [ edx + ebx ].TLZWTableEntry.Next
cmp edx, eax
jne @@2
jmp @@4
@@3:
shr edx, 4
mov eax, edx
@@4:
pop esi
pop ebx
end;
procedure TLZWCompressor.DoDecompress;
Var PrevCode :Integer;
function GetCode : Integer;
assembler;
asm
push esi
mov eax, self
mov esi, eax
call TCustomCompressor.GetChar
cmp eax, EOF_CHAR
je @@x
cmp PrevCode, LZW_EMPTY
jne @@1
mov edx, eax
mov eax, esi
push edx
call TCustomCompressor.GetChar
pop edx
cmp eax, EOF_CHAR
je @@x
and edx, 000000FFh
shl edx, 4
mov PrevCode, eax
and PrevCode, 0000000Fh
shr eax, 4
and eax, 0000000Fh
add eax, edx
jmp @@x
@@1:
mov edx, PrevCode
shl edx, 8
and edx, 00000F00h
add eax, edx
mov PrevCode, LZW_EMPTY
@@X:
pop esi
end;
Var
Code : Integer;
OldCode : Integer;
FInChar : Integer;
InCode : Integer;
LastChar : Integer;
U : Boolean;
S : PLZWStack;
P : Integer;
begin
LZWReset;
LastChar := 0;
PrevCode := LZW_EMPTY;
GetMem( S, SizeOf(Integer) * FTblSize );
try
P := 0;
U := False;
OldCode := GetCode;
Code := OldCode;
FinChar := FStrTbl^[ Code ].FollChar;
PutChar( FInChar );
InCode := GetCode;
while ( InCode <> EOF_CHAR ) do
begin
Code := InCode;
if ( not FStrTbl^[Code].Used ) then
begin
LastChar := FInChar;
Code := OldCode;
U := TRUE;
End;
while ( FStrTbl^[ Code ].PrevChar <> LZW_NO_PREV ) Do
with FStrTbl[Code] do
begin
S^[ P ] := FollChar;
inc( P );
If P >= FTblSize Then raise ECompressorError.CreateRes(SInvalidData);
Code := PrevChar;
end;
FInChar := FStrTbl^[Code].FollChar;
PutChar( FInChar );
asm
@@2:
mov ecx, p
or ecx, ecx
je @@1
dec ecx
mov p, ecx
mov eax, s
mov edx, [ eax + ecx*4 ]
mov eax, self
call TCustomCompressor.PutChar
jmp @@2
@@1:
end;
If U Then
Begin
FInChar := LastChar;
PutChar ( FInChar );
U := FALSE;
End;
MakeTableEntry( OldCode, FInChar );
OldCode := InCode;
InCode := GetCode;
End;
FlushOutBuffer;
FlushOutBuffer;
finally
FreeMem( S );
end;
end;
procedure TLZWCompressor.GetData(pData: Pointer; var cbData: Integer);
begin
cbData:=FInStream.Read(pData^,cbData);
end;
procedure TLZWCompressor.SetData(pData: Pointer; var cbData: Integer);
begin
cbData:=FOutStream.Write(pData^,cbData);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -