lzss32.pas

delhpi下lzss加密算法源码及例子

  SHR ESI, Log2TLZSSWord
  ADD ESI, EBP
  SHR EDI, Log2TLZSSWord
  ADD EDI, EBP
@Ins6:
  MOVZX EDX, BYTE PTR [EDI+EBX]
  MOVZX ECX, BYTE PTR [ESI+EBX]
  SUB EDX, ECX
  JNZ @Ins7
  INC EBX
  CMP EBX, F
  JB @Ins6
@Ins7:
  SUB ESI, EBP
  SUB EDI, EBP
  MOV EAX, ESI
  SHL ESI, Log2TLZSSWord
  SHL EDI, Log2TLZSSWord
  CMP EBX, [OFFSET MatchLen]
  JBE @Ins1
  MOV [OFFSET MatchPos], EAX
  MOV [OFFSET MatchLen], EBX
  CMP EBX, F
  JB @Ins1

@Ins8:
  LEA ECX, [EBP+OFFSET TBinaryTree.Left]
  LEA EDX, [EBP+OFFSET TBinaryTree.Right]
  ADD EBP, OFFSET TBinaryTree.Mom

  MOV EAX, [EBP+ESI]
  MOV [EBP+EDI], EAX
  MOV EAX, [ECX+ESI]
  MOV [ECX+EDI], EAX
  MOV [EBP+EAX], EDI
  MOV EAX, [EDX+ESI]
  MOV [EDX+EDI], EAX
  MOV [EBP+EAX], EDI
  MOV EAX, [EBP+ESI]

  CMP ESI, [EDX+EAX]
  JNE @Ins9

  MOV [EDX+EAX], EDI
  JMP @Ins10
@Ins9:
  MOV [ECX+EAX], EDI

@Ins10:
  MOV DWORD PTR [EBP+ESI], Nul

@Ins11:
  CMP Height, 30
  JB @Exit
  CALL Splay

@Exit:
  POPAD
end;

procedure DeleteNode; assembler;
{
   DeleteNode : delete the node from the tree

            ENTRY : ESI = position in the buffer
}
asm
  PUSHAD
  MOV EBP, [OFFSET BinaryTree]
  LEA ECX, [EBP+OFFSET TBinaryTree.Left]
  LEA EDX, [EBP+OFFSET TBinaryTree.Right]
  ADD EBP, OFFSET TBinaryTree.Mom

  SHL ESI, Log2TLZSSWord
  MOV EAX, Nul

  CMP [EBP+ESI], EAX  { ; if it has no parent then exit }
  JE @Exit
  CMP [EDX+ESI], EAX  { ; does it have a right child ? }
  JNE @HasRight
  MOV EDI, [ECX+ESI]
  JMP @Del3
@HasRight:
  MOV EDI, [ESI+ECX]  { ; does it have a left child ? }
  CMP EDI, EAX
  JNE @HasLeft
  MOV EDI, [ESI+EDX]
  JMP @Del3
@HasLeft:
  MOV EBX, [EDI+EDX]  { ; does it have a right grandchild ? }
  CMP EBX, EAX
  JE @Del2            { ; if no, then skip }
{                                                  }
{ Find the rightmost node in the right subtree ... }
{                                                  }
@Del1:
  MOV EDI, EBX
  MOV EBX, [EDX+EDI]
  CMP EBX, EAX
  JNE @Del1
{                                               }
{ Move this node as the root of the subtree ... }
{                                               }
  MOV EBX, [EBP+EDI]
  MOV EAX, [ECX+EDI]
  MOV [EDX+EBX], EAX
  MOV [EBP+EAX], EBX
  MOV EBX, [ECX+ESI]
  MOV [ECX+EDI], EBX
  MOV [EBP+EBX], EDI

@Del2:
  MOV EBX, [EDX+ESI]
  MOV [EDX+EDI], EBX
  MOV [EBP+EBX], EDI

@Del3:
  MOV EBX, [EBP+ESI]
  MOV [EBP+EDI], EBX
  CMP ESI, [EDX+EBX]
  JNE @Del4
  MOV [EDX+EBX], EDI
  JMP @Del5
