有关于Base64的问题，急，急，急！！！！

Question

'base64加密算法
Public Function Base64_Encode(strSource) As String
    Const BASE64_TABLE As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    Dim strTempLine As String
    Dim j As Integer
    For j = 1 To (Len(strSource) - Len(strSource) Mod 3) Step 3
        strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) \ 4) + 1, 1)
        strTempLine = strTempLine + Mid(BASE64_TABLE, ((Asc(Mid(strSource, j, 1)) Mod 4) * 16 _
                      + Asc(Mid(strSource, j + 1, 1)) \ 16) + 1, 1)
        strTempLine = strTempLine + Mid(BASE64_TABLE, ((Asc(Mid(strSource, j + 1, 1)) Mod 16) * 4 _
                      + Asc(Mid(strSource, j + 2, 1)) \ 64) + 1, 1)
        strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j + 2, 1)) Mod 64) + 1, 1)
    Next j
    If Not (Len(strSource) Mod 3) = 0 Then
         If (Len(strSource) Mod 3) = 2 Then
            strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) \ 4) + 1, 1)
            strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) Mod 4) * 16 _
                      + Asc(Mid(strSource, j + 1, 1)) \ 16 + 1, 1)
             strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j + 1, 1)) Mod 16) * 4 + 1, 1)
            strTempLine = strTempLine & "="
        ElseIf (Len(strSource) Mod 3) = 1 Then
            strTempLine = strTempLine + Mid(BASE64_TABLE, Asc(Mid(strSource, j, 1)) \ 4 + 1, 1)
            strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) Mod 4) * 16 + 1, 1)
             strTempLine = strTempLine & "=="
        End If
     End If
    Base64_Encode = strTempLine
End Function 'base64解密算法
Public Function DecodeBase64String(str2Decode As String) As String'******************************************************************************
'
' Synopsis:     Decode a Base 64 string
'
' Parameters:   str2Decode  - The base 64 encoded input string
'
' Return:       decoded string
'
' Description:
'   Coerce 4 base 64 encoded bytes into 3 decoded bytes by converting 4, 6 bit
'   values (0 to 63) into 3, 8 bit values. Transform the 8 bit value into its
'   ascii character equivalent. Stop converting at the end of the input string
'   or when the first '=' (equal sign) is encountered.
'
'******************************************************************************Dim lPtr            As Long
Dim iValue          As Integer
Dim iLen            As Integer
Dim iCtr            As Integer
Dim Bits(1 To 4)    As Byte
Dim strDecode       As String' for each 4 character group....
For lPtr = 1 To Len(str2Decode) Step 4
    iLen = 4
    For iCtr = 0 To 3
        ' retrive the base 64 value, 4 at a time
        iValue = InStr(1, BASE64CHR, Mid$(str2Decode, lPtr + iCtr, 1), vbBinaryCompare)
        Select Case iValue
            ' A~Za~z0~9+/
            Case 1 To 64: Bits(iCtr + 1) = iValue - 1
            ' =
            Case 65
                iLen = iCtr
                Exit For
            ' not found
            Case 0: Exit Function
        End Select
    Next
    
    ' convert the 4, 6 bit values into 3, 8 bit values
    Bits(1) = Bits(1) * &H4 + (Bits(2) And &H30) \ &H10
    Bits(2) = (Bits(2) And &HF) * &H10 + (Bits(3) And &H3C) \ &H4
    Bits(3) = (Bits(3) And &H3) * &H40 + Bits(4)
    
    ' add the three new characters to the output string
    For iCtr = 1 To iLen - 1
        strDecode = strDecode & Chr$(Bits(iCtr))
    NextNextDecodeBase64String = strDecodeEnd Function

Answer 1

给你个网站WWW.freevbcode.com，里面有的

Answer 2

可以去这里看一看，有完整的演示代码，绝对实用：
http://www.aslike.net

Answer 3

Public Function Base64_Encode(strSource As String) As String
    Const BASE64_TABLE As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    Dim strTempLine As String
    Dim j As Integer
    For j = 1 To (Len(strSource) - Len(strSource) Mod 3) Step 3
        strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) \ 4) + 1, 1)
        strTempLine = strTempLine + Mid(BASE64_TABLE, ((Asc(Mid(strSource, j, 1)) Mod 4) * 16 _
                      + Asc(Mid(strSource, j + 1, 1)) \ 16) + 1, 1)
        strTempLine = strTempLine + Mid(BASE64_TABLE, ((Asc(Mid(strSource, j + 1, 1)) Mod 16) * 4 _
                      + Asc(Mid(strSource, j + 2, 1)) \ 64) + 1, 1)
        strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j + 2, 1)) Mod 64) + 1, 1)
    Next j
    If Not (Len(strSource) Mod 3) = 0 Then
         If (Len(strSource) Mod 3) = 2 Then
            strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) \ 4) + 1, 1)
            strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) Mod 4) * 16 _
                      + Asc(Mid(strSource, j + 1, 1)) \ 16 + 1, 1)
             strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j + 1, 1)) Mod 16) * 4 + 1, 1)
            strTempLine = strTempLine & "="
        ElseIf (Len(strSource) Mod 3) = 1 Then
            strTempLine = strTempLine + Mid(BASE64_TABLE, Asc(Mid(strSource, j, 1)) \ 4 + 1, 1)
            strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) Mod 4) * 16 + 1, 1)
             strTempLine = strTempLine & "=="
        End If
     End If
    Base64_Encode = strTempLine
End Function
===============================================================================
Public Function Base64_Decode(strSource As String) As String
Dim w1 As Integer
Dim w2 As Integer
Dim w3 As Integer
Dim w4 As Integer
Dim n As Integer
Dim retry As String   For n = 1 To Len(strSource) Step 4
      w1 = mimedecode(Mid$(strSource, n, 1))
      w2 = mimedecode(Mid$(strSource, n + 1, 1))
      w3 = mimedecode(Mid$(strSource, n + 2, 1))
      w4 = mimedecode(Mid$(strSource, n + 3, 1))
      If w2 >= 0 Then retry = retry + Chr$(((w1 * 4 + Int(w2 / 16)) And 255))
      If w3 >= 0 Then retry = retry + Chr$(((w2 * 16 + Int(w3 / 4)) And 255))
      If w4 >= 0 Then retry = retry + Chr$(((w3 * 64 + w4) And 255))
   Next
   Base64_Decode = retry
End Function
Private Function mimedecode(strSource As String) As Integer
   If Len(strSource) = 0 Then mimedecode = -1: Exit Function
   mimedecode = InStr(base64, strSource) - 1
End Function