• Status: Solved
• Priority: Medium
• Security: Public
• Views: 462
• Last Modified:

# VB Source for BASE64 function?

Can anybody post the Visual Basic source code for a function that inputs a string and returns the string in BASE64?
0
alweiner
Asked:
1 Solution

Commented:
0

Author Commented:
All the comments appear to be in Japanese (there's much more there than just the Base64 routine)

Anybody have something in English? (Sorry, I should have been more specific in my request :)
0

progCommented:
Here's two function you could add to your project either as a bas module or put the functions in your form.  Not

Public Function BASE64(sNumber As String)

Dim lNumber As Long

Dim iRem As Integer

lNumber = Val(sNumber)

While lNumber <> 0

iRem = lNumber Mod 64
lNumber = lNumber \ 64

BASE64 = pad(iRem) & IIf(BASE64 <> "", " ", "") & BASE64

Wend

If BASE64 = "" Then BASE64 = "00"

End Function

Private Function pad(iNum As Integer)

pad = CStr(iNum)
If Len(pad) < 2 Then
pad = "0" & pad
End If

End Function

0

progCommented:

Public Function BASE64(sNumber As String)

Dim lNumber As Long

Dim iRem As Integer

lNumber = Val(sNumber)

While lNumber <> 0

iRem = lNumber Mod 64
lNumber = lNumber \ 64

BASE64 = pad(iRem) & IIf(BASE64 <> "", " ", "") & BASE64

Wend

If BASE64 = "" Then BASE64 = "00"

End Function

Private Function pad(iNum As Integer)

pad = CStr(iNum)
If Len(pad) < 2 Then
pad = "0" & pad
End If

End Function
0

progCommented:
Hope thats what you mean by base 64 by the way I'm assuming you want number base 64 i.e 65 would be 01 01, 66 = 01 02 etc...
0

Author Commented:
Thanks, but that only returns the base64 value if the string input is a number in string form.  I need a generic base64 function that works for any string.
0

progCommented:
Could you be more specific, what would you want the function to dow with the string "AD" for example?

Could you explain what you mean by base64?
0

Author Commented:
Base64 is a standard encoding technique -- usually used for password transmission.
0

progCommented:
Private Function base64a(sString As String)

Dim c As Long
Dim iLeft As Integer, iRight As Integer

For c = 1 To Len(sString)

ival = Asc(Mid(sString, c, 1))

iLeft = ival \ 64
iRight = ival Mod 64

base64a = base64a + IIf(base64a <> "", " ", "") + CStr(iLeft) + CStr(iRight)

Next

End Function
0

Author Commented:
Pls don't just guess if you don't know.  Does anybody understand BASE64 and have VB source code to do it?
0

Commented:
BASE64 is part of MIME encoding. It converts three binary bytes into four printable ASCII characters and back again.

I have versions in both compiled QBASIC and VB5. Too big to send here.

Email me at mark_lambert@ntsc.navy.mil and I'll forward the code. In the meantime the MIME decoder is posted on my web site: www.hostpc.net/madmark.

M

0

Author Commented:
I just emailed you - thanx...
0

progCommented:
This isn't a guess so Ill send it to you.

encode64 and decode64 are my functions designed to use the Japanese version as specified

Public Function encode64(sX As String) As String

'Encode to a string from a string

Dim x() As Byte
Dim iLen As Long, c As Long
Dim sString As String

iLen = Len(sX)
ReDim x(iLen - 1)

For c = 0 To iLen - 1

x(c) = Asc(Mid(sX, c + 1, 1))

Next

Call base64encode(x, iLen, sString)

encode64 = sString

End Function

Public Function decode64(x As String) As String

'decode from a string to  a string

Dim n() As Byte
Dim ni As Long
Dim sString As String

ReDim n(Len(x) + 1)

ni = Len(x)

Call base64decode(x, n(), ni)

For c = 1 To ni

decode64 = decode64 + Chr(n(c - 1))

Next

End Function

Private Function BinToB64(B1 As Byte) As String
'----------------------------------------------------------------
'
'    in B1  : Base64 Binary (0-63)
'    return : Base64 Ascii Code
'----------------------------------------------------------------
Dim A1 As String

If B1 <= 25 Then A1 = Chr(Asc("A") + B1)
If B1 > 25 And B1 <= 51 Then A1 = Chr(Asc("a") + B1 - 26)
If B1 > 51 And B1 <= 61 Then A1 = Chr(Asc("0") + B1 - 52)
If B1 = 62 Then A1 = "+"
If B1 = 63 Then A1 = "/"

BinToB64 = A1
'Debug.Print B1; A1
End Function

Private Sub base64decode(B64str As String, Bstr() As Byte, BCnt As Long)
'----------------------------------------------------------------
' BASE64 DECODER [1996/04/27]
'    6bit ASCII -> 8bit Binary
'      in  B64str : Base64 ASCII Code Data
'      out Bstr   : 8bit Binary Data
'      out BCnt   : Bstr Data Length
'----------------------------------------------------------------

Dim Bmode As Integer
Dim ACnt As Long
Dim B1 As Byte
Dim RetVal As Integer

ACnt = 0
BCnt = 0
Bmode = 0

Do Until (Mid\$(B64str, ACnt + 1, 1) = "=" Or Len(B64str) <= ACnt)
If Fix(ACnt Mod 100) = 0 Then RetVal = DoEvents()
B1 = B64ToBin(Mid\$(B64str, ACnt + 1, 1))
If B1 >= 0 And B1 <= 63 Then
Select Case Bmode
Case 0
Bstr(BCnt) = B1 * 4                           'ãˆÊ6Bit
Case 1
Bstr(BCnt) = Bstr(BCnt) + (B1 \ 16)           '‰ºˆÊ2Bit
BCnt = BCnt + 1                               '     +
Bstr(BCnt) = (&HF And B1) * 16                'ãˆÊ4Bit
Case 2
Bstr(BCnt) = Bstr(BCnt) + (B1 \ 4)            '‰ºˆÊ4Bit
BCnt = BCnt + 1                               '     +
Bstr(BCnt) = (&H3 And B1) * 64                'ãˆÊ2Bit
Case 3
Bstr(BCnt) = Bstr(BCnt) + B1                  'ãˆÊ6Bit
BCnt = BCnt + 1
End Select
Bmode = Bmode + 1
If Bmode > 3 Then Bmode = 0
End If
ACnt = ACnt + 1
Loop

End Sub

Private Function B64ToBin(A1 As String) As Byte

Dim B1 As Byte

If Len(A1) <> 1 Then
B64ToBin = 255
Exit Function
End If
B1 = 255
If Asc(A1) >= Asc("A") And Asc(A1) <= Asc("Z") Then B1 = Asc(A1) - Asc("A") + 0
If Asc(A1) >= Asc("a") And Asc(A1) <= Asc("z") Then B1 = Asc(A1) - Asc("a") + 26
If Asc(A1) >= Asc("0") And Asc(A1) <= Asc("9") Then B1 = Asc(A1) - Asc("0") + 52
If A1 = "+" Then B1 = 62
If A1 = "/" Then B1 = 63

B64ToBin = B1

End Function

Private Sub base64encode(Bstr() As Byte, Blen As Long, B64str As String)
'----------------------------------------------------------------
' BASE64 ENCODER [1996/04/27]
'    8bit Binary -> 6bit ASCII (A-Z,a-z,0-9,+,/,[=])
'      + Bstr   : 8bit Binary Data
'      + Blen   : Bstr Data Length
'      - B64str : Base64 ASCII Code Data
'----------------------------------------------------------------
Dim Bmode As Integer
Dim Cnt As Long
Dim B1 As Byte
Dim RetVal As Integer
Dim Str1 As String
Dim m As Integer
Dim Pos As Integer

B64str = ""
Cnt = 0
Bmode = 0

Do Until Blen <= Cnt
If Fix(Cnt Mod 100) = 0 Then RetVal = DoEvents()
B1 = Bstr(Cnt)
Select Case Bmode
Case 0
B1 = (&HFC And B1) \ 4
Case 1
B1 = (&H3 And B1) * 16
Cnt = Cnt + 1
If Blen > Cnt Then
B1 = B1 + (&HF0 And Bstr(Cnt)) \ 16
End If
Case 2
B1 = (&HF And B1) * 4
Cnt = Cnt + 1
If Blen > Cnt Then
B1 = B1 + (&HC0 And Bstr(Cnt)) \ 64 'ãˆÊ2Bit
End If
Case 3
B1 = &H3F And B1                      '‰ºˆÊ6Bit
Cnt = Cnt + 1
End Select

B64str = B64str & BinToB64(B1)

Bmode = Bmode + 1
If Bmode > 3 Then Bmode = 0

Loop

Select Case Bmode
Case 0
B64str = B64str
Case 1, 2
B64str = B64str & "=="
Case 3
B64str = B64str & "="
End Select

Str1 = ""
m = 0
Do Until Len(B64str) <= m * 76
Pos = m * 76 + 1
If Len(B64str) - Pos > 76 Then
Str1 = Str1 & Mid\$(B64str, Pos, 76) & vbCrLf
Else
Str1 = Str1 & Mid\$(B64str, Pos, Len(B64str) - m * 76) & vbCrLf
End If
m = m + 1
Loop

B64str = Str1
Debug.Print "Base64 Last Encode Mode = "; Bmode

End Sub

0

Author Commented:
Mark never sent me the code.  I'd like to assign the points to deighton
0

progCommented:
Here is my earlier solution re-posted as an answer.

Public Function encode64(sX As String) As String

'Encode to a string from a string

Dim x() As Byte
Dim iLen As Long, c As Long
Dim sString As String

iLen = Len(sX)
ReDim x(iLen - 1)

For c = 0 To iLen - 1

x(c) = Asc(Mid(sX, c + 1, 1))

Next

Call base64encode(x, iLen, sString)

encode64 = sString

End Function

Public Function decode64(x As String) As String

'decode from a string to  a string

Dim n() As Byte
Dim ni As Long
Dim sString As String

ReDim n(Len(x) + 1)

ni = Len(x)

Call base64decode(x, n(), ni)

For c = 1 To ni

decode64 = decode64 + Chr(n(c - 1))

Next

End Function

Private Function BinToB64(B1 As Byte) As String
'----------------------------------------------------------------
'
'    in B1  : Base64 Binary (0-63)
'    return : Base64 Ascii Code
'----------------------------------------------------------------
Dim A1 As String

If B1 <= 25 Then A1 = Chr(Asc("A") + B1)
If B1 > 25 And B1 <= 51 Then A1 = Chr(Asc("a") + B1 - 26)
If B1 > 51 And B1 <= 61 Then A1 = Chr(Asc("0") + B1 - 52)
If B1 = 62 Then A1 = "+"
If B1 = 63 Then A1 = "/"

BinToB64 = A1
'Debug.Print B1; A1
End Function

Private Sub base64decode(B64str As String, Bstr() As Byte, BCnt As Long)
'----------------------------------------------------------------
' BASE64 DECODER [1996/04/27]
'    6bit ASCII -> 8bit Binary
'      in  B64str : Base64 ASCII Code Data
'      out Bstr   : 8bit Binary Data
'      out BCnt   : Bstr Data Length
'----------------------------------------------------------------

Dim Bmode As Integer
Dim ACnt As Long
Dim B1 As Byte
Dim RetVal As Integer

ACnt = 0
BCnt = 0
Bmode = 0

Do Until (Mid\$(B64str, ACnt + 1, 1) = "=" Or Len(B64str) <= ACnt)
If Fix(ACnt Mod 100) = 0 Then RetVal = DoEvents()
B1 = B64ToBin(Mid\$(B64str, ACnt + 1, 1))
If B1 >= 0 And B1 <= 63 Then
Select Case Bmode
Case 0
Bstr(BCnt) = B1 * 4                           'ãˆÊ6Bit
Case 1
Bstr(BCnt) = Bstr(BCnt) + (B1 \ 16)           '‰ºˆÊ2Bit
BCnt = BCnt + 1                               '     +
Bstr(BCnt) = (&HF And B1) * 16                'ãˆÊ4Bit
Case 2
Bstr(BCnt) = Bstr(BCnt) + (B1 \ 4)            '‰ºˆÊ4Bit
BCnt = BCnt + 1                               '     +
Bstr(BCnt) = (&H3 And B1) * 64                'ãˆÊ2Bit
Case 3
Bstr(BCnt) = Bstr(BCnt) + B1                  'ãˆÊ6Bit
BCnt = BCnt + 1
End Select
Bmode = Bmode + 1
If Bmode > 3 Then Bmode = 0
End If
ACnt = ACnt + 1
Loop

End Sub

Private Function B64ToBin(A1 As String) As Byte

Dim B1 As Byte

If Len(A1) <> 1 Then
B64ToBin = 255
Exit Function
End If
B1 = 255
If Asc(A1) >= Asc("A") And Asc(A1) <= Asc("Z") Then B1 = Asc(A1) - Asc("A") + 0
If Asc(A1) >= Asc("a") And Asc(A1) <= Asc("z") Then B1 = Asc(A1) - Asc("a") + 26
If Asc(A1) >= Asc("0") And Asc(A1) <= Asc("9") Then B1 = Asc(A1) - Asc("0") + 52
If A1 = "+" Then B1 = 62
If A1 = "/" Then B1 = 63

B64ToBin = B1

End Function

Private Sub base64encode(Bstr() As Byte, Blen As Long, B64str As String)
'----------------------------------------------------------------
' BASE64 ENCODER [1996/04/27]
'    8bit Binary -> 6bit ASCII (A-Z,a-z,0-9,+,/,[=])
'      + Bstr   : 8bit Binary Data
'      + Blen   : Bstr Data Length
'      - B64str : Base64 ASCII Code Data
'----------------------------------------------------------------
Dim Bmode As Integer
Dim Cnt As Long
Dim B1 As Byte
Dim RetVal As Integer
Dim Str1 As String
Dim m As Integer
Dim Pos As Integer

B64str = ""
Cnt = 0
Bmode = 0

Do Until Blen <= Cnt
If Fix(Cnt Mod 100) = 0 Then RetVal = DoEvents()
B1 = Bstr(Cnt)
Select Case Bmode
Case 0
B1 = (&HFC And B1) \ 4
Case 1
B1 = (&H3 And B1) * 16
Cnt = Cnt + 1
If Blen > Cnt Then
B1 = B1 + (&HF0 And Bstr(Cnt)) \ 16
End If
Case 2
B1 = (&HF And B1) * 4
Cnt = Cnt + 1
If Blen > Cnt Then
B1 = B1 + (&HC0 And Bstr(Cnt)) \ 64 'ãˆÊ2Bit
End If
Case 3
B1 = &H3F And B1                      '‰ºˆÊ6Bit
Cnt = Cnt + 1
End Select

B64str = B64str & BinToB64(B1)

Bmode = Bmode + 1
If Bmode > 3 Then Bmode = 0

Loop

Select Case Bmode
Case 0
B64str = B64str
Case 1, 2
B64str = B64str & "=="
Case 3
B64str = B64str & "="
End Select

Str1 = ""
m = 0
Do Until Len(B64str) <= m * 76
Pos = m * 76 + 1
If Len(B64str) - Pos > 76 Then
Str1 = Str1 & Mid\$(B64str, Pos, 76) & vbCrLf
Else
Str1 = Str1 & Mid\$(B64str, Pos, Len(B64str) - m * 76) & vbCrLf
End If
m = m + 1
Loop

B64str = Str1
Debug.Print "Base64 Last Encode Mode = "; Bmode

End Sub
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

## Featured Post

Tackle projects and never again get stuck behind a technical roadblock.