Chikoo's Blog

MsgBox "abc的base64编码是 : " & base64Encode("abc"),64,"abc的base64编码是"
MsgBox "编码再解码是 :　" & base64uncode(base64Encode("abc")),64,"编码再解码"
Function base64Encode(sString)
    If sString = "" or IsNull(sString) Then
        base64Encode = ""
        Exit Function
    End If
    Dim xml_dom, Node
    Set xml_dom = CreateObject("Microsoft.XMLDOM")
    With xml_dom
        .loadXML ("
")
        Set Node = xml_dom.createElement("MyText")
        With Node
            .dataType = "bin.base64"
            .nodeTypedValue = Gb2312_Stream(sString)
            base64Encode = .Text
        End With
        xml_dom.documentElement.appendChild Node
    End With
    Set xml_dom = Nothing
End Function
Function base64uncode(sString)
    If sString = "" or IsNull(sString) Then
        base64uncode = ""
        Exit Function
    End If
    Dim xml_dom, Node
    Set xml_dom = CreateObject("Microsoft.XMLDOM")
    With xml_dom
        .loadXML ("
")
        Set Node = xml_dom.createElement("MyText")
        With Node
            .dataType = "bin.base64"
            .Text = sString
            base64uncode = Stream_GB2312(.nodeTypedValue)
        End With
        xml_dom.documentElement.appendChild Node
    End With
    Set xml_dom = Nothing
End Function
Function Gb2312_Stream(sString)
    Dim dr
    Set dr = CreateObject("ADODB.Stream")
    With dr
        .Mode = 3
        .Type = 2
        .open
        .Charset = "gb2312"
        .WriteText sString
        .position = 0
        .Type = 1
        Gb2312_Stream = .Read
        .Close
    End With
    Set dr = Nothing
End Function
Function Stream_GB2312(sStream)
    Dim dr
    Set dr = CreateObject("ADODB.Stream")
    With dr
        .Mode = 3
        .Type = 1
        .open
        .Write sStream
        .position = 0
        .Type = 2
        .Charset = "gb2312"
        Stream_GB2312 = .ReadText
        .Close
    End With
    Set dr = Nothing
End Function


