Question

在VB6中如何将UTF－8编码转换为ANSI编码？

我有很多的文本文件，而且还在继续增加中，这些文件都是UTF－8编码的，在VB6中用OPEN打开，用TEXT控件显示时为乱码，在记事本中手动另存为ANSI编码在VB6中打开显示就正常，有什么办法可以在用VB6打开时直接转换成ANSI编码显示呢？感谢感谢
你好，感谢你的回答，不过还有一个问题，就是CP_UTF8的值设置为什么？谢谢
设置为0&后，出现错误，提示内存不能为read后退出

Answer 1

先写入文件，再按对应的代码页按字节读取转换。

代码如下：

Private Const CP_ACP = 0        ' default to ANSI code page
Private Const CP_UTF8 = 65001   ' default to UTF-8 code page
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
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 EncodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0
    Dim aRetn() As Byte
    Dim nSize As Long
    nSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sData), -1, 0, 0, 0, 0)
    ReDim aRetn(0 To nSize - 1) As Byte
    WideCharToMultiByte CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize, 0, 0
    EncodeToBytes = aRetn
End Function

Private Function DecodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0
    Dim aRetn() As Byte
    Dim nSize As Long
    nSize = MultiByteToWideChar(CP_UTF8, 0, StrPtr(sData), -1, 0, 0)
    ReDim aRetn(0 To 2 * nSize - 1) As Byte
    MultiByteToWideChar CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize
    DecodeToBytes = aRetn
End Function

Private Sub Command1_Click()
    Dim aData() As Byte
    Dim sData As String
    Dim nFileNumber As Integer

    Open "C:\1.txt" For Output As #1
    Print #1, Text1
    Close #1
    
    nFileNumber = FreeFile()
    Open "C:\1.txt" For Binary As nFileNumber
    ReDim aData(0 To LOF(nFileNumber) - 1) As Byte
    Get nFileNumber, 1, aData
    Close nFileNumber
    sData = DecodeToBytes(aData)
    Text2.Text = sData
End Sub

效果如下：

Answer 2

重新改过，在xp已经过测试可用
Option Explicit
Private 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 Long
Private Const CP_UTF8 = 65001
'Purpose:Convert Utf8 to Unicode
Public 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 If
EndFunction:
End Function

Private 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 #1
End Sub