重新改过,在xp已经过测试可用Option ExplicitPrivate Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As LongPrivate Const CP_UTF8 = 65001'Purpose:Convert Utf8 to UnicodePublic Function UTF8_Decode(ByVal sUTF8 As String) 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 If LenB(sUTF8) = 0 Then Exit Function
On Error GoTo EndFunction
bytUtf8 = StrConv(sUTF8, vbFromUnicode)
lngUtf8Size = UBound(bytUtf8) + 1
On Error GoTo 0
'Set buffer for longest possible string i.e. each byte is
'ANSI, thus 1 unicode(2 bytes)for every utf-8 character.
lngBufferSize = lngUtf8Size * 2
strBuffer = String$(lngBufferSize, vbNullChar)
'Translate using code page 65001(UTF-8)
lngResult = MultiByteToWideChar(CP_UTF8, 0, bytUtf8(0), _
lngUtf8Size, StrPtr(strBuffer), lngBufferSize)
'Trim result to actual length
If lngResult Then
UTF8_Decode = Left$(strBuffer, lngResult)
End IfEndFunction:End FunctionPrivate Sub Command1_Click()
Dim str_UTF8 As String
Dim str_Unicode As String
Open "c:\UTF8.txt" For Binary As 1
Seek #1, 1
str_UTF8 = StrConv(InputB$(LOF(1), 1), vbUnicode) '读到字符串
str_UTF8 = Right(str_UTF8, Len(str_UTF8) - 1) '第一个字符是格式标志,无实际意义,去掉
Close 1
str_Unicode = UTF8_Decode(str_UTF8) '转换为Unicode
Text1.Text = str_Unicode '显示到文本框
'保存到Unicode格式文件
Open "c:\ANSI.txt" For Binary As #1
Put #1, , str_Unicode
Close #1End Sub |