【VB6】不借助API将UTF-8编码的字符串解码为VB6能识别的字符串

0xAA55 · 发表于 2017-11-23 10:50:47

欢迎访问技术宅的结界，请注册或者登录吧。

您需要登录才可以下载或查看，没有账号？立即注册→加入我们

×

Private Function utf8toString(utf8byte() As Byte) As String
Dim I&
Dim charcode As Long
Dim cb As Long
cb = UBound(utf8byte) + 1
Do While I < cb
If (utf8byte(I) And &HFE) = &HFC& Then '1111110x
If I + 6 <= cb Then
charcode = _
((utf8byte(I + 0) And &H1&) * &H40000000) Or _
((utf8byte(I + 1) And &H3F&) * &H1000000) Or _
((utf8byte(I + 2) And &H3F&) * &H40000) Or _
((utf8byte(I + 3) And &H3F&) * &H1000&) Or _
((utf8byte(I + 4) And &H3F&) * &H40&) Or _
((utf8byte(I + 5) And &H3F&))
I = I + 6
Else
Exit Do
End If
ElseIf (utf8byte(I) And &HFC) = &HF8& Then '111110xx
If I + 5 <= cb Then
charcode = _
((utf8byte(I + 0) And &H3&) * &H1000000) Or _
((utf8byte(I + 1) And &H3F&) * &H40000) Or _
((utf8byte(I + 2) And &H3F&) * &H1000&) Or _
((utf8byte(I + 3) And &H3F&) * &H40&) Or _
((utf8byte(I + 4) And &H3F&))
I = I + 5
Else
Exit Do
End If
ElseIf (utf8byte(I) And &HF8) = &HF0& Then '11110xxx
If I + 4 <= cb Then
charcode = _
((utf8byte(I + 0) And &H7&) * &H40000) Or _
((utf8byte(I + 1) And &H3F&) * &H1000&) Or _
((utf8byte(I + 2) And &H3F&) * &H40&) Or _
((utf8byte(I + 3) And &H3F&))
I = I + 4
Else
Exit Do
End If
ElseIf (utf8byte(I) And &HF0) = &HE0& Then '1110xxxx
If I + 3 <= cb Then
charcode = _
((utf8byte(I + 0) And &HF&) * &H1000&) Or _
((utf8byte(I + 1) And &H3F&) * &H40&) Or _
((utf8byte(I + 2) And &H3F&))
I = I + 3
Else
Exit Do
End If
ElseIf (utf8byte(I) And &HE0) = &HC0& Then '110xxxxx
If I + 2 <= cb Then
charcode = _
((utf8byte(I + 0) And &H1F&) * &H40&) Or _
((utf8byte(I + 1) And &H3F&))
I = I + 2
Else
Exit Do
End If
ElseIf (utf8byte(I) And &HC0) = &H80& Then '10xxxxxx
'遇到高2位是10的字符，这是不应该出现的。
Exit Do
ElseIf (utf8byte(I) And &H80) = &H0& Then '&Hxxxxxx
charcode = utf8byte(I) And &H7F
I = I + 1
Else
Exit Do
End If
utf8toString = utf8toString & ChrW(charcode)
Loop
End Function

复制代码

Gamma · 发表于 2017-11-23 16:10:11

拜模已经不足以对你的表达了

xiawan · 发表于 2022-5-9 15:56:52

楼主大能，感谢感谢

smartgkk · 发表于 2023-9-26 18:30:54

谢谢A5的分享，HAHA...

tlwh163 · 发表于 2023-10-9 18:16:56

本帖最后由 tlwh163 于 2023-10-9 18:17 编辑

''1. 不会出现的字节:    0xC0, 0xC1, 0xF5-0xFF
''2. 字符的第1个字节值域:  0-0x7F(ANSI), 0xC2-0xF4(UTF8)
''3. 字符的第2+个字节值域:  0x80-0xBF

tlwh163 · 发表于 2024-6-9 22:03:50

手头没有VB6 用VFB写的也没法调试逻辑纯靠脑补...

Function VB6_UTF8_TO_STRING(UTF8() As Byte, Optional ByVal nByte As Long = -1) As String
If UBound(UTF8) = -1 Or nByte = 0 Then Exit Function
Dim Buf() As Byte, k As Long ''输出缓存,缓存字节计数器
Dim i As Long, j As Long    ''状态量(j=0初始态; j=[1-5]UTF8后续字节数)
Dim c As Long ''UNICODE缓冲
ReDim Buf(0 To UBound(UTF8) - LBound(UTF8) + 1)
For i = LBound(UTF8) To UBound(UTF8)
      Select Case UTF8(i)
         Case &H1 To &H7F    ''ANSI
            If j <> 0 Then Exit For
            Buf(k) = UTF8(i) : k = k + 1
         Case &H80 To &HBF    ''UTF8的后续字节: 10xxxxxx
            j = j - 1 : If j < 0 Then Exit For
            ''UNICODE左移6位 + UTF8低6位
            c = (c * &H40& ) Or (UTF8(i) And &H3F)
            If j = 0 Then
                  Buf(k) = (c And &HFF&) : k = k + 1
                  Buf(k) = ((c And &HFF00&) \ &H100&) : k = k + 1
                  If c > &H10000 Then       ''多字节可能会出现UTF32
                     Buf(k) = ((c And &HFF0000) \ &H10000&) : k = k + 1
                     Buf(k) = ((c And &HFF000000) \ &H1000000&) : k = k + 1
                  End If : c = 0
            End If
         Case &HC0 To &HFD    ''UTF8的首字节
            If j <> 0 Then Exit For
            Select Case UTF8(i)
                  Case &HD0 To &HDF       ''3字节: 1110xxxx
                     j = 2 : c = (UTF8(i) And &H0F)
                  Case &HF0 To &HF7       ''4字节: 11110xxx
                     j = 3 : c = (UTF8(i) And &H07)
                  Case &HC0 To &HCF       ''2字节: 110xxxxx
                     j = 1 : c = (UTF8(i) And &H1F)
                  Case &HF8 To &HFB       ''5字节: 111110xx
                     j = 4 : c = (UTF8(i) And &H03)
                  Case &HFC To &HFD       ''6字节: 1111110x
                     j = 5 : c = (UTF8(i) And &H01)
            End Select
         Case 0             ''终止符\0
            If nByte > 0 Then j = -1    ''数据中出现了0,设置为错误状态
            Exit For                      ''否则认为读完了全部数据,总之必须退出
         Case Else          ''其它非法字符
            j = -1 : Exit For
      End Select
      nByte = nByte - 1 : If nByte = 0 Then Exit For
Next
''If j <> 0 Then
''  Debug.Print "转换过程中检测到非法的字符数据"
''  Exit Function
''End If
If k > 0 Then ''最大限度输出转换的结果
      ReDim Preserve Buf(0 To k - 1)
      VB6_UTF8_TO_STRING = Buf ''这要StrConv吗?
End If       ''最后1个字符可能乱码(解决的办法是再增加一个字符数计数器)
End Function

账号		自动登录	找回密码
密码			立即注册→加入我们

【VB6】不借助API将UTF-8编码的字符串解码为VB6能识别的字符串

欢迎访问技术宅的结界，请注册或者登录吧。

本帖被以下淘专辑推荐:

相关帖子