'读取UTF-8 s = UTF8_Decode(App.Path & "/index.txt") '文件名请根据实际修改
Public Function GetFile(ByVal FileName As String) As String
Dim i As Integer, BB() As Byte
If Dir(FileName) = "" Then Exit Function
i = FreeFile
ReDim BB(FileLen(FileName) - 1)
Open FileName For Binary As #i
Get #i, , BB
Close #i
GetFile = BB
End Function
'Dim strTest, testFile As String
'strTest = RichTextBox1.Text
'testFile = App.Path & "/index.html"
'If Dir(testFile) <> "" Then
' Kill testFile
'End If
'Call SaveFile(testFile, strTest, "utf8")
'功能: 生成UTFF-8页面
Public Function SaveFile(ByVal strPath_file As String, ByVal str As String, ByVal strPageCode As String) 'Call SaveFile("App.Path & "/index.html"", strTest, "utf8")
If Dir(strPath_file) <> "" Then
Kill strPath_file
End If
If strPageCode = "utf8" Then '存为UTF-8=
Dim lBufSize As Long
Dim lRest As Long
Dim bUTF8() As Byte
Dim TLen As Long
Dim fn
TLen = Len(str)
lBufSize = TLen * 3 + 1
ReDim bUTF8(lBufSize - 1)
lRest = WideCharToMultiByte(CP_UTF8, 0, StrPtr(str), TLen, bUTF8(0), lBufSize, vbNullString, 0)
If lRest Then
lRest = lRest - 1
ReDim Preserve bUTF8(lRest)
Open strPath_file For Binary As #1
Put #1, , bUTF8
Close #1
End If
Else '存为GB-2312
fn = FreeFile
Open strPath_file For Output As fn
Print #fn, str
Close #fn
End If
End Function
Public Function UTF8_Decode(ByVal FileName As String) As String
If Dir(FileName) = "" Then
' Form1.me.Caption = FileName & "不存在"
Else
Dim sUTF8 As String
Dim lngUtf8Size As Long
Dim strBuffer As String
Dim lngBufferSize As Long
Dim lngResult As Long
Dim bytUtf8() As Byte
Dim n As Long
sUTF8 = GetFile(FileName)
If LenB(sUTF8) = 0 Then Exit Function
On Error GoTo EndFunction
bytUtf8 = sUTF8
lngUtf8Size = UBound(bytUtf8) + 1
lngBufferSize = lngUtf8Size * 2
strBuffer = String$(lngBufferSize, vbNullChar)
lngResult = MultiByteToWideChar(CP_UTF8, 0, bytUtf8(0), _
lngUtf8Size, StrPtr(strBuffer), lngBufferSize)
If lngResult Then
UTF8_Decode = Left(strBuffer, lngResult)
End If
End If
EndFunction:
End Function