VB 网址链接中的编码函数 GBK及UTF-8 编码解码

n69l67399

1. VB 网址链接中的编码函数      编码解码GBK及UTF-8
   
2. 
   
3. 'UTF-8 URL编码
   
4. Public Function UTF8_URLEncoding(szInput)
   
5.     Dim wch, uch, szRet
   
6.     Dim x
   
7.     Dim nAsc, nAsc2, nAsc3
   
8.     If szInput = "" Then
   
9.         UTF8_URLEncoding = szInput
   
10.         Exit Function
    
11.     End If
    
12.     For x = 1 To Len(szInput)
    
13.         wch = Mid(szInput, x, 1)
    
14.         nAsc = AscW(wch)
    
15.       
    
16.         If nAsc < 0 Then nAsc = nAsc + 65536
    
17.       
    
18.         If (nAsc And &HFF80) = 0 Then
    
19.             szRet = szRet & wch
    
20.         Else
    
21.             If (nAsc And &HF000) = 0 Then
    
22.                 uch = "%" & Hex(((nAsc \ 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80)
    
23.                 szRet = szRet & uch
    
24.             Else
    
25.                 uch = "%" & Hex((nAsc \ 2 ^ 12) Or &HE0) & "%" & _
    
26.                 Hex((nAsc \ 2 ^ 6) And &H3F Or &H80) & "%" & _
    
27.                 Hex(nAsc And &H3F Or &H80)
    
28.                 szRet = szRet & uch
    
29.             End If
    
30.         End If
    
31.     Next
    
32.     UTF8_URLEncoding = szRet
    
33. End Function
    
34. 
    
35. 
    
36. 'UTF-8 URL解码
    
37. Public Function UTF8_UrlDecode(ByVal URL As String)
    
38.     Dim B, ub   ''中文字的Unicode码(2字节)
    
39.     Dim UtfB    ''Utf-8单个字节
    
40.     Dim UtfB1, UtfB2, UtfB3 ''Utf-8码的三个字节
    
41.     Dim i, n, s
    
42.     n = 0
    
43.     ub = 0
    
44.     For i = 1 To Len(URL)
    
45.         B = Mid(URL, i, 1)
    
46.         Select Case B
    
47.             Case "+"
    
48.                 s = s & " "
    
49.             Case "%"
    
50.                 ub = Mid(URL, i + 1, 2)
    
51.                 UtfB = CInt("&H" & ub)
    
52.                 If UtfB < 128 Then
    
53.                     i = i + 2
    
54.                     s = s & ChrW(UtfB)
    
55.                 Else
    
56.                     UtfB1 = (UtfB And &HF) * &H1000   ''取第1个Utf-8字节的二进制后4位
    
57.                     UtfB2 = (CInt("&H" & Mid(URL, i + 4, 2)) And &H3F) * &H40      ''取第2个Utf-8字节的二进制后6位
    
58.                     UtfB3 = CInt("&H" & Mid(URL, i + 7, 2)) And &H3F      ''取第3个Utf-8字节的二进制后6位
    
59.                     s = s & ChrW(UtfB1 Or UtfB2 Or UtfB3)
    
60.                     i = i + 8
    
61.                 End If
    
62.             Case Else    ''Ascii码
    
63.                 s = s & B
    
64.         End Select
    
65.     Next
    
66.     UTF8_UrlDecode = s
    
67. End Function
    
68. 
    
69. 
    
70. 'GBK URL编码
    
71. Public Function URLEncode(ByRef strURL As String) As String
    
72. Dim I As Long
    
73. Dim tempStr As String
    
74. For I = 1 To Len(strURL)
    
75. If Asc(Mid(strURL, I, 1)) < 0 Then
    
76. tempStr = "%" & Right(CStr(Hex(Asc(Mid(strURL, I, 1)))), 2)
    
77. tempStr = "%" & Left(CStr(Hex(Asc(Mid(strURL, I, 1)))), Len(CStr(Hex(Asc(Mid(strURL, I, 1))))) - 2) & tempStr
    
78. URLEncode = URLEncode & tempStr
    
79. ElseIf (Asc(Mid(strURL, I, 1)) >= 65 And Asc(Mid(strURL, I, 1)) <= 90) Or (Asc(Mid(strURL, I, 1)) >= 97 And Asc(Mid(strURL, I, 1)) <= 122) Then
    
80. URLEncode = URLEncode & Mid(strURL, I, 1)
    
81. Else
    
82. URLEncode = URLEncode & "%" & Hex(Asc(Mid(strURL, I, 1)))
    
83. End If
    
84. Next
    
85. End Function
    
86. 
    
87. 
    
88. 'GBK URL解码
    
89. Public Function URLDecode(ByRef strURL As String) As String
    
90. Dim I As Long
    
91. 
    
92. If InStr(strURL, "%") = 0 Then URLDecode = strURL: Exit Function
    
93. 
    
94. For I = 1 To Len(strURL)
    
95. If Mid(strURL, I, 1) = "%" Then
    
96. If Val("&H" & Mid(strURL, I + 1, 2)) > 127 Then
    
97. URLDecode = URLDecode & Chr(Val("&H" & Mid(strURL, I + 1, 2) & Mid(strURL, I + 4, 2)))
    
98. I = I + 5
    
99. Else
    
100. URLDecode = URLDecode & Chr(Val("&H" & Mid(strURL, I + 1, 2)))
     
101. I = I + 2
     
102. End If
     
103. Else
     
104. URLDecode = URLDecode & Mid(strURL, I, 1)
     
105. End If
     
106. Next
     
107. End Function

复制代码

联系我时，请说是在 挂海论坛 上看到的，谢谢！