@Del4:
  MOV [ECX+EBX], EDI
@Del5:
  MOV DWORD PTR [EBP+ESI], Nul

@Exit:
  POPAD
end;

procedure LZEncode; assembler;
asm
{                                       }
{ Need to preserve registers for Delphi }
{                                       }
  PUSHAD
{                }
{ Initialise ... }
{                }
  CALL InitTree
  XOR EBX, EBX
  MOV BYTE [CodeBuf], BL

  XOR ESI, ESI
  XOR EDX, EDX
  INC EDX

  PUSH EDX  // Temporary variable; accessed as [ESP]

  MOV EBP, [OFFSET BinaryTree]
  LEA EDI, [EBP+OFFSET TBinaryTree.TextBuf+N-F]
@Encode2:
  CALL GetC
  JNC @ReadOK
  TEST EBX, EBX
  JZ @Exit
  JMP @Encode4
@ReadOK:
  MOV [EDI+EBX], AL
  INC EBX
  CMP EBX, F
  JB @Encode2

@Encode4:
  SUB EDI, EBP
  MOV ECX, EBX
  XOR EBX, EBX
  PUSH EDI
  DEC EDI
@Encode5:
  CALL InsertNode
  INC EBX
  DEC EDI
  CMP EBX, F
  JB @Encode5
  POP EDI
  CALL InsertNode

@Encode6:
  MOV EAX, MatchLen
  CMP EAX, ECX
  JBE @Encode7
  MOV EAX, ECX
  MOV MatchLen, EAX
@Encode7:
  CMP EAX, Threshold
  JA @Encode8
  XOR EAX, EAX
  INC EAX
  MOV MatchLen, EAX             // Loads MatchLen with 1
                                // Only interested in AL
  MOV EAX, [ESP]
  OR BYTE [CodeBuf], AL
  MOV EAX, [EBP+EDI]            // Only interested in AL
  MOV BYTE [EDX+CodeBuf], AL
  INC EDX
  JMP @Encode9

@Encode8:
  MOV EAX, MatchPos
  MOV BYTE [EDX+CodeBuf], AL
  INC EDX
  SHL AH, 4
  MOV AL, BYTE[OFFSET MatchLen]
  SUB AL, Threshold+1
  ADD AH, AL
  MOV BYTE [EDX+CodeBuf], AH
  INC EDX

@Encode9:
  SHL BYTE PTR [ESP], 1
  JNZ @Encode11

  XOR EBX, EBX
@Encode10:
  MOV EAX, [EBX+ CodeBuf]   // PutC only stores AL
  CALL PutC
  INC EBX
  CMP EBX, EDX
  JB @Encode10
  XOR EDX, EDX
  INC EDX
  MOV [ESP], EDX
  MOV BYTE [OFFSET CodeBuf], DH

@Encode11:
  MOV EBX, MatchLen
  MOV LastLen, EBX

  XOR EBX, EBX
@Encode12:
  CALL GetC
  JC @EncodeY
  CALL DeleteNode
  MOV [EBP+ESI], AL
  CMP ESI, F-1
  JAE @Encode13
  MOV [EBP+ESI+N], AL
@Encode13:
  INC ESI
  AND ESI, N-1
  INC EDI
  AND EDI, N-1
  CALL InsertNode
  INC EBX
  CMP EBX, LastLen
  JB @Encode12
  JMP @Encode16

@EncodeX:
  INC EBX
  CALL DeleteNode
  MOV EAX, N-1
  INC ESI
  AND ESI, EAX
  INC EDI
  AND EDI, EAX
  DEC ECX
  JZ @EncodeY
  CALL InsertNode
@EncodeY:
  CMP EBX, LastLen
  JB @EncodeX

@Encode16:
  TEST ECX, ECX
  JNZ @Encode6
@Encode17:
  TEST EDX, EDX
  JZ @Exit
{                                                   }
{ Write EDX chars from CodeBuf to Output buffer ... }
{                                                   }
  XOR EBX, EBX
