xml存为utf8格式问题！！

Private Sub Command1_Click()
    Dim strAll As String
    strAll = ""
    strAll= "XML File:" & vbCrLf & "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCrLf
    strAll= strAll & "<test></test>"
    Call sPrint(strAll)           '《----这样无法存为UTF8格式，使ANSI格式
    Call sPrint("xml:" & strAll)  '〈----这样可以存为UTF8格式（加了xml:为什么就可以了呢）
End Sub
Sub sPrint(strPrint As String)
    '输出文本到记事本
    Dim sFileName As String
    sFileName = App.Path & "\xml\test.xml"
    Open sFileName For Binary As #1
    Put #1, , tran_ado(strPrint)
    Close #1
End Sub
Function tran_ado(ByVal strA As String) As String
    Dim Stm As New ADODB.Stream
    Stm.Type = adTypeText
    Stm.Mode = adModeUnknown
    Stm.Open
    Stm.Charset = "utf-8"
    Stm.WriteText strA
    Stm.Position = 0
    Stm.Type = adTypeText
    Stm.Charset = "gb2312"
    tran_ado = Stm.ReadText()
    Stm.Close
End Function

7 个解决方案

#1

干吗要这句
"XML File:" & vbCrLf &

xml是以:"<?xml version=""1.0"" encoding=""UTF-8""?>" 开始的

#2

就是因为不加："XML File:" & vbCrLf & 无法保存为UTF-8格式

#3

Function tran_ado(ByVal strA As String) As String
    Dim Stm As New ADODB.Stream
    Stm.Type = adTypeText
    Stm.Mode = adModeUnknown
    Stm.Open
    Stm.Charset = "utf-8"
    Stm.WriteText strA
    Stm.Position = 0
    Stm.Type = adTypeText
    'Stm.Charset = "gb2312" 不要这句，全按UTF-8解码译码
    tran_ado = Stm.ReadText()
    Stm.Close
End Function

Call sPrint("<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCrLf & "<test></test>")

#4

to Hassle() :
去掉'Stm.Charset = "gb2312" 不要这句，全按UTF-8解码译码
不去：Call sPrint("dddddd<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCrLf & "<test></test>")
直接这样：Call sPrint("<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCrLf & "<test></test>")，还是不可以

#5

Stm.Charset = "gb2312" ---->不能去掉的.你可以试试看

#6

如果仅仅只是要将字符串保存为 utf-8 而已，不必动用  ADODB.Stream 这个大家伙吧？

http://blog.csdn.net/zyl910 上面提供一个很好的 utf8 处理模块，建议去研究一下。

也可以直接用下面的代码：

'参数是一个字符串，返回值是byte数组。以二进制方式写入文件中，即是 utf-8 编码了。
'当然，如果你需要加 bom，那么在写返回字节着，请先写入 bom 那三个字节：
'    &HEF、&HBB、&HBF

'--------------------API声明部分--------------------
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Const CP_UTF8 = 65001

Private Function UTF8_Encode(ByVal strUnicode As String) As Byte()
'UTF-8 编码

    Dim TLen As Long
    Dim lngBufferSize As Long
    Dim lngResult As Long
    Dim bytUtf8() As Byte
    
    TLen = Len(strUnicode)
    If TLen = 0 Then Exit Function
    
    lngBufferSize = TLen * 3 + 1
    ReDim bytUtf8(lngBufferSize - 1)
    
    lngResult = WideCharToMultiByte(CP_UTF8, 0, StrPtr(strUnicode), TLen, bytUtf8(0), lngBufferSize, vbNullString, 0)
    
    If lngResult <> 0 Then
        lngResult = lngResult - 1
        ReDim Preserve bytUtf8(lngResult)
    End If
    
    UTF8_Encode = bytUtf8
End Function

#7

用法示例：
    
Private Sub Command1_Click()
    Dim str1 As String
    str1 = "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCrLf & "<test>这是一个utf-8编码的xml文件</test>"
    
    Dim buffByt() As Byte
    buffByt = UTF8_Encode(str1)
    
    Dim buffBom(2) As Byte
    buffBom(0) = &HEF: buffBom(1) = &HBB: buffBom(2) = &HBF
    
    Open "c:\abc.txt" For Binary As #1
    
    '写bom,如果不需要 bom，可以不写这句
    Put #1, , buffBom
    
    '写正文
    Put #1, , buffByt
    Close #1
    
    
End Sub