利用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