13

I have to write a textfile in VB6. I need to do it in appending and utf-8 encoded.

I tried two solutions, one with "TextStream" and another one with "ADODB.Stream".

The first one:

    Set fsoFile = fso.OpenTextFile(FileIn(fi), ForAppending, True)
    fsoFile.WriteLine "<tag>kkkjòòkkkkjlòlk</tag>"
    fsoFile.Close

Works good in appending but how can I write it utf-8 encoded?

The second one:

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

Write correctly in utf-8 but I can't write the file in appending but only with "adSaveCreateOverWrite".

How can I do that? Is there another way?

Thank you very much.

epi82
  • 497
  • 2
  • 10
  • 21
  • 1
    Using your ADODB Stream object, if the file you are appending to is not too large you can open it, read the existing text into a variable, then write the variable, and new text back out. You can also open a new file each time, write the existing text to it, then the new text. Kill the current file, and rename the new file. Complicated, but works quickly enough for smaller files that the user isn't left waiting. – jac May 04 '12 at 14:50
  • Unfortunately I'm working with large text file. I think that open it and read the existing text to each loop will be an heavy work for my application. – epi82 May 04 '12 at 15:34

3 Answers3

11

You could combine binary I/O with an API call to perform the conversion to 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
Bob77
  • 13,167
  • 1
  • 29
  • 37
  • 1
    Just add UTF-8 BOM if `LOF(OpenAppendUTF8)` is zero. – wqw May 05 '12 at 20:35
  • Actually UTF-8 files are never supposed to *have* a BOM, though you'll frequently see them on Windows files. http://en.wikipedia.org/wiki/UTF-8#Byte_order_mark So yes, if you need such a BOM add one as suggested. Also note that UTF-8 files are often expected to have LF instead of CRLF line delimiters, one more tweak one could make. – Bob77 May 05 '12 at 21:06
2

I prefer to save it ANSI as it does by default. Open it with a notepad and overwrite it selecting UTF8 encoding. I found it's the fastest way by far. And I use some other code to append, for example for a database convertion:

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
  • 1
    Does that work? I thought that if you write it first with ANSI then you're limiting your character set. Wouldn't saving it in UTF8 after it's ANSI just result in a UTF version of the ANSI character set? So if your text was in Russian, would you really maintain the proper characters? The CreateTextFile can save as Unicode (UTF16) by adding another "True", then you could probably convert it in Wordpad or something to UTF8 without missing much. – ElJeffe Jul 26 '13 at 14:20
1

Actually no need for API call.

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```

omegastripes
  • 12,351
  • 4
  • 45
  • 96