Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
888 views
in Technique[技术] by (71.8m points)

utf 8 - How can I decode UTF8 in Visual Basic 6?

How can I decode UTF-8 in Visual Basic 6?

I am having a problem where ANSI 127 and greater are not being properly decoded for whatever reason.

For instance, ? gets decoded into ? and I'm not sure why.

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

Here's what I've done. Use the MultiByteToWide Char like Comintern said to:

Private Const CP_UTF8 As Long = 65001 ' UTF-8 Code Page

'Sys call to convert multiple byte chars to a char
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

Note that I've specified the windows code page, meaning the character set we are working with is UTF-8 Unicode.

Next here is my Decode function. I've called it DecodeURI:

'------------------------------------------------------------------
' NAME:         DecodeURI (PUBLIC)
' DESCRIPTION:  Decodes a UTF8 encoded string
' CALLED BY:    HandleNavigate
' PARAMETERS:
'  EncodedURL (I,REQ) - the UTF-8 encoded string to decode
' RETURNS:      the the decoded UTF-8 string
'------------------------------------------------------------------
Private Function DecodeURI(ByVal EncodedURI As String) As String
    Dim bANSI() As Byte
    Dim bUTF8() As Byte
    Dim lIndex As Long
    Dim lUTFIndex As Long

    If Len(EncodedURI) = 0 Then
        Exit Function
    End If

EncodedURI = Replace$(EncodedURI, "+", " ")         ' In case encoding isn't used.
    bANSI = StrConv(EncodedURI, vbFromUnicode)          ' Convert from unicode text to ANSI values
    ReDim bUTF8(UBound(bANSI))                          ' Declare dynamic array, get length
    For lIndex = 0 To UBound(bANSI)                     ' from 0 to length of ANSI
        If bANSI(lIndex) = &H25 Then                    ' If we have ASCII 37, %, then
            bUTF8(lUTFIndex) = Val("&H" & Mid$(EncodedURI, lIndex + 2, 2)) ' convert hex to ANSI
            lIndex = lIndex + 2                         ' this character was encoded into two bytes
        Else
            bUTF8(lUTFIndex) = bANSI(lIndex)            ' otherwise don't need to do anything special
        End If
        lUTFIndex = lUTFIndex + 1                       ' advance utf index
    Next
    DecodeURI = FromUTF8(bUTF8, lUTFIndex)              ' convert to string
End Function

And converting from UTF-8 using the system call:

'------------------------------------------------------------------
' NAME:         FromUTF8 (Private)
' DESCRIPTION:  Use the system call MultiByteToWideChar to
'               get chars using more than one byte and return
'               return the whole string
' CALLED BY:    DecodeURI
' PARAMETERS:
'  UTF8 (I,REQ)   - the ID of the element to return
'  Length (I,REQ) - length of the string
' RETURNS:      the full raw data of this field
'------------------------------------------------------------------
Private Function FromUTF8(ByRef UTF8() As Byte, ByVal Length As Long) As String
    Dim lDataLength As Long

    lDataLength = MultiByteToWideChar(CP_UTF8, 0, VarPtr(UTF8(0)), Length, 0, 0)  ' Get the length of the data.
    FromUTF8 = String$(lDataLength, 0)                                         ' Create array big enough
    MultiByteToWideChar CP_UTF8, 0, VarPtr(UTF8(0)), _
                        Length, StrPtr(FromUTF8), lDataLength                  '
End Function

Hope that helps! I tested it with your character and it appeared to work (as all characters should).


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...