vb6编解码base64字符串（支持UTF8）

（com版本）以后有时间搞一个 api 版本的

‘* 模块功能：BASE64编码和解码函数

‘* 作者：lyserver

‘* ** *

‘优化：邓伟，QQ215879458
‘20240723 【+】新增了 UTF8 支持，后期加入 LoadFrom 函数直接从文件或者URL获取

‘用法：（可以和其他语言通用）

‘Print Bas64Tools.Encode(“邓伟”)
‘tcvOsA==
‘
‘Print Bas64Tools.Encode(“hello 邓伟”, UTF8)
‘aGVsbG8g6YKT5Lyf
‘
‘Print Bas64Tools.Decode(“6YKT5Lyf”, UTF8)
‘邓伟
‘
‘Print Bas64Tools.Decode(“tcvOsA==”)
‘邓伟

源码：（直接复制到新建的vb模块文件，建议文件名为：Bas64Tools.base 也可以直接在本文底部下载现成的文件）

'* ************************************** *

'* 模块名称：modBase64.bas

'* 模块功能：BASE64编码和解码函数

'* 作者：lyserver

'* ************************************** *

'优化：邓伟，QQ215879458
'20240723 【+】新增了 UTF8 支持，后期加入 LoadFrom 函数直接从文件或者URL获取

'用法：

'Print Bas64Tools.Encode("邓伟")
'tcvOsA==
'
'Print Bas64Tools.Encode("hello 邓伟", UTF8)
'aGVsbG8g6YKT5Lyf
'
'Print Bas64Tools.Decode("6YKT5Lyf", UTF8)
'邓伟
'
'Print Bas64Tools.Decode("tcvOsA==")
'邓伟

Option Explicit

'- ------------------------------------------- -

'  函数说明：BASE64编码
Enum EnumCodePage
    GB2312 = 0
    UTF8 = 1
End Enum

'- ------------------------------------------- -

Public Function Encode(varIn As Variant, Optional CodePage As EnumCodePage = GB2312) As String
    '邓伟：优化为静态化对象，减少频繁调用的时候创建对象开销
    Static adoStream As Object
    Static xmlDoc As Object
    Static xmlNode As Object
    Set adoStream = CreateObject("ADODB.Stream")
    
    If CodePage = GB2312 Then
        adoStream.Charset = "gb2312"
    Else
        adoStream.Charset = "utf-8"
    End If
    
    If VarType(varIn) = vbString Then
        adoStream.Type = 2                                                      'adTypeText
        adoStream.Open
        adoStream.WriteText varIn
    ElseIf VarType(varIn) = vbByte Or vbArray Then
        adoStream.Type = 1                                                      'adTypeBinary
        adoStream.Open
        adoStream.Write varIn
    Else
        Exit Function
    End If
    
    adoStream.Position = 0
    adoStream.Type = 1                                                          'adTypeBinary
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")
    Set xmlNode = xmlDoc.createElement("MyNode")
    xmlNode.dataType = "bin.base64"
    xmlNode.nodeTypedValue = adoStream.Read
    '
    '邓伟：可能xml组件默认用的是 utf8bom 编码，输出的文本前置固定了4个字符：77u/，有时间优化下
    If CodePage = GB2312 Then
        Encode = xmlNode.Text
    Else
        Encode = Mid$(xmlNode.Text, 5)
    End If
    adoStream.Close
End Function

'- ------------------------------------------- -

'  函数说明：BASE64解码

'- ------------------------------------------- -

Public Function Decode(varIn As Variant, Optional CodePage As EnumCodePage = GB2312, Optional ByVal ReturnValueType As VbVarType = vbString) As Variant
    '邓伟：优化为静态化对象，减少频繁调用的时候创建对象开销
    Static adoStream As Object
    Static xmlDoc As Object
    Static xmlNode As Object
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")
    Set xmlNode = xmlDoc.createElement("MyNode")
    
    xmlNode.dataType = "bin.base64"
    
    If VarType(varIn) = vbString Then
        xmlNode.Text = Replace(varIn, vbCrLf, "")
    ElseIf VarType(varIn) = vbByte Or vbArray Then
        xmlNode.Text = Replace(StrConv(varIn, vbUnicode), vbCrLf, "")
    Else
        Exit Function
    End If
    
    Set adoStream = CreateObject("ADODB.Stream")
    If CodePage = GB2312 Then
        adoStream.Charset = "gb2312"
    Else
        adoStream.Charset = "utf-8"
    End If
    adoStream.Type = 1                                                          'adTypeBinary
    adoStream.Open
    adoStream.Write xmlNode.nodeTypedValue
    adoStream.Position = 0
    If ReturnValueType = vbString Then
        adoStream.Type = 2                                                      'adTypeText
        Decode = adoStream.ReadText
    Else
        Decode = adoStream.Read
    End If
    adoStream.Close
End Function

Views: 102