2017-12-15

Navigation

Skip Navigation Links

Hash algorithms

Asymmetric Algorithms

Symmetric Cipher Algorithms

Encoding Algorithms

Compression Algorithms

Pseudo Random Number Algorithms

Steganography

Library Wrappers

String Comparison

Others

Syntax highlighting by Prism
PBCrypto.com Mirror

LZSS

Algorithm creator(s)

Abraham Lempel, Jakob Ziv


PB author(s)

Semen Matusovski, Don Dickinson


Description

Slow compression but decompression is fast.


Note

n/a


Source

https://forum.powerbasic.com/forum/user-to-user-discussions/source-code/25004-lzss?t=24355


See also


Source Code

Download source code file lzss.bas (Right-click -> "Save as ...")

'Somehow Don already posted similar code - see http://www.powerbasic.com/support/forums/Forum7/HTML/000379.html
'I decided to increase a little compression speed. 
'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
                  WndSubLen = 2
                  For WndBufPosA = 2 To MaxSearchChars - 1
                     If @InBufCurAddr[WndBufPosA] <> @WndBufBaseAddr[WndBufPosT + WndBufPosA] Then Exit For
                     Incr WndSubLen
                  Next
                  If WndSubLen > WndSubBestLen Then
                     If (WndBufPosT + WndSubLen) <= (%LZSS_WINDOW_SIZE + 1) Then _
                        WndSubBestLen = WndSubLen: WndSubBestOff = WndBufPosT
                  End If
               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 


------------------
E-MAIL: matus@perevozki.ru

Mirror provided by Knuth Konrad