visual basic, vb, active server pages, asp, DHTML, vbscript,java, javscript, c, c++, c__ , source, code, sample, samples, program, programs, routine, routines, source code, snippet, snippets, control, controls, class, classes, module

You are in:
 
The Basics
Visual Basic Home
Categories
Search
Submissions

Advanced
Newest Code
Top Code of Month
Top Code of All Time
Code of the Day
Coding Contest

Beyond the Code
Discuss
Tutorials
Recommend-
ed Reading

Customize

Miscellaneous
Site Home
Other Sites

Latest Code Ticker for Visual Basic
Click here to see a screenshot of this code! GetAllWindowsHwnd's(+childs), Put then in table
By M.C on 5/22

(Screen Shot)

Create Eye-Friendly Menus Using MouseOver
By Sparq on 5/22


Create Eye-Friendly Menus Using MouseOver
By Sparq on 5/22


Click here to see a screenshot of this code! DecHex Color Codes
By eboy on 5/22

(Screen Shot)

Click here to see a screenshot of this code! Display Current Mouse Pointer Image
By Will Brendel on 5/22

(Screen Shot)

Click here to see a screenshot of this code! Alarm Clock
By EXoDuS on 5/21

(Screen Shot)

MS Office Bar Code Macros for Excel and Access
By Brant Anderson on 5/21


Bar Code Check Digit Calculator & Printing Application
By Brant Anderson on 5/21


Mouse over
By Stewart MacFarlane on 5/21


A+ Screen Zoom
By Rocky Clark (Kath-Rock Software) on 5/21


Click here to see a screenshot of this code! Using Option Buttons in a Array
By Adam Spicer on 5/21

(Screen Shot)

FourSevens
By Glen A Jorgensen on 5/21


RANDOM CIRCLE GENERATOR
By Richard Banks on 5/21


Click here to see a screenshot of this code! JK Manager
By Denis Wiegand on 5/21

(Screen Shot)

Simple Update Checker
By Andrew on 5/21


Click here to see a screenshot of this code! Snap
By ZerO Invasion on 5/21

(Screen Shot)

Click here to see a screenshot of this code! MouseMove
By Alexandre Joly on 5/21

(Screen Shot)

Number 2 Letter - algorithm
By Max Christian Pohle on 5/21


File Explorer
By EXoDuS on 5/21


Click here to see a screenshot of this code! Dude Chat
By Travis Ruiz on 5/21

(Screen Shot)

Calculate Angles from the coords of three points
By Kevin Laity on 5/21


Julian Date Converter
By Data Management Systems on 5/21


Screen Manager
By Albert Nicholas Tedja on 5/21


Click here to see a screenshot of this code! Checkers AI
By Viper on 5/21

(Screen Shot)

enter
By Adam Short on 5/21


API Demo V2
By Andy McCurtin on 5/21


mCodE
By amaru on 5/21


MaxiClipper
By ZaMaX23 on 5/21


File Wiping
By Adam on 5/21


Click here to see a screenshot of this code! ActiveX - Scroll Text on Form with Kinjal's Text Scroll ActiveX Control
By Kinjal Patel on 5/20

(Screen Shot)

Click here to put this ticker on your site!


Click here to join the
'Code of the Day' Mailing List


  @Backup.com  


  SQL Server Magazine  

   
Visual Basic Stats

Code: 585,335 lines
Users: 299 online
 
Search for: 
in language:
 
 
Sponsored by:
  @Backup.com  
 

   


   

LZSS Compress/Decompress\

VB icon
Submitted on: 5/20/1999
By: Jesper Soderberg

Level: Not Given
User Rating: By 36 Users
Compatibility:VB 5.0/6.0, VB 4.0/32

