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


  Verio Hosting  


   

   
Visual Basic Stats

Code: 585,335 lines
Users: 300 online
 
Search for: 
in language:
 
 
Sponsored by:
  Help Maker Plus: Windows Help Authoring Tool  
 

  Click Here For More Info!  


   

LZW (Lempel, Ziv, Welch) Dictionary Compression\

VB icon
Submitted on: 10/22/1998
By: Asgeir Bjarni Ingvarsson
Level: Not Given
User Rating: By 36 Users
Compatibility:VB 5.0/6.0, VB 4.0/32, VB 4.0/16, VB 3.0

Users have accessed this code 3961 times.
 
 
     The Lempel, Ziv, Welch compression algorithm is considered the most efficcient all purpose compression algorithm there is.
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!

						
'**************************************
' Name: LZW (Lempel, Ziv, Welch) Diction
'     ary Compression
' Description:The Lempel, Ziv, Welch com
'     pression algorithm is considered the mos
'     t efficcient all purpose compression alg
'     orithm there is.
' By: Asgeir Bjarni Ingvarsson
'
'
' Inputs:None
'
' Returns:None
'
'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.
'**************************************

' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'     -=-=-=-=-=-=-=-
'| LZW - Compression/Uncompression|
'|-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'     -=-=-=-=-=-=-=-|
'|Author: Asgeir B. Ingvarsson |
'| |
'|E-Mail: abi@islandia.is |
'| |
'|Address: Hringbraut 119 |
'| IS-107, Reykjavik|
'| ICELAND |
'|-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'     -=-=-=-=-=-=-=-|
'|For any comments or questions, please 
'     contact me |
'|using either of the above measures. |
'|-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'     -=-=-=-=-=-=-=-|
'|This code has one flaw, it can't proce
'     ss characters |
'|higher than 127. |
'|For the code that can compress all 256
'     ascii chars. |
'|please e-mail me.|
'|If you use this code or modify it, I w
'     ould appreciate|
'|it if you would mention my name somewh
'     ere and send me|
'|a copy of the code (if it has been mod
'     ified).|
'|-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'     -=-=-=-=-=-=-=-|
'|LZW is property of Unisys and is free 


'     for|
    '|noncommercial software. |
    ' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
    '     -=-=-=-=-=-=-=-
    Private Dict(0 To 255) As String
    Private Count As Integer


Private Sub Init()



    For i = 0 To 127
        Dict(i) = Chr(i)
    Next

End Sub



Private Function Search(inp As String) As Integer



    For i = 0 To 255
        If Dict(i) = inp Then Search = i: Exit Function
    Next

    Search = 256
End Function



Private Sub Add(inp As String)

    If Count = 256 Then Wipe
    Dict(Count) = inp
    Count = Count + 1
End Sub



Private Sub Wipe()



    For i = 128 To 255
        Dict(i) = ""
    Next

    Count = 128
End Sub



Public Function Deflate(inp As String) As String

    'Begin Error Checking
    If Len(inp) = 0 Then Exit Function


    For i = 1 To Len(inp)
        If Asc(Mid(inp, i, 1)) > 127 Then MsgBox "Illegal Character Value", vbCritical, "Error:": Exit Function
    Next

    'End Error Checking
    Init
    Wipe
    p = ""
    i = 1


    Do Until i > Len(inp)
        c = Mid(inp, i, 1)
        i = i + 1
        temp = p & c


        If Not Search(CStr(temp)) = 256 Then
            p = temp
        Else
            o = o & Chr(Search(CStr(p)))
            Add CStr(temp)
            p = c
        End If

    Loop

    o = o & Chr(Search(CStr(p)))
    Deflate = o
End Function



Public Function Inflate(inp As String) As String

    If Len(inp) = 0 Then Exit Function
    Init
    Wipe
    cW = Asc(Mid(inp, 1, 1))
    o = Dict(cW)
    i = 2


    Do Until i > Len(inp)
        pW = cW
        cW = Asc(Mid(inp, i, 1))
        i = i + 1


        If Not Dict(cW) = "" Then
            o = o & Dict(cW)
            p = Dict(pW)
            c = Mid(Dict(cW), 1, 1)
            Add (CStr(p) & CStr(c))
        ElseIf Dict(cW) = "" Then
            p = Dict(pW)
            c = Mid(Dict(pW), 1, 1)
            o = o & p & c
            Add (CStr(p) & CStr(c))
        End If

    Loop

    Inflate = o
End Function



Public Sub main()

    inp = "Hello World, Hello World"
    d = Deflate(CStr(inp)) 'Compress
    q = Inflate(CStr(d)) 'Uncompress
    MsgBox "Uncompressed: " & q & vbCrLf & vbCrLf & _
    "Compressed: " & d & vbCrLf & vbCrLf & _
    "Compressed Size: " & Len(d) & vbCrLf & vbCrLf & _
    "Uncompressed Size: " & Len(q) & vbCrLf & vbCrLf & _
    "Compression Ratio: " & (100 - (((Len(d) / Len(q)) * 100) \ 1)) & "%", vbOKOnly, "Results:"
End Sub


Other 4 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
6/24/1999 2:20:00 AM: ?
it would be nice if you had declerd 
some
Variables in here :)
Keep the Planet clean! If this comment was disrespectful, please click here.

 
7/8/1999 9:04:00 PM: anti
...I don't know what to say. this is an 
excellent work of art, vardecs or not.  
i love it, great job
Keep the Planet clean! If this comment was disrespectful, please click here.

 
10/31/1999 11:22:00 AM: Phuzzy
How would i adapt this to take in files 
and compress them?

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

 
11/18/1999 10:33:00 PM: Jake
One Word: THANX!!!!!!
Keep the Planet clean! If this comment was disrespectful, please click here.

 
12/7/1999 6:37:00 PM: Tanner (Genesis Entertainment L.C.)
Excellent!!
Keep the Planet clean! If this comment was disrespectful, please click here.

 
12/7/1999 8:13:00 PM: Tanner (Genesis Entertainment L.C.)
Quoting from the Unisys 
website:

"Unisys has frequently been 
asked whether a Unisys license is 
required in order to use LZW software 
obtained by downloading from the 
Internet or from other sources. The 
answer is simple. In all cases, a 
written license agreement or statement 
signed by an authorized Unisys 
representative is required from Unisys 
for all use, sale or distribution of 
any software (including so-called 
"freeware") and/or hardware providing 
LZW conversion capability (for example, 
downloaded software used for 
creating/displaying GIF images). In 
certain cases, no license fees may be 
required, but this needs to be 
evidenced by a written agreement or 
written statement signed by an 
authorized Unisys 
representative."

Just thought you 
might want to know...
Keep the Planet clean! If this comment was disrespectful, please click here.

 
2/20/2000 1:33:09 AM: Actually
You are permitted to use the code with 
no credit to Unisys provided that it is 
not their source code. Unless it is 
patented in which case some 
acknowledgement may be necessary
Keep the Planet clean! If this comment was disrespectful, please click here.

 
5/4/2000 5:00:07 PM: vbMen
It does not compress very much...
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.