我必须在VB6中编写一个文本文件。我需要附加和utf-8编码。
我尝试了两个解决方案,一个使用“TextStream”,另一个使用“ADODB.Stream”。
第一个:
Set fsoFile = fso.OpenTextFile(FileIn(fi), ForAppending, True)
fsoFile.WriteLine "<tag>kkkjòòkkkkjlòlk</tag>"
fsoFile.Close
在附加方面做得很好,但我怎么能用utf-8编码呢?
第二个:
Dim ST As ADODB.Stream
Set ST = New ADODB.Stream
ST.Mode = adModeReadWrite
ST.Type = adTypeText
ST.Charset = "UTF-8"
ST.Open
ST.LoadFromFile FileIn(fi)
ST.Position = ST.Size
ST.WriteText "<tag>kkkjòòkkkkjlòlk</tag>"
ST.SaveToFile FileIn(fi)
ST.Close
在utf-8中正确写入,但我不能附加文件,只能使用“adSaveCreateOverWrite”。
我该怎么做?还有另一种方式吗?
非常感谢。
答案 0 :(得分:10)
您可以将二进制I / O与API调用结合使用,以执行转换为UTF-8:
Option Explicit
Private Const CP_UTF8 As Long = 65001
Private Declare Function WideCharToMultiByte Lib "kernel32" ( _
ByVal CodePage As Long, _
ByVal dwFlags As Long, _
ByVal lpWideCharStr As Long, _
ByVal cchWideChar As Long, _
ByVal lpMultiByteStr As Long, _
ByVal cchMultiByte As Long, _
ByVal lpDefaultChar As Long, _
ByVal lpUsedDefaultChar As Long) As Long
Private Function OpenAppendUTF8(ByVal FileName As String) As Integer
OpenAppendUTF8 = FreeFile(0)
Open FileName For Binary Access Write As #OpenAppendUTF8
Seek #OpenAppendUTF8, LOF(OpenAppendUTF8) + 1
End Function
Private Sub WriteUTF8( _
ByVal FNum As Integer, _
ByVal Text As String, _
Optional ByVal NL As Boolean)
Dim lngResult As Long
Dim UTF8() As Byte
If NL Then Text = Text & vbNewLine
lngResult = WideCharToMultiByte(CP_UTF8, 0, StrPtr(Text), Len(Text), _
0, 0, 0, 0)
If lngResult > 0 Then
ReDim UTF8(lngResult - 1)
WideCharToMultiByte CP_UTF8, 0, StrPtr(Text), Len(Text), _
VarPtr(UTF8(0)), lngResult, 0, 0
Put #FNum, , UTF8
End If
End Sub
Private Sub Main()
Dim F As Integer
F = OpenAppendUTF8("test.txt")
WriteUTF8 F, "Hello"
WriteUTF8 F, ChrW$(&H2026&)
WriteUTF8 F, "World", True
Close #F
MsgBox "Done"
End Sub
答案 1 :(得分:1)
我更喜欢将它保存为ANSI,就像默认情况下那样。用记事本打开它并覆盖它选择UTF8编码。我发现它是迄今为止最快的方式。 我使用其他一些代码来附加,例如数据库转换:
Dim fs As Object, a
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(filename, True) 'example (myfile.xml, True)
a.writeline var1
a.writeline var2
a.Close
答案 2 :(得分:0)
实际上不需要API调用。
Option Explicit
Sub testAppend()
Dim fileName
fileName = "C:\Test\test.txt"
Dim f As Integer
f = FreeFile(0)
Open fileName For Binary Access Write As #f
Seek #f, LOF(f) + 1
Dim t
t = "<tag>" & ChrW(107) & ChrW(107) & ChrW(107) & ChrW(106) & ChrW(242) & ChrW(242) & ChrW(107) & ChrW(107) & ChrW(107) & ChrW(107) & ChrW(106) & ChrW(108) & ChrW(242) & ChrW(108) & ChrW(107) & "</tag>"
Put #f, , textToBinary(t, "utf-8")
Close #f
End Sub
Function textToBinary(text, charset) As Byte()
With CreateObject("ADODB.Stream")
.Open
.Type = 2 ' adTypeText
.charset = charset
.WriteText text
.Position = 0
.Type = 1 ' adTypeBinary
textToBinary = .Read
.Close
End With
End Function```