Users have accessed this code 3137 times.
 
 
     This is a standard LZSS compression/decompression engine. It is written in VB for learning purposes, and should be converted to C/C++ if it is to be used with large amounts of data. It uses a dictionary compression algorithm (like ZIP,ARJ and others) and works the best on data with a lot of repetitions.
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!

						
'**************************************
' Name: LZSS Compress/Decompress
' Description:This is a standard LZSS co
'     mpression/decompression engine. It is wr
'     itten in VB for learning purposes, and s
'     hould be converted to C/C++ if it is to 
'     be used with large amounts of data. It u
'     ses a dictionary compression algorithm (
'     like ZIP,ARJ and others) and works the b
'     est on data with a lot of repetitions.
' By: Jesper Soderberg
'
'
' Inputs:sCompData - the string to be co
'     mpressed, sDecompData - the string to be
'     decompressed
'
' Returns:Should be obvious
'
'Assumes:None
'
'Side Effects:None
'
'Warranty:
'code provided by Planet Source Code(tm)
'     (http://www.Planet-Source-Code.com) 'as 
'     is', without warranties as to performanc
'     e, fitness, merchantability,and any othe
'     r warranty (whether expressed or implied
'     ).
'Terms of Agreement:
'By using this source code, you agree to
'     the following terms...
' 1) You may use this source code in per
'     sonal projects and may compile it into a
'     n .exe/.dll/.ocx and distribute it in bi
'     nary format freely and with no charge.
' 2) You MAY NOT redistribute this sourc
'     e code (for example to a web site) witho
'     ut written permission from the original 
'     author.Failure to do so is a violation o
'     f copyright laws.
' 3) You may link to this code from anot
'     her website, provided it is not wrapped 
'     in a frame.
' 4) The author of this code may have re
'     tained certain additional copyright righ
'     ts.If so, this is indicated in the autho
'     r's description.
'**************************************

Option Explicit


Public Function sCompress(sCompData As String) As String

    Dim lDataCount As Long
    Dim lBufferStart As Long
    Dim lMaxBufferSize As Long
    Dim sBuffer As String
    Dim lBufferOffset As Long
    Dim lBufferSize As Long
    Dim sDataControl As String
    Dim bDataControlChar As Byte
    Dim lControlCount As Long
    Dim bControlPos As Byte
    Dim bCompLen As Long
    Dim lCompPos As Long
    Dim bMaxCompLen As Long
    
    lMaxBufferSize = 65535
    bMaxCompLen = 255
    lBufferStart = 0
    sDataControl = ""
    bDataControlChar = 0
    bControlPos = 0
    lControlCount = 0


    If Len(sCompData) > 4 Then
        sCompress = Left(sCompData, 4)


        For lDataCount = 5 To Len(sCompData)


            If lDataCount > lMaxBufferSize Then
                lBufferSize = lMaxBufferSize
                lBufferStart = lDataCount - lMaxBufferSize
            Else
                lBufferSize = lDataCount - 1
                lBufferStart = 1
            End If

            sBuffer = Mid(sCompData, lBufferStart, lBufferSize)
            If Len(sCompData) - lDataCount < bMaxCompLen Then bMaxCompLen = Len(sCompData) - lDataCount
            lCompPos = 0


            For bCompLen = 3 To bMaxCompLen Step 3


                If bCompLen > bMaxCompLen Then
                    bCompLen = bMaxCompLen
                End If

                lCompPos = InStr(1, sBuffer, Mid(sCompData, lDataCount, bCompLen), 0)


                If lCompPos = 0 Then


                    If bCompLen > 3 Then


                        While lCompPos = 0
                            lCompPos = InStr(1, sBuffer, Mid(sCompData, lDataCount, bCompLen - 1), 0)
                            If lCompPos = 0 Then bCompLen = bCompLen - 1
                        Wend

                    End If

                    bCompLen = bCompLen - 1
                    Exit For
                End If

            Next



            If bCompLen > bMaxCompLen And lCompPos > 0 Then
                bCompLen = bMaxCompLen
                lCompPos = InStr(1, sBuffer, Mid(sCompData, lDataCount, bCompLen), 0)
            End If



            If lCompPos > 0 Then
                lBufferOffset = lBufferSize - lCompPos + 1
                sCompress = sCompress & Chr((lBufferOffset And &HFF00) / &H100) & Chr(lBufferOffset And &HFF) & Chr(bCompLen)
                lDataCount = lDataCount + bCompLen - 1
                bDataControlChar = bDataControlChar + 2 ^ bControlPos
            Else
                sCompress = sCompress & Mid(sCompData, lDataCount, 1)
            End If

            bControlPos = bControlPos + 1


            If bControlPos = 8 Then
                sDataControl = sDataControl & Chr(bDataControlChar)
                bDataControlChar = 0
                bControlPos = 0
            End If

            lControlCount = lControlCount + 1
        Next

        If bControlPos <> 0 Then sDataControl = sDataControl & Chr(bDataControlChar)
        sCompress = Chr((lControlCount And &H8F000000) / &H1000000) & Chr((lControlCount And &HFF0000) / &H10000) & Chr((lControlCount And &HFF00) / &H100) & Chr(lControlCount And &HFF) & Chr((Len(sDataControl) And &H8F000000) / &H1000000) & Chr((Len(sDataControl) And &HFF0000) / &H10000) & Chr((Len(sDataControl) And &HFF00) / &H100) & Chr(Len(sDataControl) And &HFF) & sDataControl & sCompress
    Else
        sCompress = sCompData
    End If

