• 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:
alweiner
1 Solution
 
a111a111a111Commented:
0
 
alweinerAuthor 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
 
deightonprogCommented:
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
Cloud Class® Course: Certified Penetration Testing

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

 
deightonprogCommented:


      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
 
deightonprogCommented:
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
 
alweinerAuthor 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
 
deightonprogCommented:
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
 
alweinerAuthor Commented:
Base64 is a standard encoding technique -- usually used for password transmission.
0
 
deightonprogCommented:
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
 
alweinerAuthor Commented:
Pls don't just guess if you don't know.  Does anybody understand BASE64 and have VB source code to do it?
0
 
mark2150Commented:
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
 
alweinerAuthor Commented:
I just emailed you - thanx...
0
 
deightonprogCommented:
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
 
alweinerAuthor Commented:
Mark never sent me the code.  I'd like to assign the points to deighton
0
 
deightonprogCommented:
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.

Join & Write a Comment

Featured Post

Cloud Class® Course: Certified Penetration Testing

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

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