利用ADO STREAM实现BASE64编码和解码

'* ************************************** *
'* 模块名称：modBase64.bas
'* 模块功能：BASE64编码和解码函数
'* 作者：lyserver
'* ************************************** *

Option Explicit

'- ------------------------------------------- -
'  函数说明：BASE64编码
'- ------------------------------------------- -
Public Function Base64Encode(varIn As Variant) As String
Dim adoStream As Object
Dim xmlDoc As Object
Dim xmlNode As Object

Set adoStream = CreateObject("ADODB.Stream")
adoStream.Charset = "gb2312"
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
Base64Encode = xmlNode.Text
adoStream.Close
End Function

'- ------------------------------------------- -
'  函数说明：BASE64解码
'- ------------------------------------------- -
Public Function Base64Decode(varIn As Variant, Optional ByVal ReturnValueType As VbVarType = vbString) As Byte()
Dim adoStream As Object
Dim xmlDoc As Object
Dim 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")
adoStream.Charset = "gb2312"
adoStream.Type = 1 'adTypeBinary
adoStream.Open
adoStream.Write xmlNode.nodeTypedValue
adoStream.Position = 0
If ReturnValueType = vbString Then
adoStream.Type = 2 'adTypeText
Base64Decode = adoStream.ReadText
Else
Base64Decode = adoStream.Read
End If
adoStream.Close
End Function