ASP的URLDecode函数URLEncode解码函数
程序员文章站
2022-06-24 20:26:15
我们知道,ASP的Server对象有个URLEncode方法可以对地址进行编码,但却没有相应的解码函数,下边的这个函数可以实现对URLEncode的解码。下面的代码是从kesion...
我们知道,ASP的Server对象有个URLEncode方法可以对地址进行编码,但却没有相应的解码函数,下边的这个函数可以实现对URLEncode的解码。
下面的代码是从kesion系统扒下的,确实不错,支持utf8格式。
001 ================================================
002 函数名:URLDecode
003 作 用:URL解码
004 ================================================
005 Function URLDecode(ByVal urlcode)
006 Dim start,final,length,char,i,butf8,pass
007 Dim leftstr,rightstr,finalstr
008 Dim b0,b1,bx,blength,position,u,utf8
009 On Error Resume Next
010
011 b0 = Array(192,224,240,248,252,254)
012 urlcode = Replace(urlcode,"+"," ")
013 pass = 0
014 utf8 = -1
015
016 length = Len(urlcode) : start = InStr(urlcode,"%") : final = InStrRev(urlcode,"%")
017 If start = 0 Or length < 3 Then URLDecode = urlcode : Exit Function
018 leftstr = Left(urlcode,start - 1) : rightstr = Right(urlcode,length - 2 - final)
019
020 For i = start To final
021 char = Mid(urlcode,i,1)
022 If char = "%" Then
023 bx = URLDecode_Hex(Mid(urlcode,i + 1,2))
024 If bx > 31 And bx < 128 Then
025 i = i + 2
026 finalstr = finalstr & ChrW(bx)
027 ElseIf bx > 127 Then
028 i = i + 2
029 If utf8 < 0 Then
030 butf8 = 1 : blength = -1 : b1 = bx
031 For position = 4 To 0 Step -1
032 If b1 >= b0(position) And b1 < b0(position + 1) Then
033 blength = position
034 Exit For
035 End If
036 Next
037 If blength > -1 Then
038 For position = 0 To blength
039 b1 = URLDecode_Hex(Mid(urlcode,i + position * 3 + 2,2))
040 If b1 < 128 Or b1 > 191 Then butf8 = 0 : Exit For
041 Next
042 Else
043 butf8 = 0
044 End If
045 If butf8 = 1 And blength = 0 Then butf8 = -2
046 If butf8 > -1 And utf8 = -2 Then i = start - 1 : finalstr = "" : pass = 1
047 utf8 = butf8
048 End If
049 If pass = 0 Then
050 If utf8 = 1 Then
051 b1 = bx : u = 0 : blength = -1
052 For position = 4 To 0 Step -1
053 If b1 >= b0(position) And b1 < b0(position + 1) Then
054 blength = position
055 b1 = (b1 xOr b0(position)) * 64 ^ (position + 1)
056 Exit For
057 End If
058 Next
059 If blength > -1 Then
060 For position = 0 To blength
061 bx = URLDecode_Hex(Mid(urlcode,i + 2,2)) : i = i + 3
062 If bx < 128 Or bx > 191 Then u = 0 : Exit For
063 u = u + (bx And 63) * 64 ^ (blength - position)
064 Next
065 If u > 0 Then finalstr = finalstr & ChrW(b1 + u)
066 End If
067 Else
068 b1 = bx * &h100 : u = 0
069 bx = URLDecode_Hex(Mid(urlcode,i + 2,2))
070 If bx > 0 Then
071 u = b1 + bx
072 i = i + 3
073 Else
074 If Left(urlcode,1) = "%" Then
075 u = b1 + Asc(Mid(urlcode,i + 3,1))
076 i = i + 2
077 Else
078 u = b1 + Asc(Mid(urlcode,i + 1,1))
079 i = i + 1
080 End If
081 End If
082 finalstr = finalstr & Chr(u)
083 End If
084 Else
085 pass = 0
086 End If
087 End If
088 Else
089 finalstr = finalstr & char
090 End If
091 Next
092 URLDecode = leftstr & finalstr & rightstr
093 End Function
094
095 Function URLDecode_Hex(ByVal h)
096 On Error Resume Next
097 h = "&h" & Trim(h) : URLDecode_Hex = -1
098 If Len(h) <> 4 Then Exit Function
099 If isNumeric(h) Then URLDecode_Hex = cInt(h)
100 End Function
下面的代码是从kesion系统扒下的,确实不错,支持utf8格式。
001 ================================================
002 函数名:URLDecode
003 作 用:URL解码
004 ================================================
005 Function URLDecode(ByVal urlcode)
006 Dim start,final,length,char,i,butf8,pass
007 Dim leftstr,rightstr,finalstr
008 Dim b0,b1,bx,blength,position,u,utf8
009 On Error Resume Next
010
011 b0 = Array(192,224,240,248,252,254)
012 urlcode = Replace(urlcode,"+"," ")
013 pass = 0
014 utf8 = -1
015
016 length = Len(urlcode) : start = InStr(urlcode,"%") : final = InStrRev(urlcode,"%")
017 If start = 0 Or length < 3 Then URLDecode = urlcode : Exit Function
018 leftstr = Left(urlcode,start - 1) : rightstr = Right(urlcode,length - 2 - final)
019
020 For i = start To final
021 char = Mid(urlcode,i,1)
022 If char = "%" Then
023 bx = URLDecode_Hex(Mid(urlcode,i + 1,2))
024 If bx > 31 And bx < 128 Then
025 i = i + 2
026 finalstr = finalstr & ChrW(bx)
027 ElseIf bx > 127 Then
028 i = i + 2
029 If utf8 < 0 Then
030 butf8 = 1 : blength = -1 : b1 = bx
031 For position = 4 To 0 Step -1
032 If b1 >= b0(position) And b1 < b0(position + 1) Then
033 blength = position
034 Exit For
035 End If
036 Next
037 If blength > -1 Then
038 For position = 0 To blength
039 b1 = URLDecode_Hex(Mid(urlcode,i + position * 3 + 2,2))
040 If b1 < 128 Or b1 > 191 Then butf8 = 0 : Exit For
041 Next
042 Else
043 butf8 = 0
044 End If
045 If butf8 = 1 And blength = 0 Then butf8 = -2
046 If butf8 > -1 And utf8 = -2 Then i = start - 1 : finalstr = "" : pass = 1
047 utf8 = butf8
048 End If
049 If pass = 0 Then
050 If utf8 = 1 Then
051 b1 = bx : u = 0 : blength = -1
052 For position = 4 To 0 Step -1
053 If b1 >= b0(position) And b1 < b0(position + 1) Then
054 blength = position
055 b1 = (b1 xOr b0(position)) * 64 ^ (position + 1)
056 Exit For
057 End If
058 Next
059 If blength > -1 Then
060 For position = 0 To blength
061 bx = URLDecode_Hex(Mid(urlcode,i + 2,2)) : i = i + 3
062 If bx < 128 Or bx > 191 Then u = 0 : Exit For
063 u = u + (bx And 63) * 64 ^ (blength - position)
064 Next
065 If u > 0 Then finalstr = finalstr & ChrW(b1 + u)
066 End If
067 Else
068 b1 = bx * &h100 : u = 0
069 bx = URLDecode_Hex(Mid(urlcode,i + 2,2))
070 If bx > 0 Then
071 u = b1 + bx
072 i = i + 3
073 Else
074 If Left(urlcode,1) = "%" Then
075 u = b1 + Asc(Mid(urlcode,i + 3,1))
076 i = i + 2
077 Else
078 u = b1 + Asc(Mid(urlcode,i + 1,1))
079 i = i + 1
080 End If
081 End If
082 finalstr = finalstr & Chr(u)
083 End If
084 Else
085 pass = 0
086 End If
087 End If
088 Else
089 finalstr = finalstr & char
090 End If
091 Next
092 URLDecode = leftstr & finalstr & rightstr
093 End Function
094
095 Function URLDecode_Hex(ByVal h)
096 On Error Resume Next
097 h = "&h" & Trim(h) : URLDecode_Hex = -1
098 If Len(h) <> 4 Then Exit Function
099 If isNumeric(h) Then URLDecode_Hex = cInt(h)
100 End Function
上一篇: jsp页面转后台,出现中文乱码
下一篇: Oracle DBA链接到空闲进程问题