Base64编码/解码VB6超精简版(适用于中、英文)

来源：互联网发布：开票软件重装恢复数据编辑：程序博客网时间：2024/04/30 15:57

上次因为要编写自动登录邮箱的程序，需要Base64编码，但是我看了几种版本的VB下Base64编码的程序，发现要么就是太冗长，要么就是不支持中文，要么根本不能用，于是我想求人不如求己，便仔细研究了一下Base64编码原理，然后编写了这段程序，在电脑上调试通过，可以顺利进行Base64编码/解码，速度也快。现在拿出来分享给大家，希望对大家有所帮助。若有Bug请与我联系：hzh932@gmail.com。

程序模块：

Option Explicit
Private Const cstBase64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Private arrBase64() As String
'作者:同济黄正引用请注明出处:http://fine3x.com
'00100001 00100001 00100001 --源码
'00001000 00010010 00000100 00100001 --Base64码

Public Function Base64Encode(strSource As String) As String
On Error Resume Next
'适用于中、英文的Base64编码/解码VB6超精简版作者:同济黄正引用请注明出处:http://fine3x.com
If UBound(arrBase64) = -1 Then
arrBase64 = Split(StrConv(cstBase64, vbUnicode), vbNullChar)
End If
Dim arrB() As Byte, bTmp(2) As Byte, bT As Byte
Dim I As Long, J As Long
arrB = StrConv(strSource, vbFromUnicode)

J = UBound(arrB)
For I = 0 To J Step 3
    Erase bTmp
    bTmp(0) = arrB(I + 0)
    bTmp(1) = arrB(I + 1)
    bTmp(2) = arrB(I + 2)

    bT = (bTmp(0) And 252) / 4
    Base64Encode = Base64Encode & arrBase64(bT)

    bT = (bTmp(0) And 3) * 16
    bT = bT + bTmp(1) / 16
    Base64Encode = Base64Encode & arrBase64(bT)

    bT = (bTmp(1) And 15) * 4
    bT = bT + bTmp(2) / 64
    If I + 1 <= J Then
        Base64Encode = Base64Encode & arrBase64(bT)
    Else
        Base64Encode = Base64Encode & "="
    End If

    bT = bTmp(2) And 63
    If I + 2 <= J Then
        Base64Encode = Base64Encode & arrBase64(bT)
    Else
        Base64Encode = Base64Encode & "="
    End If
Next
End Function

Public Function Base64Decode(strEncoded As String) As String
'适用于中、英文的Base64编码/解码VB6超精简版作者:同济黄正引用请注明出处:http://fine3x.com
On Error Resume Next
Dim arrB() As Byte, bTmp(3) As Byte, bT As Long, bRet() As Byte
Dim I As Long, J As Long
arrB = StrConv(strEncoded, vbFromUnicode)
J = InStr(strEncoded & "=", "=") - 2
ReDim bRet(J - J / 4 - 1)
For I = 0 To J Step 4
    Erase bTmp
    bTmp(0) = (InStr(cstBase64, Chr(arrB(I))) - 1) And 63
    bTmp(1) = (InStr(cstBase64, Chr(arrB(I + 1))) - 1) And 63
    bTmp(2) = (InStr(cstBase64, Chr(arrB(I + 2))) - 1) And 63
    bTmp(3) = (InStr(cstBase64, Chr(arrB(I + 3))) - 1) And 63

    bT = bTmp(0) * 2 ^ 18 + bTmp(1) * 2 ^ 12 + bTmp(2) * 2 ^ 6 + bTmp(3)

    bRet((I / 4) * 3) = bT / 65536
    bRet((I / 4) * 3 + 1) = (bT And 65280) / 256
    bRet((I / 4) * 3 + 2) = bT And 255
Next
Base64Decode = StrConv(bRet, vbUnicode)
End Function