ASP的URLDecode函数URLEncode解码函数

时间:2011-02-16 11:17:00 

下面的代码是从kesion系统扒下的,确实不错,支持utf8格式。

代码如下:


'================================================
'函数名: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

标签:URLDecode
0
投稿

猜你喜欢

  • 有关Server.Mappath详细接触

    2010-07-07 11:35:00
  • 利用XML实现通用WEB报表打印实际使用中的例子

    2008-09-04 14:42:00
  • 统计热门文章的算法

    2008-03-16 15:40:00
  • 几款优秀的中文字体设计

    2008-03-24 17:25:00
  • 一个ACCESS数据库数据传递的方法

    2008-03-05 11:58:00
  • 利用XMLBean轻轻松松读写XML

    2008-09-04 11:25:00
  • asp如何用SA-FileUp上传多个HTML文件?

    2010-05-18 18:27:00
  • 浏览器根据什么来判定脚本失控?[译]

    2009-02-20 13:36:00
  • 在Asp程序中取得表单所有内容的方法

    2010-04-24 16:07:00
  • 让SQL Server数据库自动执行管理任务(二)

    2009-03-20 11:40:00
  • 添加到各大流行网摘 书签的代码

    2008-04-20 14:15:00
  • asp如何做一个专门显示文本文件的页面?

    2010-07-12 19:04:00
  • 《设计网事》前言

    2009-07-15 17:19:00
  • 如何修改MySQL密码(方法大总结)

    2009-11-18 11:07:00
  • ASP脚本变量、函数、过程和条件语句

    2008-10-14 14:43:00
  • 一个二级伸缩下拉菜单代码

    2008-06-24 18:12:00
  • CSS鼠标悬停tip效果

    2007-08-26 17:32:00
  • MYSQL数据库表设计与优化(二)

    2010-10-25 20:12:00
  • 使用:after清除浮动

    2008-10-30 12:10:00
  • 揭开HTML 5工作草稿的神秘面纱

    2008-02-13 08:25:00
  • asp之家 网络编程 m.aspxhome.com