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 FunctionPublic 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“提示类型不对，出错中断不知道是不是代码有错。求救。
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 FunctionPublic 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 = byteUnicode
End 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 = byteGB2312
End Function