Making Base64 encoder for VB

Can someone tell me how i can make a base64 encoder for vb6.  Is there a library out that can do this?  Is it easy to make?  What i want to do is be able to encode "UserFirstName:UserLastName" for http authentication calls.  The user will provide his/her first name and last name and it will then be encoded for the call.

Thanks
anistonAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

deightonprogCommented:
Private Sub Command1_Click()
'Sub base64encode(Bstr() As Byte, Blen As Long, B64str As String)
'base64decode(B64str As String, Bstr() As Byte, BCnt As Long)
Dim x(2) As Byte
Dim sString As String
Dim n As Long


sString = encode64("ANDREW DEIGHTON")

MsgBox sString

MsgBox decode64(sString)



End Sub

Attribute VB_Name = "Module1"

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
Public Function decode64(x As String) As String

'Private Sub base64decode(B64str As String, Bstr() As Byte, BCnt As Long)

    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


Public Function encode64(sX As String) As 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

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
anistonAuthor Commented:
You're a GENIUS!!!

Thanks
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.