VB Source for BASE64 function?

here is a base64 code:
http://www.asahi-net.or.jp/~AI2H-YKMZ/tech/base64vb.htm

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 :)

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

      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

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...  

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.

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?

Base64 is a standard encoding technique -- usually used for password transmission.

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

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

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

I just emailed you - thanx...

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

Mark never sent me the code.  I'd like to assign the points to deighton