Discuz教程网

ASP的URLDecode函数URLEncode解码函数

[复制链接]
authicon dly 发表于 2011-9-14 09:01:44 | 显示全部楼层 |阅读模式
下面的代码是从kesion系统扒下的,确实不错,支持utf8格式。

  1. '================================================
  2. '函数名:URLDecode
  3. '作 用:URL解码
  4. '================================================
  5. Function URLDecode(ByVal urlcode)
  6. Dim start,final,length,char,i,butf8,pass
  7. Dim leftstr,rightstr,finalstr
  8. Dim b0,b1,bx,blength,position,u,utf8
  9. On Error Resume Next

  10. b0 = Array(192,224,240,248,252,254)
  11. urlcode = Replace(urlcode,"+"," ")
  12. pass = 0
  13. utf8 = -1

  14. length = Len(urlcode) : start = InStr(urlcode,"%") : final = InStrRev(urlcode,"%")
  15. If start = 0 Or length < 3 Then URLDecode = urlcode : Exit Function
  16. leftstr = Left(urlcode,start - 1) : rightstr = Right(urlcode,length - 2 - final)

  17. For i = start To final
  18. char = Mid(urlcode,i,1)
  19. If char = "%" Then
  20. bx = URLDecode_Hex(Mid(urlcode,i + 1,2))
  21. If bx > 31 And bx < 128 Then
  22. i = i + 2
  23. finalstr = finalstr & ChrW(bx)
  24. ElseIf bx > 127 Then
  25. i = i + 2
  26. If utf8 < 0 Then
  27. butf8 = 1 : blength = -1 : b1 = bx
  28. For position = 4 To 0 Step -1
  29. If b1 >= b0(position) And b1 < b0(position + 1) Then
  30. blength = position
  31. Exit For
  32. End If
  33. Next
  34. If blength > -1 Then
  35. For position = 0 To blength
  36. b1 = URLDecode_Hex(Mid(urlcode,i + position * 3 + 2,2))
  37. If b1 < 128 Or b1 > 191 Then butf8 = 0 : Exit For
  38. Next
  39. Else
  40. butf8 = 0
  41. End If
  42. If butf8 = 1 And blength = 0 Then butf8 = -2
  43. If butf8 > -1 And utf8 = -2 Then i = start - 1 : finalstr = "" : pass = 1
  44. utf8 = butf8
  45. End If
  46. If pass = 0 Then
  47. If utf8 = 1 Then
  48. b1 = bx : u = 0 : blength = -1
  49. For position = 4 To 0 Step -1
  50. If b1 >= b0(position) And b1 < b0(position + 1) Then
  51. blength = position
  52. b1 = (b1 xOr b0(position)) * 64 ^ (position + 1)
  53. Exit For
  54. End If
  55. Next
  56. If blength > -1 Then
  57. For position = 0 To blength
  58. bx = URLDecode_Hex(Mid(urlcode,i + 2,2)) : i = i + 3
  59. If bx < 128 Or bx > 191 Then u = 0 : Exit For
  60. u = u + (bx And 63) * 64 ^ (blength - position)
  61. Next
  62. If u > 0 Then finalstr = finalstr & ChrW(b1 + u)
  63. End If
  64. Else
  65. b1 = bx * &h100 : u = 0
  66. bx = URLDecode_Hex(Mid(urlcode,i + 2,2))
  67. If bx > 0 Then
  68. u = b1 + bx
  69. i = i + 3
  70. Else
  71. If Left(urlcode,1) = "%" Then
  72. u = b1 + Asc(Mid(urlcode,i + 3,1))
  73. i = i + 2
  74. Else
  75. u = b1 + Asc(Mid(urlcode,i + 1,1))
  76. i = i + 1
  77. End If
  78. End If
  79. finalstr = finalstr & Chr(u)
  80. End If
  81. Else
  82. pass = 0
  83. End If
  84. End If
  85. Else
  86. finalstr = finalstr & char
  87. End If
  88. Next
  89. URLDecode = leftstr & finalstr & rightstr
  90. End Function

  91. Function URLDecode_Hex(ByVal h)
  92. On Error Resume Next
  93. h = "&h" & Trim(h) : URLDecode_Hex = -1
  94. If Len(h) <> 4 Then Exit Function
  95. If isNumeric(h) Then URLDecode_Hex = cInt(h)
  96. End Function
复制代码




上一篇:ASP中使用Set ors=oConn.Execute()时获取记录数的方法
下一篇:asp中判断服务器是否安装了某种组件的函数
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

1314学习网 ( 浙ICP备10214163号 )

GMT+8, 2025-5-2 07:01

Powered by Discuz! X3.4

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表