Solved

UUencode UUDecode

Posted on 2000-04-03
9
682 Views
Last Modified: 2008-02-20
When you want to email a binary file without sending it as an attatchment UUencode translates non-printable characters into printable characters so that email programs can handle them to be sent.  It does this by taking 3 chars 8 bit each total 24 bits and stretching them out to 4 chars 6 bits each total 24 bits. 6 bits for each character means a total of 64 possible characters all of which can be used from the printable character set.  Does this sound familiar to anyone?  Does anyone have an algorithm for this?

Also any procedures for getting/setting specific bits in a byte, integer, word or bit array would be helpfull.
0
Comment
Question by:Jsan
  • 3
  • 3
  • 2
  • +1
9 Comments
 
LVL 32

Expert Comment

by:bhess1
Comment Utility
Try this ActiveX control

http://www.coolstf.com/activex.html

and select the UUencode/uudecode control for download.  You'll have to register, but the control is free.

Also, check out:

http://www.vbip.com/winsock/winsock_uucode_01.asp

This is a tutorial on UUEncode/Decode with VB code examples
0
 
LVL 1

Expert Comment

by:plasmatek
Comment Utility
Public Function UUDecode(ByVal B64String) As String

    Dim TableByte(255) As Integer
    Dim SexTet(4) As Integer
    Dim SexTetNUM As Integer
    Dim n As Integer
    Dim i As Integer
    Dim T1 As Integer
    Dim T2 As Integer
    Dim NumBits As Integer
    Dim OutStream As String
    Dim CharTable As String * 64
    Dim LiStream As Long
    Dim InStreamIndex As Long
    Dim c As Long
    CharTable = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

    For n = 0 To 255
        TableByte(n) = -1
    Next


    For n = 0 To 63
        i = Asc(Mid(CharTable, n + 1, 1))
        TableByte(i) = n
    Next

    InStreamIndex = 1
    LiStream = Len(B64String)
    OutStream = Space(Int(72 * Int(LiStream / 74) * 3 / 4) + Int((LiStream Mod 74) * 3 / 4))

    While InStreamIndex <= LiStream
        SexTetNUM = 1
        NumBits = 0

        While (SexTetNUM <= 4 And InStreamIndex <= LiStream)
            i = Asc(Mid(B64String, InStreamIndex, 1))
            InStreamIndex = InStreamIndex + 1
            T1 = TableByte(i)

            If T1 >= 0 Then
                SexTet(SexTetNUM) = T1
                NumBits = NumBits + 6
                SexTetNUM = SexTetNUM + 1
            End If

        Wend


        If NumBits >= 8 Then
            T1 = SexTet(1)
            T2 = SexTet(2)
            c = c + 1
            Mid(OutStream, c, 1) = Chr((4 * T1) + (T2 \ 16))
            NumBits = NumBits - 8
        End If


        If NumBits >= 8 Then
            T1 = SexTet(3)
            c = c + 1
            Mid(OutStream, c, 1) = Chr(16 * (T2 Mod 16) + (T1 \ 4))
            NumBits = NumBits - 8
        End If


        If NumBits >= 8 Then
            T2 = SexTet(4)
            c = c + 1
            Mid(OutStream, c, 1) = Chr(64 * (T1 Mod 4) + T2)
        End If

    Wend

    UUDecode = Left(OutStream, c)
End Function

