如果我們想將%BD%C5%B1%BE%D6%AE%BC%D2還原為中文，使用下面的函數即可。 % response.write urldecode("http://www.baidu.com/s?cl=3wd=%BD%C5%B1%BE%D6%AE%BC%D2") '================================================ '函數名：URLDecode '作 用：URL解碼 '================================================ Function URLDecode(ByVal urlcode) Dim start,final,length,char,i,butf8,pass Dim leftstr,rightstr,finalstr Dim b0,b1,bx,blength,position,u,utf8 On Error Resume Next
length = Len(urlcode) : start = InStr(urlcode,"%") : final = InStrRev(urlcode,"%") If start = 0 Or length 3 Then URLDecode = urlcode : Exit Function leftstr = Left(urlcode,start - 1) : rightstr = Right(urlcode,length - 2 - final)
For i = start To final char = Mid(urlcode,i,1) If char = "%" Then bx = URLDecode_Hex(Mid(urlcode,i + 1,2)) If bx > 31 And bx 128 Then i = i + 2 finalstr = finalstr ChrW(bx) ElseIf bx > 127 Then i = i + 2 If utf8 0 Then butf8 = 1 : blength = -1 : b1 = bx For position = 4 To 0 Step -1 If b1 >= b0(position) And b1 b0(position + 1) Then blength = position Exit For End If Next If blength > -1 Then For position = 0 To blength b1 = URLDecode_Hex(Mid(urlcode,i + position * 3 + 2,2)) If b1 128 Or b1 > 191 Then butf8 = 0 : Exit For Next Else butf8 = 0 End If If butf8 = 1 And blength = 0 Then butf8 = -2 If butf8 > -1 And utf8 = -2 Then i = start - 1 : finalstr = "" : pass = 1 utf8 = butf8 End If If pass = 0 Then If utf8 = 1 Then b1 = bx : u = 0 : blength = -1 For position = 4 To 0 Step -1 If b1 >= b0(position) And b1 b0(position + 1) Then blength = position b1 = (b1 xOr b0(position)) * 64 ^ (position + 1) Exit For End If Next If blength > -1 Then For position = 0 To blength bx = URLDecode_Hex(Mid(urlcode,i + 2,2)) : i = i + 3 If bx 128 Or bx > 191 Then u = 0 : Exit For u = u + (bx And 63) * 64 ^ (blength - position) Next If u > 0 Then finalstr = finalstr ChrW(b1 + u) End If Else b1 = bx * h100 : u = 0 bx = URLDecode_Hex(Mid(urlcode,i + 2,2)) If bx > 0 Then u = b1 + bx i = i + 3 Else If Left(urlcode,1) = "%" Then u = b1 + Asc(Mid(urlcode,i + 3,1)) i = i + 2 Else u = b1 + Asc(Mid(urlcode,i + 1,1)) i = i + 1 End If End If finalstr = finalstr Chr(u) End If Else pass = 0 End If End If Else finalstr = finalstr char End If Next URLDecode = leftstr finalstr rightstr End Function
Function URLDecode_Hex(ByVal h) On Error Resume Next h = "h" Trim(h) : URLDecode_Hex = -1 If Len(h) > 4 Then Exit Function If isNumeric(h) Then URLDecode_Hex = cInt(h) End Function %>
