如何将ＵＴＦ８字符转化为ＶＢ能显示的字符

Question

请问如何将ＵＴＦ８字符转换为ＶＢ能显示的字符

Answer 1

读取UTF-8格式的TXT:
Private Sub Command1_Click()
    Dim strRlt As String
    Dim objStream As Object
    Set objStream = CreateObject("ADODB.Stream")    With objStream
            .Type = 2
            .Mode = 3
            .Open
            .LoadFromFile "c:\test.txt"
            .Position = 0
            .Charset = "UTF-8" 
            strRlt = Mid(.ReadText, 2)
            .Close
    End With
    Set objStream = Nothing
    Debug.Print strRlt
End Sub

Answer 2

Private Declare Function MultiByteToWideChar _
                    Lib "kernel32" (ByVal CodePage As Long, _
                                    ByVal dwFlags As Long, _
                                    ByVal lpMultiByteStr As String, _
                                    ByVal cchMultiByte As Long, _
                                    ByVal lpWideCharStr As String, _
                                    ByVal cchWideChar As Long) _
                    As Long
    
    Private Const CP_UTF8 = 65001       'CODE PAGE FOR UTF8
    
    
    Public Function Decode_UTF8(ByVal sText As String)
    
        Dim sBuffer  As String
        Dim nLength  As Long
        Dim byText() As Byte
        
        '''' CONVERT UTF8 TO UNICODE '''''''''''''''''''''''''''''''''''''''''''''''
        If LenB(sText) = 0 Then
            Decode_UTF8 = ""
            Exit Function
        End If                          'IF NOTHING TO CONVERT, DON'T BOTHER
        
        byText() = StrConv(sText, vbFromUnicode)
        nLength = UBound(byText()) + 1
        sBuffer = String(nLength * 2, vbNullChar)
        
        nLength = MultiByteToWideChar(CP_UTF8, 0, byText(0), nLength, _
                                      StrPtr(sBuffer), nLength * 2)
                                        'CONVERT TO UNICODE AND STORE IN sBuffer
                                      
        If nLength > 0 Then sText = Left(sBuffer, nLength)
                                        'TRIM IF REQUIRED
        Decode_UTF8 = sText
    End Function

Answer 3

Private Function Utf8_Decode(ByVal UTF8_String As String) As String
  Dim Utf8_Binary() As Byte    '//UTF8 Binary Source
  Dim Utf16_Binary() As Byte   '//Unicode Binary
  Dim Utf8_BytesLength As Long '//UTF8 String Length in Binary
  Dim Utf16_Length As Long     '//Unicode Binary Length with Terminal Symbol &H0000
  Dim Binary_Byte As Byte      '//UTF8 Byte
  Dim WideChar_Long As Long    '//Unicode Char
  Dim Source_Counter As Long   '
  Dim Dest_Counter As Long
  
  Utf8_Decode = ""             '//Predefine a return value
  If UTF8_String = "" Then Exit Function
  
  Utf8_Binary = UTF8_String                  '//Copy to Binary Array
  Utf8_BytesLength = UBound(Utf8_Binary) + 1
  Utf16_Length = (Utf8_BytesLength + 1) * 2
  ReDim Utf16_Binary(Utf16_Length)           '//Get Memory for Unicode String
  
  Source_Counter = 0
  Dest_Counter = 0
  
  While (Source_Counter < Utf8_BytesLength) And (Dest_Counter < (Utf16_Length \ 2))
     WideChar_Long = Utf8_Binary(Source_Counter)
     Source_Counter = Source_Counter + 1
     
     If (WideChar_Long And &H80&) <> 0 Then
        If Source_Counter >= Utf8_BytesLength Then Exit Function       '// incomplete multibyte char
        WideChar_Long = WideChar_Long And &H3F&
        If (WideChar_Long And &H20&) <> 0 Then
           Binary_Byte = Utf8_Binary(Source_Counter)
           Source_Counter = Source_Counter + 1
           If (Binary_Byte And &HC0&) <> &H80& Then Exit Function      '// malformed trail byte or out of range char
           If Source_Counter >= Utf8_BytesLength Then Exit Function    '// incomplete multibyte char
           WideChar_Long = (WideChar_Long * (2 ^ 6)) Or (Binary_Byte And &H3F&)
        End If
        Binary_Byte = Utf8_Binary(Source_Counter)
        Source_Counter = Source_Counter + 1
        If (Binary_Byte And &HC0&) <> &H80& Then Exit Function         '// malformed trail byte
        Utf16_Binary(Dest_Counter * 2 + 1) = (((WideChar_Long * (2 ^ 6)) Or (Binary_Byte And &H3F&)) And &HFF00&) \ (2 ^ 8)
        Utf16_Binary(Dest_Counter * 2) = ((WideChar_Long * (2 ^ 6)) Or (Binary_Byte And &H3F&)) And &HFF&
     Else
        Utf16_Binary(Dest_Counter * 2 + 1) = (WideChar_Long And &HFF00&) \ (2 ^ 8)
        Utf16_Binary(Dest_Counter * 2) = WideChar_Long And &HFF&
     End If
     Dest_Counter = Dest_Counter + 1
  Wend
  
  If Dest_Counter >= Utf16_Length \ 2 Then Dest_Counter = Utf16_Length \ 2 - 1
  
  Utf16_Binary(Dest_Counter * 2) = 0                '//Terminal Symbol
  Utf16_Binary(Dest_Counter * 2 + 1) = 0            '//Terminal Symbol
  
  ReDim Preserve Utf16_Binary(Dest_Counter * 2 + 1) '//effective bytes only
  
  Utf8_Decode = Utf16_Binary                        '//Convert binary array to unicode string
End Function

Answer 4

或者你找一個有中文內容的字段,並且把內容讀取到String對象當中再使用一個Byte數組保存下來,然後把相就的值發上來,並且附上原中文的內容,我幫你看一下.
比如說:
Length of Byte Array:6
Binary:E4,B8,AD,E5,9C,8B
String:中國

Answer 5

private function StringToHex(Byval Source As String) as String
   dim LocalBinary() as Byte
   Dim Length as Long
   Dim Counter as long
   dim LocalString() as String
   LocalBinary=Source
   Length=UBound(LocalBinary)+1
   redim LocalString(Length-1)
   for Counter=0 to Length
      LocalString(Counter)=Hex(LocalBinary(Counter))
   next
   StringToHex=Join(LocalString,",")
end function

Answer 6

奇怪,我都没测试出楼主的结果出来,也不知道如何去弄,我不管如何显示一切都正常.
mysql> select *,charset(name) as charset from test\g
+--------------+---------+
| name         | charset |
+--------------+---------+
| utf8数据测试 | utf8    |
+--------------+---------+
1 row in set (0.00 sec)这个我在VB直接使用ADODB.Recordset直接抓出来的也好,使用控件取得的也罢,一切都是正常的中文字符.不过根据楼主所给出的图来看,也确实象是UTF8编码生成的数据,只是我实在没有办法测试出结果,下面是我所使用的版本:
mysql> select version();
+-----------+
| version() |
+-----------+
| 5.0.19-nt |
+-----------+
1 row in set (0.02 sec)
驱动版本为:
MySQL ODBC 3.51 Driver

Answer 7

OS:Microsoft Windows Server 2003 Enterprise Edition Service Pack 1
VB:Visual Basic 6.0 Service Pack 6
ADO:Microsoft ActiveX Data Objects 2.8 Library除以上环境外,我也实在找不出可能存在差异的关键所在了.