End Function



Public Function sDecompress(sDecompData As String) As String

    Dim lControlCount As Long
    Dim lControlPos As Long
    Dim bControlBitPos As Byte
    Dim lDataCount As Long
    Dim lDataPos As Long
    Dim lDecompStart As Long
    Dim lDecompLen As Long
    


    If Len(sDecompData) > 4 Then
        lControlCount = Asc(Left(sDecompData, 1)) * &H1000000 + Asc(Mid(sDecompData, 2, 1)) * &H10000 + Asc(Mid(sDecompData, 3, 1)) * &H100 + Asc(Mid(sDecompData, 4, 1))
        lDataCount = Asc(Mid(sDecompData, 5, 1)) * &H1000000 + Asc(Mid(sDecompData, 6, 1)) * &H10000 + Asc(Mid(sDecompData, 7, 1)) * &H100 + Asc(Mid(sDecompData, 8, 1)) + 9
        sDecompress = Mid(sDecompData, lDataCount, 4)
        lDataCount = lDataCount + 4
        bControlBitPos = 0
        lControlPos = 9


        For lDataPos = 1 To lControlCount


            If 2 ^ bControlBitPos = (Asc(Mid(sDecompData, lControlPos, 1)) And 2 ^ bControlBitPos) Then
                lDecompStart = Len(sDecompress) - (CLng(Asc(Mid(sDecompData, lDataCount, 1))) * &H100 + CLng(Asc(Mid(sDecompData, lDataCount + 1, 1)))) + 1
                lDecompLen = Asc(Mid(sDecompData, lDataCount + 2, 1))
                sDecompress = sDecompress & Mid(sDecompress, lDecompStart, lDecompLen)
                lDataCount = lDataCount + 3
            Else
                sDecompress = sDecompress & Mid(sDecompData, lDataCount, 1)
                lDataCount = lDataCount + 1
            End If

            bControlBitPos = bControlBitPos + 1


            If bControlBitPos = 8 Then
                bControlBitPos = 0
                lControlPos = lControlPos + 1
            End If

        Next

    Else
        sDecompress = sDecompData
    End If

End Function

'Put a two command buttons (Command1 and
'     Command2) on to a form and paste the fol
'     lowing on to it as well:
Option Explicit
Private Const sFileName = "c:\compressthis.exe" ' the file To be compressed


