posted June 01, 2002 06:03 AM            

I have no idea, why Don named this algo "LZ77".
If somebody interesting, you can find brief description at http://www.rasip.fer.hr/research/compress/algorithms/index.html

Unf. LZSS compression is not fast by definition (and this fact not directly depends of implementation) and commercial archivators use this algo in combination with arithmetic coding only.

   ' 6.11
   #Compile Exe
   #Dim All
   #Register None
   #Include "Win32Api.Inc"
   $SourceFile = "C:\System.1St" ' <--- Change
   $TargetFile = "C:\System.Lz
   '=============================================================================
   %LZSS_WINDOW_SIZE           = 4096
   %LZSS_MATCH_LENGTH_MAXIMUM  =   18
   %LZSS_MATCH_LENGTH_MINIMUM  =    3
   Function Compress_LZSS (InBuf As String, OutBuf As String) As Long
      Dim InBufSize As Local Dword
      Dim InBufCurAddr As Local Byte Ptr
      Dim InBufEndAddr As Local Dword
      Dim OutBufSize As Local Dword
      Dim OutBufCurAddr As Local Byte Ptr
      Dim OutBufEndAddr As Local Dword
      Dim OutBufNewAddr As Local Byte Ptr
      Dim WndBuf As Local String
      Dim WndBufBaseAddr As Local Byte Ptr
      Dim WndBufPos As Local Word
      Dim WndEnt(&HFFFF??) As Local Word
      Dim WndRef(%LZSS_WINDOW_SIZE) As Local Word
      Dim WndSch As Word
      Dim WndBufPosT As Local Word
      Dim WndBufPosL As Local Word
      Dim WndBufPosM As Local Word
      Dim WndBufPosC As Local Word
      Dim WndBufPosA As Local Dword
      Dim WndSubLen As Local Word
      Dim WndSubOff As Local Word
      Dim WndSubBestLen As Local Word
      Dim WndSubBestOff As Local Word
      Dim MaxSearchChars As Local Dword
      Dim LenAndOffSet As Local Word
      Dim BitMask    As Local Byte
      Dim BitMaskAdd As Local Byte
      InBufSize = Len(InBuf): If InBufSize < %LZSS_MATCH_LENGTH_MINIMUM Then _
         OutBuf = "": Function = -1: Exit Function ' Nothing to compress
      InBufCurAddr = StrPtr(InBuf)
      InBufEndAddr = InBufCurAddr + InBufSize
      OutBufSize = InBufSize ' maximum
      OutBuf = Space$(OutBufSize)
      OutBufCurAddr = StrPtr(OutBuf)
      OutBufEndAddr = InBufCurAddr + OutBufSize
      WndBuf = Space$(%LZSS_WINDOW_SIZE + %LZSS_MATCH_LENGTH_MAXIMUM - 1)
      WndBufBaseAddr = StrPtr(WndBuf) - 1
      WndBufPos = 1
      Do
         If InBufCurAddr >= InBufEndAddr Then Exit Do
         OutBufNewAddr = OutBufCurAddr + 1: If CDwd(OutBufEndAddr - OutBufCurAddr) < 17 Then _
            OutBuf = "": Function = -1: Exit Function ' 17 = 2 * 8 + 1
         BitMask = 0: BitMaskAdd = 1
         Do
            WndSubBestLen = 2
            MaxSearchChars = InBufEndAddr - InBufCurAddr
            If MaxSearchChars > %LZSS_MATCH_LENGTH_MAXIMUM Then MaxSearchChars = %LZSS_MATCH_LENGTH_MAXIMUM
            WndSch = @InBufCurAddr + @InBufCurAddr[1] * 256
            WndBufPosT = WndEnt(WndSch)
            While WndBufPosT
               If @InBufCurAddr[WndSubBestLen] = @WndBufBaseAddr[WndBufPosT + WndSubBestLen] Then
                  Do
                     WndSubLen = WndSubBestLen
                     For WndBufPosA = WndSubBestLen To MaxSearchChars - 1
                         If @InBufCurAddr[WndBufPosA] <> @WndBufBaseAddr[WndBufPosT + WndBufPosA] Then Exit For
                         Incr WndSubLen
                     Next
                     If WndSubLen > WndSubBestLen Then
                        For WndBufPosA = 2 To WndSubBestLen - 1
                            If @InBufCurAddr[WndBufPosA] <> @WndBufBaseAddr[WndBufPosT + WndBufPosA] Then Exit Do
                        Next
                        If (WndBufPosT + WndSubLen) <= (%LZSS_WINDOW_SIZE + 1) Then _
                           WndSubBestLen = WndSubLen: WndSubBestOff = WndBufPosT
                     End If
                     Exit Do
                  Loop
               End If
               WndBufPosT = WndRef(WndBufPosT)
            Wend
            If WndSubBestLen < %LZSS_MATCH_LENGTH_MINIMUM Then
               BitMask = BitMask + BitMaskAdd
               @OutBufNewAddr = @InBufCurAddr: Incr OutBufNewAddr
               WndSubBestLen = 1
            Else
               LenAndOffSet = (WndSubBestLen - %LZSS_MATCH_LENGTH_MINIMUM) * &H1000 + (WndSubBestOff - 1)
               @OutBufNewAddr = LoByt(LenAndOffset): Incr OutBufNewAddr
               @OutBufNewAddr = HiByt(LenAndOffset): Incr OutBufNewAddr
            End If
            For WndBufPosA = 1 To WndSubBestLen
               If WndBufPos > %LZSS_WINDOW_SIZE Then WndBufPos = 1
               For WndBufPosC = 0 To 1
                   WndBufPosM = WndBufPos - WndBufPosC
                   If WndBufPosM Then
                      WndSch = @WndBufBaseAddr[WndBufPosM] + @WndBufBaseAddr[WndBufPosM + 1] * 256
                      WndBufPosT = WndEnt(WndSch)
                      WndBufPosL = 0
                      While WndBufPosT
                         If WndBufPosT = WndBufPosM Then
                            If WndBufPosL = 0 Then WndEnt(WndSch) = WndRef(WndBufPosM) Else _
                               WndRef(WndBufPosL) = WndRef(WndBufPosM)
                            WndRef(WndBufPosM) = 0: Exit Do
                         End If
                         WndBufPosL = WndBufPosT
                         WndBufPosT = WndRef(WndBufPosT)
                     Wend
                  End If
               Next
               @WndBufBaseAddr[WndBufPos] = @InBufCurAddr
               For WndBufPosC = 0 To 1
                   WndBufPosM = WndBufPos - WndBufPosC
                   If WndBufPosM Then
                      WndSch = @WndBufBaseAddr[WndBufPosM] + @WndBufBaseAddr[WndBufPosM + 1] * 256
                      WndRef(WndBufPosM) = WndEnt(WndSch)
                      WndEnt(WndSch) = WndBufPosM
                   End If
               Next
               Incr WndBufPos
               Incr InBufCurAddr
            Next
            If InBufCurAddr = InBufEndAddr Then Exit Loop
            If BitMaskAdd = 128 Then Exit Do
            BitMaskAdd = BitMaskAdd + BitMaskAdd
         Loop
         @OutBufCurAddr = BitMask
         OutBufCurAddr = OutBufNewAddr
      Loop
      OutBuf = MkDwd$(InBufSize) + Left$(outBuf, OutBufCurAddr - StrPtr(OutBuf))
   End Function
   '=================================================================
   Function DeCompress_LZSS (InBuf As String, OutBuf As String) As Long
      Dim InBufSize As Local Dword
      Dim InBufCurAddr As Local Byte Ptr
      Dim InBufEndAddr As Local Dword
      Dim OutBufSize As Local Dword
      Dim OutBufCurAddr As Local Byte Ptr
      Dim OutBufEndAddr As Local Dword
      Dim WndBuf As Local String
      Dim WndBufStartAddr As Local Byte Ptr
      Dim WndBufCurAddr As Local Byte Ptr
      Dim WndBufEndAddr As Local Dword
      Dim WndBufSubstrAddr As Local Byte Ptr
      Dim WndSubOff As Local Word
      Dim WndSubLen As Local Word
      Dim WndBufPosA As Local Word
      Dim LenAndOffSet As Local Word
      Dim BitMask    As Local Byte
      Dim BitMaskAdd As Local Byte
      InBufSize = Len(InBuf)
      If InBufSize < 4 Then Function = -1: Exit Function
      InBufCurAddr = StrPtr(InBuf)
      InBufEndAddr = InBufCurAddr + InBufSize
      OutBufSize = CvDwd(InBuf, 1): InBufCurAddr = InBufCurAddr + 4
      OutBuf = Space$(OutBufSize)
      OutBufCurAddr = StrPtr(outBuf)
      WndBuf = Space$(%LZSS_WINDOW_SIZE + %LZSS_MATCH_LENGTH_MAXIMUM - 1)
      WndBufStartAddr = StrPtr(WndBuf)
      WndBufEndAddr = WndBufStartAddr + %LZSS_WINDOW_SIZE
      WndBufCurAddr = WndBufStartAddr
      Do
         If InBufCurAddr >= InBufEndAddr Then Exit Do
         BitMask = @InBufCurAddr: Incr InBufCurAddr
         BitMaskAdd = 1
         Do
            If InBufCurAddr >= InBufEndAddr Then Exit Do
            If (BitMask And BitMaskAdd) Then
               If WndBufCurAddr >= WndBufEndAddr Then WndBufCurAddr = WndBufStartAddr
               @OutBufCurAddr = @InBufCurAddr
               @WndBufCurAddr = @InBufCurAddr
               Incr WndBufCurAddr: Incr InBufCurAddr: Incr OutBufCurAddr
            Else
               LenAndOffset = @InBufCurAddr + 256 * @InBufCurAddr[1]
               InBufCurAddr = InBufCurAddr + 2
               WndSubOff = LenAndOffset And &HFFF
               Shift Right LenAndOffset, 12
               WndSubLen = LenAndOffset + %LZSS_MATCH_LENGTH_MINIMUM
               WndBufSubstrAddr = WndBufStartAddr + WndSubOff
               For WndBufPosA = 1 To WndSubLen
                  @OutBufCurAddr = @WndBufSubstrAddr
                  Incr WndBufSubstrAddr: Incr OutBufCurAddr
               Next
               WndBufSubstrAddr = OutBufCurAddr - WndSubLen
               For WndBufPosA = 1 To WndSubLen
                  If WndBufCurAddr >= WndBufEndAddr Then WndBufCurAddr = WndBufStartAddr
                  @WndBufCurAddr = @WndBufSubstrAddr
                  Incr WndBufCurAddr
                  Incr WndBufSubstrAddr
               Next
            End If
            If BitMaskAdd = 128 Then Exit Do Else BitMaskAdd = BitMaskAdd + BitMaskAdd
         Loop
      Loop

   End Function
   Function PbMain
      Local InBuf As String, InBuf2 As String, OutBuf As String
      Local f As Long, t1 As Single, t2 As Single, t3 As Single
      f = FreeFile: ErrClear: Open $SourceFile For Binary As #f
      If Err = 0 Then Get$ #f, Lof(f), InBuf
      Close #f
      If Err Then MsgBox "Can't read the source file": Exit Function
      t1 = Timer
      If Compress_LZSS (InBuf, OutBuf) < 0 Then MsgBox "Can't compress": Exit Function
      t2 = Timer
      If Decompress_LZSS (OutBuf, inBuf2)  Then MsgBox "Can't decompress": Exit Function
      t3 = Timer
      f = FreeFile: ErrClear: Open $TargetFile For Output As #f
      If Err = 0 Then Print #f, OutBuf;
      Close #f
      If Err Then MsgBox "Can't write the target file": Exit Function
      MsgBox "Compress: " + Format$(1000# * (t2 - t1), "#") + " ms" + $CrLf + _
             "Decompress: " + Format$(1000# * (t3 - t2), "#") + " ms" + $CrLf + _
             "Ratio: " + Format$(Len(InBuf)) + " -> " + Format$(Len(OutBuf))
      If InBuf <> InBuf2 Then MsgBox "Problems"
    End Function

posted September 17, 2004 10:30 AM            

quote:

---

I have no idea, why Don named this algo "LZ77".

---

Just for people who are wondering whether this is LZ77 or not....

LZSS is a version of LZ77 developed by "storer" & "Szymanski" in '82. It improves on the original in three ways:

1. It holds the look ahead buffer in a cicular queue
2. It holds the dictionary in a binary tree
3. It creates tokens in two fields instead of three.

The deficiency of all LZ77 varients is that they make the assumption that patterns in the imput data occur close together, data streams that don't meet this req tend to compress poorly.

To be honest this algo works very well in my opinion.

(Hopefully that's enough useful info to warrent a mention in the source section