UTF8的url解码问题%C2%B7这个中文符号转换错误
Public Function UTF8_URLEncoding(szInput)
Dim wch, uch, szRet
Dim x
Dim nAsc, nAsc2, nAsc3
If szInput = "" Then
UTF8_URLEncoding = szInput
Exit Function
End If
For x = 1 To Len(szInput)
wch = Mid(szInput, x, 1)
nAsc = AscW(wch)
If nAsc < 0 Then nAsc = nAsc + 65536
If (nAsc And &HFF80) = 0 Then
szRet = szRet & wch
Else
If (nAsc And &HF000) = 0 Then
uch = "%" & Hex(((nAsc \ 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80)
szRet = szRet & uch
Else
uch = "%" & Hex((nAsc \ 2 ^ 12) Or &HE0) & "%" & _
Hex((nAsc \ 2 ^ 6) And &H3F Or &H80) & "%" & _
Hex(nAsc And &H3F Or &H80)
szRet = szRet & uch
End If
End If
Next
UTF8_URLEncoding = szRet
End Function
Public Function UTF8_UrlDecode(ByVal URL As String)
'On Error Resume Next
Dim B, ub ''中文字的Unicode码(2字节)
Dim UtfB ''Utf-8单个字节
Dim UtfB1, UtfB2, UtfB3 ''Utf-8码的三个字节
Dim i, n, s
n = 0
ub = 0
For i = 1 To Len(URL)
B = Mid(URL, i, 1)
Select Case B
Case "+"
s = s & " "
Case "%"
ub = Mid(URL, i + 1, 2)
UtfB = CInt("&H" & ub)
If UtfB < 128 Then
i = i + 2
s = s & ChrW(UtfB)
Else
UtfB1 = (UtfB And &HF) * &H1000 ''取第1个Utf-8字节的二进制后4位
UtfB2 = (CInt("&H" & Mid(URL, i + 4, 2)) And &H3F) * &H40 ''取第2个Utf-8字节的二进制后6位
UtfB3 = CInt("&H" & Mid(URL, i + 7, 2)) And &H3F ''取第3个Utf-8字节的二进制后6位
s = s & ChrW(UtfB1 Or UtfB2 Or UtfB3)
i = i + 8
End If
Case Else ''Ascii码
s = s & B
End Select
Next
UTF8_UrlDecode = s
End Function
上面两段代码，UTF8_URLEncoding输入字符“·”这个中文符号，转换出来是%C2B7（实际是%C2%B7），用UTF8_UrlDecode解码“%C2%B7“提示类型不对，出错中断。。。
不知道是不是代码有错。求救。。。。
[解决办法]
'====================================================================================================' User in the class custom's funtion dispose process ( 自定义函数及处理过程 )'===================================================================================================='----------------------------------------------------------------' Function Name: UTF8ToUnicode' Input Parameter: funUTF8(Byte Array) - The UTF-8's byte array' Return Value: (Byte Array) - Return Unicode's byte array' Description : Visual Basic compile's conversion the UTF-8 to Unicode dispose process' Author : SupermanKing'----------------------------------------------------------------Function UTF8ToUnicode(ByRef funUTF8() As Byte) As Byte() '==================== 变量定义 ==================== Dim lngLength As Long Dim lngLengthB As Long Dim lngUTF8Char As Long Dim intWChar As Integer Dim byteTemp As Byte Dim byteBit As Byte Dim byteUnicode() As Byte Dim lngUTF8Count As Long Dim i As Long Dim j As Long On Error Resume Next ' 开始设置错误陷阱，防止程序发生意外错误而崩溃 '==================== 初始化变量 ==================== lngLengthB = 0 '==================== 校验输入参数 ==================== lngLength = UBound(funUTF8) + 1 If Err.Number <> 0 Then Err.Clear Exit Function End If '==================== 开始循环处理编码转换过程 ==================== For i = 0 To lngLength - 1 '-------------------- 根据 UTF-8 编码规则数 UTF-8 字符的存储个数 -------------------- lngUTF8Count = 0 byteTemp = funUTF8(i) For j = 1 To 7 byteBit = Int(byteTemp / (2 ^ (8 - j))) '二进制位向右偏移 (8 - j) 个二进制位 byteBit = byteBit And 1 '取最后一个二进制位值 If byteBit = 1 Then lngUTF8Count = lngUTF8Count + 1 Else '碰到0就结束数字符数操作 Exit For End If Next j '-------------------- 判断编码内存储的内容是否是经过编码的 -------------------- If lngUTF8Count < 2 Or lngUTF8Count > 3 Then '---------- 没有经过 UTF-8 格式编码，直接转换成 Unicode 编码 ---------- If lngLengthB = 0 Then lngLengthB = 2 ReDim byteUnicode(lngLengthB - 1) Else lngLengthB = lngLengthB + 2 ReDim Preserve byteUnicode(lngLengthB - 1) End If byteUnicode(lngLengthB - 2) = byteTemp Else '---------- 经过 UTF-8 格式编码，先读出内容后再转换成 Unicode 编码 ---------- ' 读出这几个UTF-8字节内容 For j = 0 To lngUTF8Count - 1 byteTemp = funUTF8(i + j) If j = 0 Then '第一个UTF-8编码含编码字节信息，所以取存储信息特别点 byteTemp = byteTemp And ((2 ^ (8 - (lngUTF8Count + 1))) - 1) lngUTF8Char = byteTemp Else '后面的只取6个二进制位 byteTemp = byteTemp And &H3F lngUTF8Char = lngUTF8Char * &H40 '向左偏移6位好存储后面的6位数据 lngUTF8Char = lngUTF8Char Or byteTemp '将低6位的数据补充到编码中 End If Next j ' 已经取出Unicode编码到 lngUTF8Char 里 If lngLengthB = 0 Then lngLengthB = 2 ReDim byteUnicode(lngLengthB - 1) Else lngLengthB = lngLengthB + 2 ReDim Preserve byteUnicode(lngLengthB - 1) End If byteUnicode(lngLengthB - 2) = lngUTF8Char And 255 byteUnicode(lngLengthB - 1) = Int(lngUTF8Char / (2 ^ 8)) And 255 i = i + (lngUTF8Count - 1) End If If i > (lngLength - 1) Then Exit For End If Next i '==================== 完成编码转换过程，返回数据 ==================== UTF8ToUnicode = byteUnicodeEnd Function'----------------------------------------------------------------' Function Name: UnicodeToGB2312' Input Parameter: funUnicode(Byte Array) - The Unicode's byte array' Return Value: (Byte Array) - Return GB2312's byte array' Description : Visual Basic compile's conversion the Unicode to GB2312 dispose process' Author : SupermanKing'----------------------------------------------------------------Function UnicodeToGB2312(ByRef funUnicode() As Byte) As Byte() '==================== 变量定义 ==================== Dim lngLength As Long Dim lngLengthB As Long Dim byteGB2312() As Byte Dim i As Long Dim intWChar As Integer Dim intChar As Integer On Error Resume Next ' 开始设置错误陷阱，防止程序发生意外错误而崩溃 '==================== 初始化变量 ==================== lngLengthB = 0 '==================== 校验输入参数 ==================== lngLength = UBound(funUnicode) + 1 If Err.Number <> 0 Then Err.Clear Exit Function End If lngLength = lngLength / 2 '==================== 开始循环处理编码转换过程 ==================== For i = 0 To lngLength - 1 CopyMemory intWChar, funUnicode(i * 2), 2 intChar = Asc(StrConv(ChrW(intWChar), vbNarrow)) If intChar < 0 Or intChar > 255 Then If lngLengthB = 0 Then lngLengthB = 2 ReDim byteGB2312(lngLengthB - 1) byteGB2312(lngLengthB - 1) = intChar And 255 byteGB2312(lngLengthB - 2) = Int(CLng("&H" & Hex(intChar)) / (2 ^ 8)) And 255 Else lngLengthB = lngLengthB + 2 ReDim Preserve byteGB2312(lngLengthB - 1) byteGB2312(lngLengthB - 1) = intChar And 255 byteGB2312(lngLengthB - 2) = Int(CLng("&H" & Hex(intChar)) / (2 ^ 8)) And 255 End If Else If lngLengthB = 0 Then lngLengthB = 1 ReDim byteGB2312(lngLengthB - 1) byteGB2312(lngLengthB - 1) = CByte(intChar) Else lngLengthB = lngLengthB + 1 ReDim Preserve byteGB2312(lngLengthB - 1) byteGB2312(lngLengthB - 1) = CByte(intChar) End If End If Next i '==================== 完成编码转换过程，返回数据 ==================== UnicodeToGB2312 = byteGB2312End Function