Private Sub Command1_Click() 'Compress the file

    Dim sReturn As String
    Dim sFileData As String
    
    Open sFileName For Binary As #1
    sFileData = Input(LOF(1), #1)
    Close #1
    sReturn = sCompress(sFileData)
    Debug.Print Len(sReturn), Len(sFileData)
    
    Open Left(sFileName, Len(sFileName) - 3) & "wnc" For Output As #1
    Print #1, sReturn;
    Close #1
End Sub



Private Sub Command2_Click() 'Decompress the file

    Dim sReturn As String
    Dim sFileData As String
    
    Open Left(sFileName, Len(sFileName) - 4) & ".wnc" For Binary As #1
    sFileData = Input(LOF(1), #1)
    sReturn = sDecompress(sFileData)
    Close #1
    Debug.Print Len(sReturn), Len(sFileData)
    
    Open Left(sFileName, Len(sFileName) - 4) & "2" & Right(sFileName, 4) For Output As #1
    Print #1, sReturn;
    Close #1
End Sub


Other 1 submission(s) by this author

 

 
Report Bad Submission
Use this form to notify us if this entry should be deleted (i.e contains no code, is a virus, etc.).
Reason:
 
Your Vote!

What do you think of this code(in the Not Given category)?
(The codewith your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor See Voting Log
 
Other User Comments
5/20/1999 12:54:00 PM: Matt Walshkin
Very...very..very good 
coding!
wondering if you could send me 

a form, based upon this, to give
me 
a better idea and example
on how to 
use this 
decompression/compression 
source.
-Matt W.
Keep the Planet clean! If this comment was disrespectful, please click here.

 
5/20/1999 2:02:00 PM: Johnny
Yeah, I like it also, can ya send me a 
demo form also?

Thnx
Keep the Planet clean! If this comment was disrespectful, please click here.

 
5/21/1999 2:56:00 AM: Leigh
A most impressive bit of coding - Tight 
and pretty fast.
Keep the Planet clean! If this comment was disrespectful, please click here.

 
5/21/1999 5:46:00 AM: Ross
Could you also send me a form with it?
Keep the Planet clean! If this comment was disrespectful, please click here.

 
5/21/1999 4:08:00 PM: Lance

I just have a few comments on this 
code.. First of all, This is a nice 
peice of code here.. But , I have tried 
to compress a file that is 145k on 2 
different computers, 1 p2 233 with 128 
mgs of ram, and No Luck, the program 
locks up and quits responging (I even 
let it sit for 15 minutes). and a p2 
450 with 128 mg o ram.. and the same 
thing happend... :c( But this code does 
work good on small file's.. (20k or 
so)... 
Keep the Planet clean! If this comment was disrespectful, please click here.

 
5/25/1999 10:52:00 AM: Leigh
It will compress your file - 
eventually.
It appears to be haging 
'cause there are no DoEvents in the 
source - Chuck one in at the bottom of 
the main loop to stop that.

I've 
written a small app using the LZSS 
module and it updates a progress bar as 
it compresses. It is *very* slow but 
the author only really intended it for 
strings/small files.
Keep the Planet clean! If this comment was disrespectful, please click here.

 
5/26/1999 12:56:00 AM: Jesper Soderberg
Hi there

I can see, that there are a 
few comments to my code regarding the 
speed of this code. The main drawback 
of this implementation (as I see it) is 
the VB InStr function. It becomes very 
slow when the searchbuffer increases in 
size. The code above uses the maximum 
bufersize(65335 bytes). If this value 
is decreased the operation should be 
faster, but the output might be larger 
because of the smaller buffer.
Keep the Planet clean! If this comment was disrespectful, please click here.

 
5/30/1999 5:52:00 PM: Yura Korneev
Good source. Continue your researching 
in *codec* area. I hope all know what 
*codec* mean (coder/decoder)
Keep the Planet clean! If this comment was disrespectful, please click here.

 
6/8/1999 7:42:00 AM: Ong
Actually i'm looking for a compression 
tool which can compress and decompress 
data in wavefile format. what changes 
shall i make in order to let it work 
properly??
Keep the Planet clean! If this comment was disrespectful, please click here.

 
6/27/1999 7:52:00 PM: Kenneth
A very nice piece of code you have 
written there.
Do you have any source 
code that can compress/decompress 
larger files
like wavefile format? 
About(3-4Megs)
Keep the Planet clean! If this comment was disrespectful, please click here.

 
10/8/1999 11:54:00 PM: wiz
sub nCompress(lbl as label)
open 
"c:\program.exe" for binary as #1
open 
"c:\program.xyz" for binary access 
write as #2

For i = 1 to Lof(1) step 
1
 Get #1, i, fileText
 thePreData = 
sCompress(fileText)
 Put #2, i, 
thePreData
 lbl.caption = (i / lof(1)) 
* 100
next i

close #1
close #2
Keep the Planet clean! If this comment was disrespectful, please click here.

 
1/29/2000 8:05:27 AM: Joris Davidson
Verry verry nice code!!!!
Keep the Planet clean! If this comment was disrespectful, please click here.

 
Add Your Feedback!
Note:Not only will your feedback be posted, but an email will be sent to the code's author.

NOTICE: The author of this code has been kind enough to share it with you.  If you have a criticism, please state it politely or it will be deleted.

For feedback not related to this particular code, please click here.
 
Name:
Comment:

 
 
   
 
 

About the Site  |  Feedback  |  Link to the Site  |  Awards  |  Advertising

Copyright© 1997 by Exhedra Solutions, Inc. All Rights Reserved.   By using this site you agree to its Terms and Conditions.   Planet Source Code (tm) and the phrase "Dream It. Code It" (tm) are trademarks of Exhedra Solutions, Inc.