[VB6]產生UTF-8的文字檔
在前篇([Office]設定Word開啟合併列印文字檔，預設的編碼格式)的合併列印中，因為我們的程式在合併列印時，所產生的資料文字檔是Big5編碼的格式，所以當User將Office由2K換到Office 2010時，在某些資料會導致Word 2010在合併時，判斷錯了檔案的編碼，而導致合併出來的檔案是亂碼。所以改Word預設開啟檔案的編碼為Big5，但如果是其他編碼的檔案(如UTF-8)，就會用Big5去開啟，而導致合併成亂碼。所以，將要文字檔改以UTF-8編碼儲存似乎是比較好的方式。
以下從網路上找到2種VB6產生文字檔的方式，說明如下，
方法1，將文字串成Byte Array，再轉成UTF-8編碼，Code如下，
Private Sub Command1_Click()
Dim fid As Integer
'先產生檔案,並取回檔案的Number
fid = OpenFile("f:\test.txt")
'將文字寫入檔案之中
WriteFile fid, Text1.Text & vbCrLf & Text1.Text
'關閉檔案
CloseFile fid
MsgBox "OK"
End Sub
Public Function OpenFile(path As String) As Integer
On Error Resume Next
Kill path
Dim fid As Integer
fid = FreeFile()
Open path For Binary As fid
OpenFile = fid
End Function
Public Sub CloseFile(fid As Integer)
Close fid
End Sub
Public Function WriteFile(fid As Integer, s As String) As Integer
Dim bs() As Byte, buf(0 To 6) As Byte
Dim c As Integer, l As Integer, i As Integer, ch As Long
bs = s
c = UBound(bs)
For i = 0 To c Step 2
ch = bs(i + 1) * 2 ^ 8 Or bs(i)
l = UnicodeToUTF8(ch, buf)
Call WriteBytes(buf, l, fid)
Next i
End Function
Private Sub WriteBytes(buf() As Byte, cnt As Integer, fid As Integer)
Dim i As Integer
Dim b(0 To 0) As Byte
For i = 0 To cnt
b(0) = buf(i)
Put fid, , b
Next i
End Sub
Private Function UnicodeToUTF8(ch As Long, buf() As Byte) As Integer
Dim i As Integer: i = 0
If (ch < &H80) Then
buf(i) = ch
ElseIf (ch < &H800) Then
buf(i) = &HC0 Or ((ch And &H7C00) / 2 ^ 6): i = i + 1
buf(i) = &H80 Or (ch And &H3F)
ElseIf (ch < &H10000) Then
buf(i) = &HE0 Or ((ch And &HF000) / 2 ^ 12): i = i + 1
buf(i) = &H80 Or ((ch And &HFC0) / 2 ^ 6): i = i + 1
buf(i) = &H80 Or (ch And &H3F)
End If
UnicodeToUTF8 = i
End Function
方法2，利用ADODB.Stream，存成UTF-8編碼的檔案，Code如下，
Dim objStream As Object
'Create the stream
Set objStream = CreateObject("ADODB.Stream")
'Initialize the stream
objStream.Open
'Reset the position and indicate the charactor encoding
objStream.Position = 0
objStream.Charset = "UTF-8"
'Write to the steam
objStream.WriteText Text1.Text & vbCrLf
objStream.WriteText Text1.Text & vbCrLf
On Error Resume Next
Kill "f:\text2.txt"
'Save the stream to a file
objStream.SaveToFile "f:\text2.txt"
objStream.Close
MsgBox "OK"
參考資料
範例程式
Hi,
亂馬客Blog已移到了 「亂馬客 : Re:從零開始的軟體開發生活」
請大家繼續支持 ^_^
