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
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
"XML File:" & vbCrLf &xml是以:"<?xml version=""1.0"" encoding=""UTF-8""?>" 开始的
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 FunctionCall sPrint("<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCrLf & "<test></test>")
去掉'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>"),还是不可以
'当然,如果你需要加 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 = 65001Private 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
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