最新消息:Rockyxia Web技术博客全新改版,响应式布局满足各种设备各种尺寸的访问需求。

asp的URL解码函数URLDecode,可以直接使用

后台开发语言 rockyxia 8381浏览 0评论

20160804更新一个更简洁的函数在后面

URL编码是我们经常要做的事,都是中文的原因哈,在javascript和php等语言中都有定义好的URL解码函数URLDecode,但是asp中却没有定义好这个函数,如果需要我们还得自己写到我们的函数文件中去,今天给大家分享一个功能全的asp的URL解码函数URLDecode!直接上代码,以下代码可以直接复制到文件中使用!

'================================================ 
'函数名: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 
    
    b0 = Array(192,224,240,248,252,254) 
    urlcode = Replace(urlcode,"+"," ") 
    pass = 0 
    utf8 = -1 
    
    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

20160804更新一个更加简洁的函数

'url解码
function URLDecode(strIn)
    URLDecode = ""
    Dim sl: sl = 1
    Dim tl: tl = 1
    Dim key: key = "%"
    Dim kl: kl = Len(key)
    sl = InStr(sl, strIn, key, 1)
    Do While sl>0
        If (tl=1 And sl<>1) Or tl<sl Then
            URLDecode = URLDecode & Mid(strIn, tl, sl-tl)
        End If
        Dim hh, hi, hl
        Dim a
        Select Case UCase(Mid(strIn, sl+kl, 1))
            Case "U":'Unicode URLEncode
                a = Mid(strIn, sl+kl+1, 4)
                URLDecode = URLDecode & ChrW("&H" & a)
                sl = sl + 6
            Case "E":'UTF-8 URLEncode
                hh = Mid(strIn, sl+kl, 2)
                a = Int("&H" & hh)'ascii码
                If Abs(a)<128 Then
                    sl = sl + 3
                    URLDecode = URLDecode & Chr(a)
                Else
                    hi = Mid(strIn, sl+3+kl, 2)
                    hl = Mid(strIn, sl+6+kl, 2)
                    a = ("&H" & hh And &H0F) * 2 ^12 Or ("&H" & hi And &H3F) * 2 ^ 6 Or ("&H" & hl And &H3F)
                If a<0 Then a = a + 65536
                    URLDecode = URLDecode & ChrW(a)
                    sl = sl + 9
                End If
            Case Else:'Asc URLEncode
                hh = Mid(strIn, sl+kl, 2)'高位
                a = Int("&H" & hh)'ascii码
                If Abs(a)<128 Then
                    sl = sl + 3
                Else
                    hi = Mid(strIn, sl+3+kl, 2)'低位
                    a = Int("&H" & hh & hi)'非ascii码
                    sl = sl + 6
                End If
                URLDecode = URLDecode & Chr(a)
        End Select
        tl = sl
        sl = InStr(sl, strIn, key, 1)
    Loop
    URLDecode = URLDecode & Mid(strIn, tl)
End function

转载请注明:Rockyxia Web技术博客 » asp的URL解码函数URLDecode,可以直接使用
感谢阅读,如果您发现文章中有表述不准确,欢迎提出来,也欢迎交流相关问题,你可以去这里进行一对一问答交流。

(本篇完)