Question

VB utf8转unicode的代码！要汉字不会乱码的！

急求一个utf8转unicode的代码！要转换后汉字不会乱码、问号、漏字的。要能完美转换汉字！在网上都快翻遍了也没找到好的，都是会乱码、漏字、出问号。急求！如果能完美解决再加分！

Answer 1

试下这个代码 如果你的UTF8 没有错误编码 应该不会错
Private BasicChr() As Byte = {&H80, &H40, &H20, &H10, &H8, &H4}
Function UTFToUnicode(bytes() As Byte) As String
On Error Resume Next
Dim l As long,i as long,j as long
l = UBound(bytes)
Dim s As String
s = ""
For i = 0 To l
Dim index As long
Dim b As long
For index = 0 To UBound(BasicChr)
If (bytes(i) And BasicChr(index)) = 0 Then Exit For
Next
b = bytes(i)
If index > 1 Then
For j = 1 To index - 1
If (bytes(i + j) And &HC0) = &H80 Then
' b = (b << 6) Or (bytes(i + j) And &H3F)
b = (b * &H40) Or (bytes(i + j) And &H3F)
Else
MsgBox("不是UTF编码 :&H" & Hex(bytes(i + j)))
End If
Next
i += index - 1
End If
Select Case index
Case 0
b = b And &H7F
Case 1 '
Case 2
b = b And &H7FF
Case 3
b = b And &HFFFF
Case 4
b = b And &H1FFFFF
Case 5
b = b And &H3FFFFFF
Case 6
b = b And &H7FFFFFFF
End Select
s = s & ChrW(b)
's &= ChrW(b)
Next
UTFToUnicode = s
'Return s
End Function

追问

第一句就是错的
还有这句 i += index - 1 这句是VB.NET代码吧

追答

嗯 现在不经常用vb了 都vb.net 做的 下面的就可以了 已经修改 试验 通过
Function UTFToUnicode(bytes() As Byte) As String
Static BasicChr(5) As Byte, islond As Boolean
If Not islond Then
BasicChr(0) = &H80
BasicChr(1) = &H40
BasicChr(2) = &H20
BasicChr(3) = &H10
BasicChr(4) = &H8
BasicChr(5) = &H4
islond = True
End If
On Error Resume Next
Dim l As Long, i As Long
l = UBound(bytes)
Dim s As String
s = ""
For i = 0 To l
Dim index As Long
Dim b As Long, j As Long
For index = 0 To UBound(BasicChr)
If (bytes(i) And BasicChr(index)) = 0 Then Exit For
Next
b = bytes(i)
If index > 1 Then
For j = 1 To index - 1
If (bytes(i + j) And &HC0) = &H80 Then
b = (b * &H40) Or (bytes(i + j) And &H3F)
Else
MsgBox ("不是UTF编码 :&H" & Hex(bytes(i + j)))
End If
Next
i = i + index - 1
End If
Select Case index
Case 0: b = b And &H7F&
Case 1 '
Case 2: b = (b And &H7FF&)
Case 3: b = (b And &HFFFF&)
Case 4: b = (b And &H1FFFFF)
Case 5: b = (b And &H3FFFFFF)
Case 6: b = (b And &H7FFFFFFF)
End Select
s = s & ChrW(b)
Next
UTFToUnicode = s
End Function

追问

还是有很多汉字是半角问号

追答

你发一下你的符号 如果还有 感觉就是你接收字符问题 如果你是从文本文件读取的 前面有标记字符
Function BytesToHex(ByVal bytes() As Byte) As String
Dim s As String ,i As Byte
For Each i In bytes
s = s & IIf(i > 9, "", "0") & Hex(i) & ","
Next
BytesToHex = s
End Function
你可以发一下你的十六进制码! 分析一下

追问

我是GET获取到的，这是协议头

HTTP/1.1 200 OK
Date: Fri, 18 Jan 2013 01:24:10 GMT
Server: Apache
Set-Cookie: PHPSESSID=0rmadcfu5772v367i4ma7mjf21; path=/
Expires: Thu, 19 Nov 1981 08:52:00 GMT
Cache-Control: no-store, no-cache, must-revalidate, post-check=0, pre-check=0
Pragma: no-cache
Vary: Accept-Encoding
Content-Length: 2474
Connection: close
Content-Type: text/xml; charset=UTF-8

追答

哎!这个还真不好解决啊,上面的代码我是根据百科中的
http://baike.baidu.com/view/25412.htm
写的.可能标准不一样照成的吧.
下面再给一个转码,这个系统API的转的.如果再有乱码我还真的没有办法了
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 Const CP_UTF8 = 65001
Function Utf8ToUnicode(ByRef Utf() As Byte) As String
Dim lRet As Long
Dim lLength As Long
Dim lBufferSize As Long
lLength = UBound(Utf) - LBound(Utf) + 1
If lLength 0 Then
Utf8ToUnicode = Left(Utf8ToUnicode, lRet)
Else
Utf8ToUnicode = ""
End If
End Function

追问

还是不行，还是有很多字变成半角问号。有人说是StrConv函数造成的原因是吗？

追答

你获取的数据你确定是没有修改过的.如果是网页地址类的 会加如 % 号要去掉的.你获取的数据不加修改直接传给函数试一下.如果再不行有 可能就是你数据的问题 .如果你转码后的数据 是对你原数据 有时有正确的有时又乱码.那就是发送的码符有错误.

Answer 2

Function Utf8ToUnicode(ByRef Utf() As Byte) As String
Dim utfLen As Long

utfLen = -1
On Error Resume Next
utfLen = UBound(Utf)
If utfLen = -1 Then Exit Function

On Error GoTo 0

Dim i As Long, j As Long, k As Long, N As Long
Dim B As Byte, cnt As Byte
Dim Buf() As String
ReDim Buf(utfLen)

i = 0
j = 0
Do While i <= utfLen
B = Utf(i)

If (B And &HFC) = &HFC Then
cnt = 6
ElseIf (B And &HF8) = &HF8 Then
cnt = 5
ElseIf (B And &HF0) = &HF0 Then
cnt = 4
ElseIf (B And &HE0) = &HE0 Then
cnt = 3
ElseIf (B And &HC0) = &HC0 Then
cnt = 2
Else
cnt = 1
End If

If i + cnt - 1 > utfLen Then
Buf(j) = "?"
Exit Do
End If

Select Case cnt
Case 2
N = B And &H1F
Case 3
N = B And &HF
Case 4
N = B And &H7
Case 5
N = B And &H3
Case 6
N = B And &H1
Case Else
Buf(j) = Chr(B)
GoTo Continued:
End Select

For k = 1 To cnt - 1
B = Utf(i + k)
N = N * &H40 + (B And &H3F)
Next

Buf(j) = ChrW(N)
Continued:
i = i + cnt
j = j + 1
Loop

Utf8ToUnicode = Join(Buf, "")
End Function

追问

还是不行，有些字是乱码，例如UTF8的“邀请”，转换成unicode之后就变成“邀诿”

追答

这个已经是很好的啦。

追问

可是我很多关键的字都变成乱码了，很头疼

Answer 3

编码是什么？能贴出来吗？最好是字节数组，我看看转换后的结果

追问

UTF-8编码，VB通过winsock get到的

追答

你能贴出来一部分吗？类似于A8 06 C9 AD.....这样的16进制码，我有一些转换的代码，看能不能百分之百正确转换

追问

没有，获取到的数据，数字、半角符号、英文在VB中都是显示正常的，然后汉字、全角符号全是乱码，通过有些utf8转码的代码转码之后，有少部分汉字还是乱码或半角问号

追答

贴不出来？那我也没办法了