utf-8 - 在 VB6 中追加写入文本文件（utf-8 编码）

Question

我必须在 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”。

我怎样才能做到这一点？还有其他方法吗？

非常感谢你。

Answer 1

您可以将二进制 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

Answer 2

我更喜欢将其保存为 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

Answer 3

实际上不需要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```