Public Function UUEncode(ByVal text) As String

    Dim a1 As Integer
    Dim a2 As Integer
    Dim a3 As Integer
    Dim LineChars As Integer
    Dim OutStream As String
    Dim CharTable As String
    Dim i As Long
    Dim c As Long
    CharTable = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    c = 1
    i = Int(4 * Len(text) / 3)
    OutStream = Space(i + 2 * (i \ 72 + 1))
    LineChars = 0

    For i = 1 To Len(text) - 2 Step 3
        '      'Get 24 bits
        a1 = Asc(Mid(text, i, 1))
        a2 = Asc(Mid(text, i + 1, 1))
        a3 = Asc(Mid(text, i + 2, 1))

        '      'Encode each 6 bits
        Mid(OutStream, c, 4) = Mid(CharTable, (a1 And &HFC) \ 4 + 1, 1) _
                & Mid(CharTable, (16 * (a1 And &H3) + (a2 And &HF0) \ 16) + 1, 1) _
                & Mid(CharTable, (4 * (a2 And &HF) + (a3 And &HC0) \ 64) + 1, 1) _
                & Mid(CharTable, (a3 And &H3F) + 1, 1)
        c = c + 4

        '      'Break line
        LineChars = LineChars + 4

        If LineChars >= 72 Then
            LineChars = 0
            Mid(OutStream, c, 2) = vbCrLf
            c = c + 2
        End If

    Next

    '     'Add last 24 bits
    Select Case Len(text) Mod 3
        Case 1
            a1 = Asc(Mid(text, i, 1))
            a2 = 0
            a3 = 0
            Mid(OutStream, c, 4) = Mid(CharTable, (a1 And &HFC) \ 4 + 1, 1) _
                    & Mid(CharTable, (16 * (a1 And &H3) + (a2 And &HF0) \ 16) + 1, 1) _
                    & "==" & vbCrLf
            c = c + 6
        Case 2
            a1 = Asc(Mid(text, i, 1))
            a2 = Asc(Mid(text, i + 1, 1))
            a3 = 0
            Mid(OutStream, c, 4) = Mid(CharTable, (a1 And &HFC) \ 4 + 1, 1) _
                    & Mid(CharTable, (16 * (a1 And &H3) + (a2 And &HF0) \ 16) + 1, 1) _
                    & Mid(CharTable, (4 * (a2 And &HF) + (a3 And &HC0) \ 64) + 1, 1) _
                    & "=" & vbCrLf
            c = c + 6
    End Select

    UUEncode = Left(OutStream, c - 1)
End Function

there we go :)
0
 
LVL 32

Expert Comment

by:bhess1
Comment Utility
Whoops - that's base64 Encoding, not uuEncoding in the above example.  uuEncoding starts at Space and goes to underscore (ascii 32 to ascii 95), with space normally replaced by ascii 96 (` - a grave accent).

uuEncode does not use lower case letters.
0
 
LVL 1

Author Comment

by:Jsan
Comment Utility
Yes I would rather uuEncoding.  The reason being that I ran plasmatek's but the over head for converting a string was 73%  normal uencoding would have an overhead closer to 25%.

I looked at the example bhess1 gave me but the code doesn't run.  It blows up on the uuDecode function.

plasmatek's could you provide a normal uuEncoding example please?  Or someone point me to a sample UU Encode/Decode code set that works.


Jsan
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 32

Expert Comment

by:bhess1
Comment Utility
What version of VB are you using?

Where did it blow up in the decode?
0
 
LVL 1

Author Comment

by:Jsan
Comment Utility
Yes I would rather uuEncoding.  The reason being that I ran plasmatek's but the over head for converting a string was 73%  normal uencoding would have an overhead closer to 25%.

I looked at the example bhess1 gave me but the code doesn't run.  It blows up on the uuDecode function.

plasmatek's could you provide a normal uuEncoding example please?  Or someone point me to a sample UU Encode/Decode code set that works.


Jsan
0
 
LVL 1

Author Comment

by:Jsan
Comment Utility
Im using VB 6.  Were you able to run the code successfully?  I tried to UU encode and then decode a small 9k gif file.
0
 
LVL 14

Accepted Solution

by:
mcrider earned 50 total points
Comment Utility
Here you go...  Add the following code to a module... Then to encode a file, do this:

   if uuEncodeFile("c:\windows\desktop\oicicles.jpg","c:\windows\desktop\myuu.uue") = true then
      msgbox "OK"
   else
      msgbox "FAILED"
   end if

And to decode a file, do this:

   if uuDecodeFile("c:\windows\desktop\myuu.uue","c:\windows\desktop\icicles.jpg")= true then
      msgbox "OK"
   else
      msgbox "FAILED"
   end if



