⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 compresslzw.pas

📁 老外的超高效率压缩
💻 PAS
📖 第 1 页 / 共 2 页
字号:
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 + -