excel字符替换c语言,VBA高级教程之基础篇：文本编码和字符串处理(包括指针)，ADODB.Stream转换文本编码...

Function BytesToBstr(ByRef arrBody() As Byte, ByVal CodeBase As String) As String'- ------------------------------------------- -

'  函数说明：字节数组转换成Unicode字符串(BSTR)

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

Dim objStream As Object

Set objStream = CreateObject("ADODB.Stream")

objStream.Type = 1     'adTypeBinary=1  adTypeText=2

objStream.Mode = 3     'adModeRead=1  adModeWrite=2  adModeReadWrit=3  adModeUnknown=0

objStream.Open

objStream.Write arrBody

objStream.Position = 0

objStream.Type = 2      'adTypeBinary=1  adTypeText=2

objStream.Charset = CodeBase

BytesToBstr = objStream.ReadText

objStream.Close

Set objStream = Nothing

End Function

Function BytesToBytesNoBom(ByRef arrBody() As Byte, ByVal SCodeBase As String, ByVal DCodeBase As String) As Byte()

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

'  函数说明：不同编码的字节数组转换

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

Dim objStream As Object

Dim SText$, Dtext$

Set objStream = CreateObject("ADODB.Stream")

objStream.Type = 1     'adTypeBinary=1  adTypeText=2

objStream.Mode = 3     'adModeRead=1  adModeWrite=2  adModeReadWrit=3  adModeUnknown=0

objStream.Open

objStream.Write arrBody

objStream.Position = 0

objStream.Type = 2                  'adTypeText = 2

objStream.Charset = SCodeBase

SText = objStream.ReadText          '读取文本到sCode(Unicode)

objStream.Position = 0              ' 这只是定位到文件头

objStream.SetEOS                    'Position=0,更新 EOS 属性的值。使EOS的位置为0(也就是把结尾设成开头的位置)

objStream.Type = 2                  'adTypeText = 2

objStream.Charset = DCodeBase       '指定输出编码

objStream.WriteText SText           '写入文本数据到Adodb.Stream

'objStream.SaveToFile ThisWorkbook.Path & Application.PathSeparator & "out.bin", 2    '输出成文件

objStream.Position = 0              '切换type之前，要先重置指针为0

objStream.Type = 1                  'adTypeBinary=1  adTypeText=2

If InStr(1, DCodeBase, "utf-8", vbTextCompare) > 0 Then                               '去掉BOM

objStream.Position = 3

ElseIf InStr(1, DCodeBase, "unicode", vbTextCompare) > 0 Then

objStream.Position = 2

End If

BytesToBytesNoBom = objStream.Read

objStream.Close

Set objStream = Nothing

End Function

Public Function Base64Encode(varIn As Variant, CodeBase As String) As String

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

'  函数说明：BASE64编码

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

Dim adoStream As Object

Dim xmlDoc As Object

Dim xmlNode As Object

Set adoStream = CreateObject("ADODB.Stream")

adoStream.Charset = CodeBase   '文本编码

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

Public Function Base64Decode(varIn As Variant, CodeBase As String, Optional ByVal ReturnValueType As VbVarType = vbString) As Byte()

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

'  函数说明：BASE64解码

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

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 = CodeBase  '文本的编码

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