html 链接加密,网页设计_URL解码超级链接加密解密

对于网页开发者来说，有时候要对URL进行编码显示在浏览器的地址栏，增加链接的安全性,下面是源代码，引用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

转载请标明电脑保姆之家http://www.tchotn.cn