当前位置:编程学习 > VB >>

UTF8转unicode问题

我用串口通讯,采集上面是手机名字,传上来的是UTF8字符,转换如果是两个字和四个字没问题,但如果一个字和三个字,最后面一个字是乱码请各位高手帮忙解,急
代码如下
Public m_bIsNt     As Boolean
    
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
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 Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Const CP_UTF8 = 65001
'Purpose:Convert Utf8 to Unicode
Public Function UTF8_Decode(ByRef 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

    If m_bIsNt Then
        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
    Else
        Dim i As Long
        Dim TopIndex As Long
        Dim TwoBytes(1) As String
        Dim ThreeBytes(2) As String
        Dim AByte As Byte
        Dim TStr As String
        Dim BArray() As Byte

        'Resume   on   error   in   case   someone   inputs   text   with   accents
        'that   should   have   been   encoded   as   UTF-8
        On Error Resume Next

        TopIndex = Len(sUTF8)         '   Number   of   bytes   equal   TopIndex+1
        If TopIndex = 0 Then Exit Function  'get out if there's nothing to convert
        BArray = StrConv(sUTF8, vbFromUnicode)
        i = 0       '   Initialise   pointer
        TopIndex = TopIndex - 1
        '   Iterate   through   the   Byte   Array
        Do While i <= TopIndex
          AByte = BArray(i)
          If AByte < &H80 Then
            'Normal   ANSI   character   -   use   it   as   is
            TStr = TStr & Chr$(AByte):           i = i + 1           '   Increment   byte   array   index
        ElseIf AByte >= &HE0 And Val(AByte) <> 255 Then                         'was   =   &HE1   Then
            'Start   of   3   byte   UTF-8   group   for   a   character
            'Copy   3   byte   to   ThreeBytes
            ThreeBytes(0) = BArray(i):       i = i + 1
            ThreeBytes(1) = BArray(i):       i = i + 1
            ThreeBytes(2) = BArray(i):       i = i + 1
              '   Convert   Byte   array   to   UTF-16   then   Unicode
            TStr = TStr & ChrW$((ThreeBytes(0) And &HF) * &H1000 + (ThreeBytes(1) And &H3F) * &H40 + (ThreeBytes(2) And &H3F))
        ElseIf (AByte >= &HC2) And (AByte <= &HDB) Then
                '   Start   of   2   byte   UTF-8   group   for   a   character
            TwoBytes(0) = BArray(i):       i = i + 1
            TwoBytes(1) = BArray(i):       i = i + 1
              '   Convert   Byte   array   to   UTF-16   then   Unicode
            TStr = TStr & ChrW$((TwoBytes(0) And &H1F) * &H40 + (TwoBytes(1) And &H3F))
        Else
                '   Normal   ANSI   character   -   use   it   as   is
              TStr = TStr & Chr$(AByte): i = i + 1 'Increment byte array index
          End If
        Loop
        UTF8_Decode = TStr 'Return the resultant string
        Erase BArray
    End If

EndFunction:

End Function 我也是这个问题哦
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 Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
'常用的代码页:
const cpUTF8   =65001
const cpGB2312 =  936
const cpGB18030=54936
const cpUTF7   =65000
Function MultiByteToUTF16(UTF8() As Byte, CodePage As Long) As String
    Dim bufSize As Long
    bufSize = MultiByteToWideChar(CodePage, 0&, UTF8(0), UBound(UTF8) + 1, 0, 0)
    MultiByteToUTF16 = Space(bufSize)
    MultiByteToWideChar CodePage, 0&, UTF8(0), UBound(UTF8) + 1, StrPtr(MultiByteToUTF16), bufSize
End Function

Function UTF16ToMultiByte(UTF16 As String, CodePage As Long) As Byte()
    Dim bufSize As Long
    Dim arr() As Byte
    bufSize = WideCharToMultiByte(CodePage, 0&, StrPtr(UTF16), Len(UTF16), 0, 0, 0, 0)
    ReDim arr(bufSize - 1)
    WideCharToMultiByte CodePage, 0&, StrPtr(UTF16), Len(UTF16), arr(0), bufSize, 0, 0
    UTF16ToMultiByte = arr
End Function

Private Sub Command1_Click()
    MsgBox MultiByteToUTF16(UTF16ToMultiByte("ab中,c", cpUTF8), cpUTF8)
End Sub

补充:VB ,  API
CopyRight © 2012 站长网 编程知识问答 www.zzzyk.com All Rights Reserved
部份技术文章来自网络,