@Encode18:
  MOV EAX, [EBX+CodeBuf]  // PutC only stores AL
  CALL PutC
  INC EBX
  CMP EBX, EDX
  JB @Encode18
{                                           }
{ Restore registers and flush Output buffer }
{                                           }
@Exit:
  POP EDX
  POPAD
  CALL LZSS_Write
end;

procedure LZDecode; assembler;
asm
{                                       }
{ Need to preserve registers for Delphi }
{                                       }
  PUSHAD
{                }
{ Initialise ... }
{                }
  XOR EDX, EDX
  MOV EDI, N-F
  MOV ESI, [OFFSET BinaryTree] // First field in BTree is TextBuf
{                }
{ Main loops ... }
{                }
@Decode2:
  SHR EDX, 1
  TEST DH, DH
  JNZ @Decode3
  CALL GetC
  JC @Exit
  MOV DH, $FF
  MOV DL, AL
@Decode3:
  CALL GetC
  JC @Exit
// Two alternatives ... Either:
  TEST DL, 1
  JZ @Decode4
// Or:
//  bt edx, 0
//  jnc @Decode4
  MOV [ESI+EDI], AL
  INC EDI
  AND EDI, N-1
  CALL PutC
  JMP @Decode2
@Decode4:
  MOV EBX, EAX   // Only require MOV BL, AL
  CALL GetC
  JC @Exit
  MOV BH, AL
  SHR BH, 4
  MOVZX ECX, AL
  AND CL, $F
  ADD CL, Threshold
  INC ECX
@Decode5:
  AND EBX, N-1
  MOV EAX, [ESI+EBX]  // Only interested in AL ...
  MOV [ESI+EDI], AL
  INC EDI
  AND EDI, N-1
  CALL PutC
  INC EBX
  DEC ECX
  JNZ @Decode5
  JMP @Decode2
{                                               }
{ Restore registers and flush Output buffer ... }
{                                               }
@Exit:
  POPAD
  CALL LZSS_Write
end;

function LZInit: boolean;
label
  Abort;
Begin
{
  *Non-interruptable* test for whether this unit is busy...
}
  asm
    BTS DWORD PTR [OFFSET IsLZInitialized], 0 // If IsLZInitialized then goto Abort;
    JC Abort                                  // IsLZInitialized := True;
  end;
{
  Unit WASN'T busy, but it is now ...
}
  try
    New(InBufP);
    New(OutBufP);
    New(BinaryTree)
  except
    LZDone   // Flag unit as `free' again ...
  end;
Abort:
  LZInit := IsLZInitialized
End; { LZInit }

Procedure LZDone;
Begin
  if InBufP <> nil then
    Dispose(InBufP);
  if OutBufP <> nil then
    Dispose(OutBufP);
  if BinaryTree <> nil then
    Dispose(BinaryTree);
  IsLZInitialized := False
End; { LZDone }

Procedure LZSquash(ReadProc: TReadProc; WriteProc: TWriteProc);
Begin
  if IsLZInitialized then
  begin
    InBufPtr := LZRWBufSize;
    InBufSize := LZRWBufSize;
    OutBufPtr := 0;
    Height := 0;
    MatchPos := 0;
    MatchLen := 0;
    LastLen := 0;

    FillChar(BinaryTree^, SizeOf(TBinaryTree), 0);
    FillChar(CodeBuf, SizeOf(CodeBuf), 0);

    LZReadProc := ReadProc;
    LZWriteProc := WriteProc;

    LZEncode
  end
End; { LZSquash }

Procedure LZUnSquash(ReadProc: TReadProc; WriteProc: TWriteProc);
Begin
  if IsLZInitialized then
  begin
    InBufPtr := LZRWBufSize;
    InBufSize := LZRWBufSize;
    OutBufPtr := 0;
    FillChar(BinaryTree^.TextBuf, SizeOf(TLZTextBuf), 0);

    LZReadProc := ReadProc;
    LZWriteProc := WriteProc;

    LZDecode
  end
End; { LZUnSquash }

end.