Cheers!


THE CODE:


    Function uuDecode(sBuffer As String) As String
        Dim iLoop As Long
        Dim sOutBuffer As String
        Dim iVal As Integer
         
        'FIND ANY HIGH SPACES AND REPLACE THEM
        iVal = 1
        Do
            iVal = InStr(iVal, sBuffer, Chr$(96))
            If iVal = 0 Then Exit Do
            Mid$(sBuffer, iVal, 1) = " "
        Loop
        'DO THE DECODE
        For iLoop = 1 To Len(sBuffer) Step 4
            sOutBuffer = sOutBuffer + _
                Chr$((Asc(Mid$(sBuffer, iLoop, 1)) - 32) * 4 + _
                (Asc(Mid$(sBuffer, iLoop + 1, 1)) - 32) \ 16)
            sOutBuffer = sOutBuffer + _
                Chr$((Asc(Mid$(sBuffer, iLoop + 1, 1)) Mod 16) * 16 + _
                (Asc(Mid$(sBuffer, iLoop + 2, 1)) - 32) \ 4)
            sOutBuffer = sOutBuffer + _
                Chr$((Asc(Mid$(sBuffer, iLoop + 2, 1)) Mod 4) * 64 + _
                Asc(Mid$(sBuffer, iLoop + 3, 1)) - 32)
        Next iLoop
        uuDecode = sOutBuffer
    End Function
    Function uuEncode(sBuffer As String) As String
        Dim iLoop As Long
        Dim sOutBuffer As String
        Dim sOutChar As String
         
        'PAD BUFFER TO MULTIPLE OF 3
        If Len(sBuffer) Mod 3 <> 0 Then sBuffer = sBuffer + _
            Space$(3 - Len(sBuffer) Mod 3)
         
        'ENCODE BUFFER REPLACING ENCODED SPACES WITH HIGH SPACES
        For iLoop = 1 To Len(sBuffer) Step 3
            '1ST UUCHAR
            sOutChar = Chr$(Asc(Mid$(sBuffer, iLoop, 1)) \ 4 + 32)
            If sOutChar = " " Then
                sOutBuffer = sOutBuffer + Chr$(96)
            Else
                sOutBuffer = sOutBuffer + sOutChar
            End If
            '2ND UUCHAR
            sOutChar = Chr$((Asc(Mid$(sBuffer, iLoop, 1)) Mod 4) * 16 + _
                Asc(Mid$(sBuffer, iLoop + 1, 1)) \ 16 + 32)
            If sOutChar = " " Then
                sOutBuffer = sOutBuffer + Chr$(96)
            Else
                sOutBuffer = sOutBuffer + sOutChar
            End If
            '3RD UUCHAR
            sOutChar = Chr$((Asc(Mid$(sBuffer, iLoop + 1, 1)) Mod 16) * 4 + _
                Asc(Mid$(sBuffer, iLoop + 2, 1)) \ 64 + 32)
            If sOutChar = " " Then
                sOutBuffer = sOutBuffer + Chr$(96)
            Else
                sOutBuffer = sOutBuffer + sOutChar
            End If
            '4TH UUCHAR
            sOutChar = Chr$(Asc(Mid$(sBuffer, iLoop + 2, 1)) Mod 64 + 32)
            If sOutChar = " " Then
                sOutBuffer = sOutBuffer + Chr$(96)
            Else
                sOutBuffer = sOutBuffer + sOutChar
            End If
        Next iLoop
        uuEncode = sOutBuffer
    End Function
    Function uuDecodeFile(sInFile As String, sOutFile As String) As Boolean
        Dim iInput As Long
        Dim iOutput As Long
        Dim iFoundHeader As Boolean
        Dim sInput As String
        Dim sOutput As String
        Dim lChar As Byte
         
        On Error Resume Next
        uuDecodeFile = False
        'DOES THE INPUT FILE EXIST?
        If Dir$(sInFile) = "" Then Exit Function
        iInput = FreeFile
        Open sInFile For Binary Access Read As #iInput
        If Err Then Exit Function
         
        'ERASE THE OUTPUT FILE IF IT EXISTS
        Kill sOutFile
        Err = 0
        iOutput = FreeFile
        Open sOutFile For Binary As #iOutput
        If Err Then Exit Function
         
        'FIND THE UUBEGIN HEADER
        iFoundHeader = False
        Do Until EOF(iInput)
            sInput = ""
            Do
                If EOF(iInput) Then Exit Do
                Get #iInput, , lChar
                Select Case lChar
                    Case 13
                    Case 10
                        Exit Do
                    Case Else
                        sInput = sInput + Chr$(lChar)
                End Select
            Loop
            If Left$(UCase$(Trim$(sInput)), 5) = "BEGIN" Then
                iFoundHeader = True
                Exit Do
            End If
        Loop
         
        If iFoundHeader = True Then
            'DECODE THE FILE
            Do Until EOF(iInput)
                sInput = ""
                Do
                    If EOF(iInput) Then Exit Do
                    Get #iInput, , lChar
                    Select Case lChar
                        Case 13
                        Case 10
                            Exit Do
                        Case Else
                            sInput = sInput + Chr$(lChar)
                    End Select
                Loop
                If UCase$(Trim$(sInput)) = "END" Then
                   Exit Do
                End If
                If Trim$(sInput) <> "" Then
                   sOutput = Left$(uuDecode(Mid$(sInput, 2, Len(sInput) - 1)), Asc(Left$(sInput, 1)) - 32)
                   Put #iOutput, , sOutput
                End If
            Loop
            uuDecodeFile = True
        End If
         
        'WE'RE DONE!
        Close iInput
        Close iOutput
    End Function
    Function uuEncodeFile(sInFile As String, sOutFile As String) As Boolean
        Dim iLoop As Long
        Dim iInput As Long
        Dim iOutput As Long
        Dim iFullLines As Long
        Dim sInput As String
        Dim sOutput As String
        Dim sFileName As String
         
        On Error Resume Next
        uuEncodeFile = False
         
        'DOES THE INPUT FILE EXIST?
        If (Dir$(sInFile) = "") Then Exit Function
        Kill sOutFile
        Err = 0
        iInput = FreeFile
        Open sInFile For Binary As #iInput
        If Err Then Exit Function
        'OPEN THE OUTPUT FILE
        iOutput = FreeFile
        Open sOutFile For Output As #iOutput
        If Err Then
            Close iInput
            Exit Function
        End If
         
        'PUT TOGETHER THE UUHEADER
        sFileName = sInFile
        For iLoop = Len(sInFile) - 1 To 1 Step -1
            If Mid$(sInFile, iLoop, 1) = "\" Then
                sFileName = Mid$(sInFile, iLoop + 1)
                Exit For
            End If
        Next iLoop
        Print #iOutput, "begin 644 " + sFileName + Chr$(10);
         
        'DETERMINE NUMBER OF LINES... EACH 45 BYTES GET EXPANDED TO 60 BYTES
        'WRITE ALL LINES UP TO LAST FULL BLOCK
        iFullLines = LOF(iInput) \ 45
        sInput = Space$(45)
        For iLoop = 1 To iFullLines
            Get #iInput, , sInput
            Print #iOutput, "M" + uuEncode(sInput) + Chr$(10);
        Next iLoop
         
        'WRITE THE LAST BLOCK
        sInput = Space$(LOF(iInput) - Seek(iInput) + 1)
        Get iInput, , sInput
        Print #iOutput, Chr$(Len(sInput) + 32) + uuEncode(sInput) + Chr$(10);
        Print #iOutput, Chr$(96) + Chr$(10) + "end" + Chr$(10);
         
        'WE'RE DONE!
        Close #iInput
        Close #iOutput
        uuEncodeFile = True
    End Function
     
     
     


0
 
LVL 14

Expert Comment

by:mcrider
Comment Utility
Thanks for the points! Glad I could help!


Cheers!®©
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

728 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now