lzss16.pas

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

{$G+}

Unit LZSS16;
{
   LZSSUNIT - Compress and uncompress unit using LZ77 algorithm for
   Borland (Turbo) Pascal version 7.0.

   Assembler Programmer: Andy Tam, Pascal Conversion: Douglas Webb,
   Unit Conversion and Dynamic Memory Allocation: Andrew Eigus.

   Written by Andrew Eigus (aka: Mr. Byte) of:
   Fidonet: 2:5100/33,
   Internet: [e-mail], [e-mail].

   Modified again by Chris Rankin: apart from a few minor tweaks to the
   code, the only real change is the grouping together of TextBuf, Left,
   Right and Mom into a (large!) record which is allocated in a single
   segment on the Heap. This enables ES to be loaded ONCE at the beginning
   of LZEncode and LZDecode, *drastically* reducing the number of segment
   loads during a typical LZ call. This should enhance performance,
   especially under DPMI and Windows.


   Public Domain version 1.10, last changed on 15.07.96.
   Target platforms: DOS, DPMI, Windows.

}

interface

{#Z+}
{ This unit is ready for use with Dj. Murdoch's ScanHelp utility which
  will make a Borland .TPH file for it ????? }
{#Z-}

type
  TLZSSWord = word;

const Log2TLZSSWord = 1;

const
  LZRWBufSize     = 32000{8192}; { Read buffer size }

{#Z+}
  N           = 4096;  { Bigger N -> Better compression on big files only. }
  F           = 18;
  Threshold   = 2;
  Nul         = N * SizeOf(TLZSSWord);
  InBufPtr    : TLZSSWord = LZRWBufSize;
  InBufSize   : TLZSSWord = LZRWBufSize;
  OutBufPtr   : TLZSSWord = 0;
{#Z-}

type
{#X TWriteProc}{#X LZSquash}{#X LZUnsquash}

  TReadProc = function(var ReadBuf): TLZSSWord;
  { This is declaration for custom read function. It should read
    #LZRWBufSize# bytes from ReadBuf, returning the number of bytes
    actually read. }

{#X TReadProc}{#X LZSquash}{#X LZUnsquash}
  TWriteProc = function(var WriteBuf;
                            Count: TLZSSWord): TLZSSWord;
  { This is declaration for custom write function. It should write
    Count bytes into WriteBuf, returning the number of actual bytes
    written. }

{#Z+}
  PLZRWBuffer = ^TLZRWBuffer;
  TLZRWBuffer = array[0..LZRWBufSize - 1] of Byte; { file buffers }

  PLZTextBuf = ^TLZTextBuf;
  TLZTextBuf = array[0..N + F - 2] of Byte;

  PLeftMomTree = ^TLeftMomTree;
  TLeftMomTree = array[0..N] of TLZSSWord;
  PRightTree = ^TRightTree;
  TRightTree = array[0..N + 256] of TLZSSWord;

  PBinaryTree = ^TBinaryTree;
  TBinaryTree = record
                  TextBuf: TLZTextBuf;
                  Left:    TLeftMomTree;
                  Right:   TRightTree;
                  Mom:     TLeftMomTree
                end;
const
  LZSSMemRequired = SizeOf(TLZRWBuffer)*2 + SizeOf(TBinaryTree);
{#Z-}

function LZInit : boolean;
{ This function should be called before any other compression routines
  from this unit - it allocates memory and initializes all internal
  variables required by compression procedures. If allocation fails,
  LZInit returns False, this means that there isn't enough memory for
  compression or decompression process. It returns True if initialization
  was successful. }
{#X LZDone}{#X LZSquash}{#X LZUnsquash}

procedure LZSquash(ReadProc : TReadProc; WriteProc : TWriteProc);
{ This procedure is used for compression. ReadProc specifies custom
  read function that reads data, and WriteProc specifies custom write
  function that writes compressed data. }
{#X LZUnsquash}{#X LZInit}{#X LZDone}

procedure LZUnSquash(ReadProc : TReadProc; WriteProc : TWriteProc);
{ This procedure is used for decompression. ReadProc specifies custom
  read function that reads compressed data, and WriteProc specifies
  custom write function that writes decompressed data. }
{#X LZSquash}{#X LZInit}{#X LZDone}

procedure LZDone;
{ This procedure should be called after you finished compression or
  decompression. It deallocates (frees) all memory allocated by LZInit.
  Note: You should always call LZDone after you finished using compression
  routines from this unit. }
{#X LZInit}{#X LZSquash}{#X LZUnsquash}

procedure LZEncode;
procedure LZDecode;

{#Z+}
const BinaryTree: PBinaryTree = nil;
const InBufP:     PLZRWBuffer = nil;
const OutBufP:    PLZRWBuffer = nil;

const IsLZInitialized: boolean = false;

var
  Height, MatchPos, MatchLen, LastLen: TLZSSWord;
  CodeBuf : array[0..16] of Byte;
  LZReadProc  : TReadProc;
  LZWriteProc : TWriteProc;
{#Z-}

implementation

type
  PtrRec = record
             Ofs, Seg: word
           end;

Function LZSS_Read : TLZSSWord;    { Returns # of bytes read }
Begin
  LZSS_Read := LZReadProc(InBufP^);
End; { LZSS_Read }

Function LZSS_Write : TLZSSWord;  { Returns # of bytes written }
Begin
  LZSS_Write := LZWriteProc(OutBufP^, OutBufPtr);
End; { LZSS_Write }

Procedure GetC; assembler;
Asm
{
  getc : return a character from the buffer
          RETURN : AL = input char
                   Carry set when EOF
}
              push    bx
              mov     bx, inBufPtr
              cmp     bx, inBufSize
              jb      @getc1
              push    cx
              push    dx
              push    di
              push    si
              push    es
              call    LZSS_Read
              pop     es
              pop     si
              pop     di
              pop     dx
              pop     cx
              mov     inBufSize, ax
              or      ax, ax
              jnz     @NewBuf
              stc                         { ; set carry to indicate EOF }
              jmp     @Exit

  @NewBuf:    xor     bx, bx

  @getc1:     PUSH    DI
              PUSH    ES
              LES     DI,[InBufP]
              MOV     AL,[ES:DI+BX]
              POP     ES
              POP     DI
              inc     bx
              mov     inBufPtr, bx
              clc                         { ; clear the carry flag }

  @Exit:      pop bx
End; { Getc }

Procedure PutC; assembler;
{
  putc : put a character into the output buffer
             Entry : AL = output char
}
Asm
              push    bx
              mov     bx, outBufPtr
              PUSH    DI
              PUSH    ES
              LES     DI,[OutBufP]
              MOV     [ES:DI+BX],AL
              POP     ES
              POP     DI
              inc     bx
              cmp     bx, LZRWBufSize
              jb      @putc1
              mov     OutBufPtr,LZRWBufSize   { Just so the flush will work. }
              push    cx
              push    dx
              push    di
              push    si
              push    es
              call    LZSS_Write
              pop     es
              pop     si
              pop     di
              pop     dx
              pop     cx
              xor     bx, bx
  @putc1:     mov     outBufPtr, bx
              pop     bx
End; { Putc }

Procedure InitTree; assembler;
{
  initTree : initialize all binary search trees.  There are 256 BST's, one
             for all strings started with a particular character.  The
             parent is tree K is the node N + K + 1 and it has only a
             right child
}
Asm
      cld
      MOV     DI,PtrRec[OFFSET BinaryTree].Ofs
      ADD     DI, OFFSET TBinaryTree.Mom
      mov     cx, N+1
      mov     ax, Nul
      rep     stosw
{                                                             }
{ Initialise last 256 elements to BinaryTree.Right to Nul ... }
{                                                             }
      add     di, OFFSET TBinaryTree.Right - OFFSET TBinaryTree.Mom
      mov     ch, (256 shr 8)
      rep     stosw
End; { InitTree }

Procedure Splay; assembler;
{
  splay : use splay tree operations to move the node to the 'top' of
           tree.  Note that it will not actual become the root of the tree
           because the root of each tree is a special node.  Instead, it
           will become the right child of this special node.

             ENTRY : di = the node to be rotated
}
Asm
  @Splay1:
              PUSH    BX
              MOV     BX,PtrRec[OFFSET BinaryTree].Ofs
              MOV     SI,[ES:BX+DI+OFFSET TBinaryTree.Mom]
              POP     BX
{              mov     si, [Offset Mom + di]}
              cmp     si, Nul           { ; exit if its parent is a special node }
              ja      @Splay4
              MOV     BX,PtrRec[OFFSET BinaryTree].Ofs
              MOV     BX,[ES:BX+SI+OFFSET TBinaryTree.Mom]
{              mov     bx, [Offset Mom + si]}
              cmp     bx, Nul           { ; check if its grandparent is special }
              jbe     @Splay5           { ; if not then skip }
              PUSH    BX
              MOV     BX,PtrRec[BinaryTree].Ofs
              CMP     DI,[ES:BX+SI+OFFSET TBinaryTree.Left]
              POP     BX
{              cmp     di, [Offset Left + si]} { ; is the current node is a left child ? }
              jne     @Splay2
              PUSH    BX
              MOV     BX,PtrRec[OFFSET BinaryTree].Ofs
              MOV     DX,[ES:BX+DI+OFFSET TBinaryTree.Right]
{              mov     dx, [Offset Right + di]}    { ; perform a left zig operation }
              MOV     [ES:BX+SI+OFFSET TBinaryTree.Left],DX
{              mov     [Offset Left + si], dx}
              MOV     [ES:BX+DI+OFFSET TBinaryTree.Right],SI
              POP     BX
{              mov     [Offset Right + di], si}
              jmp     @Splay3
  @Splay2:
              PUSH    BX
              MOV     BX,PtrRec[OFFSET BinaryTree].Ofs
              MOV     DX,[ES:BX+DI+OFFSET TBinaryTree.Left]
{              mov     dx, [Offset Left + di]}     { ; perform a right zig }
              MOV     [ES:BX+SI+OFFSET TBinaryTree.Right],DX
{              mov     [Offset Right + si], dx}
              MOV     [ES:BX+DI+OFFSET TBinaryTree.Left],SI
              POP     BX
{              mov     [Offset Left + di], si}
  @Splay3:
              PUSH    SI
              MOV     SI,PtrRec[OFFSET BinaryTree].Ofs
              MOV     [ES:SI+BX+OFFSET TBinaryTree.Right],DI
              POP     SI
{              mov     [Offset Right + bx], di}
              xchg    bx, dx
              PUSH    AX
              MOV     AX,BX
              MOV     BX,PtrRec[OFFSET BinaryTree].Ofs
              ADD     BX,AX
              MOV     [ES:BX+OFFSET TBinaryTree.Mom],SI
              MOV     BX,PtrRec[OFFSET BinaryTree].Ofs
              MOV     [ES:BX+SI+OFFSET TBinaryTree.Mom],DI
              MOV     [ES:BX+DI+OFFSET TBinaryTree.Mom],DX
              MOV     BX,AX
              POP     AX
{              mov     [Offset Mom + bx], si
              mov     [Offset Mom + si], di
              mov     [Offset Mom + di], dx}
  @Splay4:    jmp     @end
  @Splay5:
              PUSH    DI
              MOV     DI,PtrRec[OFFSET BinaryTree].Ofs
              MOV     CX,[ES:DI+BX+OFFSET TBinaryTree.Mom]
              POP     DI
{              mov     cx, [Offset Mom + bx]}
              PUSH    BX
              MOV     BX,PtrRec[OFFSET BinaryTree].Ofs
              CMP     DI,[ES:BX+SI+OFFSET TBinaryTree.Left]
              POP     BX
{              cmp     di, [Offset Left + si]}
              jne     @Splay7
              PUSH    DI
              MOV     DI,PtrRec[OFFSET BinaryTree].Ofs
              CMP     SI,[ES:DI+BX+OFFSET TBinaryTree.Left]
              POP     DI
{              cmp     si, [Offset Left + bx]}
              jne     @Splay6
              PUSH    AX
              MOV     AX,DI
              MOV     DI,PtrRec[OFFSET BinaryTree].Ofs
              ADD     DI,SI
              MOV     DX,[ES:DI+OFFSET TBinaryTree.Right]
{              mov     dx, [Offset Right + si]   } { ; perform a left zig-zig operation }
              MOV     DI,PtrRec[OFFSET BinaryTree].Ofs
              MOV     [ES:DI+BX+OFFSET TBinaryTree.Left],DX
{              mov     [Offset Left + bx], dx}
              xchg    bx, dx
              MOV     [ES:DI+BX+OFFSET TBinaryTree.Mom],DX
{              mov     [Offset Mom + bx], dx}
              ADD     DI,AX
              MOV     BX,[ES:DI+OFFSET TBinaryTree.Right]
{              mov     bx, [Offset Right + di]}
              MOV     DI,PtrRec[OFFSET BinaryTree].Ofs
              ADD     DI,SI
              MOV     [ES:DI+OFFSET TBinaryTree.Left],BX
              MOV     DI,PtrRec[OFFSET BinaryTree].Ofs
              MOV     [ES:DI+BX+OFFSET TBinaryTree.Mom],SI
{              mov     [Offset Left +si], bx
              mov     [Offset Mom + bx], si}
              mov     bx, dx
              ADD     DI,SI
              MOV     [ES:DI+OFFSET TBinaryTree.Right],BX
              MOV     DI,PtrRec[OFFSET BinaryTree].Ofs
              ADD     DI,AX
              MOV     [ES:DI+OFFSET TBinaryTree.Right],SI
{              mov     [Offset Right + si], bx
              mov     [Offset Right + di], si}
              MOV     DI,PtrRec[OFFSET BinaryTree].Ofs
              MOV     [ES:DI+BX+OFFSET TBinaryTree.Mom],SI
              ADD     DI,SI
              MOV     [ES:DI+OFFSET TBinaryTree.Mom], AX
              MOV     DI,AX
              POP     AX
{              mov     [Offset Mom + bx], si
              mov     [Offset Mom + si], di}
              jmp     @Splay9
  @Splay6:
              PUSH    AX
              MOV     AX,SI
              MOV     SI,PtrRec[OFFSET BinaryTree].Ofs
              ADD     SI,DI
              MOV     DX,[ES:SI+OFFSET TBinaryTree.Left]