Link to home
Start Free TrialLog in
Avatar of phuzzy
phuzzy

asked on

Compression Code Adpat

I have VB code that performs a compression routine on a string but i was wondering how it could be adapted to take a file name in from, say, a textbox and compress the file creating another file in the process?

CODE FOLLOWS

==========================

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 = "dhfjkdshfhsdk"
    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





Avatar of Erick37
Erick37
Flag of United States of America image

You could use a 3rd Party OCX to do this such as ActiveZipper:

http://www.iessoft.com/scripts/interfac.asp
ASKER CERTIFIED SOLUTION
Avatar of Vbmaster
Vbmaster

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial