收藏本站腾讯微博新浪微博

经典论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

蓝色理想 最新研发动态 网站开通淘帖功能 - 蓝色理想插件 论坛内容导读一页看论坛 - 给官方提建议

论坛活动及任务 地图和邮件任务 请多用悬赏提问 热夏来袭,选一款蓝色理想的个性T恤吧!

手机上论坛,使用APP获得更好体验 急需前端攻城狮,获得内部推荐机会 论坛开通淘帖功能,收藏终于可以分类了!

搜索
查看: 15020|回复: 22

[asp] asp好用的函数集

[复制链接]
发表于 2007-1-6 02:49:00 | 显示全部楼层 |阅读模式
请不要在回贴中出现任何与楼主的函数库分享无关的话题,否则删除不通知,谢谢---5do8
--------------------------------------------------------
现在不写asp了
这次我将我以前沉淀下的一些函数库共享给大家,希望能给初学者启示,给老手也有所帮助吧.
先谢谢大家支持!



  1. <%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
  2. <%
  3. StartTime=timer() '程序执行时间检测

  4. '###############################################################
  5. '┌──VIBO───────────────────┐
  6. '│             VIBO STUDIO 版权所有             │
  7. '└───────────────────────┘
  8. ' Author:Vibo
  9. ' Email:vibo_cn@hotmail.com
  10. '----------------- Vibo ASP站点开发常用函数库 ------------------
  11. 'OpenDB(vdata_url)   -------------------- 打开数据库
  12. 'getIp()  ------------------------------- 得到真实IP
  13. 'getIPAdress(sip)------------------------ 查找ip对应的真实地址
  14. 'IP2Num(sip) ---------------------------- 限制某段IP地址
  15. 'chkFrom() ------------------------------ 防站外提交设定
  16. 'getsys() ------------------------------- 操作系统检测
  17. 'GetBrowser() --------------------------- 浏览器版本检测
  18. 'GetSearcher() -------------------------- 识别搜索引擎
  19. '
  20. '---------------------- 数据过滤 ↓----------------------------
  21. 'CheckStr(byVal ChkStr) ----------------- 检查无效字符
  22. 'CheckSql() ----------------------------- 防止SQL注入

  23. 'UnCheckStr(Str)------------------------- 检查非法sql命令
  24. 'Checkstr(Str) -------------------------- ASP最新SQL防注入过滤涵数

  25. 'HTMLEncode(reString) ------------------- 过滤转换HTML代码
  26. 'DateToStr(DateTime,ShowType) ----------- 日期转换函数
  27. 'Date2Chinese(iDate) -------------------- 获得ASP的中文日期字符串
  28. 'lenStr(str) ---------------------------- 计算字符串长度(字节)

  29. 'CreateArr(str) ------------------------- 生成二维数组
  30. 'ShowRsArr(rsArr) ----------------------- 用表格显示记录集getrows生成的数组的表结构

  31. '---------------------- 外接组件使用函数↓------------------------
  32. 'sendMail(to_Email,from_Email,from_Name,mail_Subject,mail_Body,mail_htmlBody) -----'Jmail组件 发送邮件

  33. '-----------------------------------------系统检测函数↓------------------------------------------
  34. 'IsValidUrl(url) ------------------------ 检测网页是否有效
  35. 'getHTMLPage(filename) ------------------ 获取文件内容
  36. 'CheckFile(FilePath) -------------------- 检查某一文件是否存在
  37. 'CheckDir(FolderPath) ------------------- 检查某一目录是否存在
  38. 'MakeNewsDir(foldername) ---------------- 根据指定名称生成目录
  39. 'CreateHTMLPage(filename,FileData,C_mode) 生成文件

  40. 'CheckBadWord(byVal ChkStr) ------------- 过滤脏字
  41. '###############################################################

  42. Dim ipData_url
  43. ipData_url="./Ip.mdb"

  44. Response.Write("--------------客户端信息检测------------"&"<br>")
  45. Response.Write(getsys()&"<br>")
  46. Response.Write(GetBrowser()&"<br>")
  47. Response.Write(GetSearcher()&"<br>")
  48. Response.Write("IP:"&getIp()&"<br>")
  49. Response.Write("来源:"&(getIPAdress(GetIp()))&"<br>")
  50. Response.Write("<br>")

  51. Response.Write("--------------数据提交检测--------------"&"<br>")
  52. if not chkFrom then
  53.     Response.write("请不要从站外提交内容!"&"<br>")
  54.         Response.end
  55. else
  56.     Response.write("本站提交内容!"&"<br><br>")
  57. End if


  58. function OpenDB(vdata_url)
  59. '------------------------------打开数据库
  60. '使用:Conn = OpenDB("data/data.mdb")
  61.   Dim vibo_Conn
  62.   Set vibo_Conn= Server.CreateObject("ADODB.Connection")
  63.   vibo_Conn.ConnectionString="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(vdata_url)
  64.   vibo_Conn.Open
  65.   OpenDB=vibo_Conn
  66. End Function

  67. function getIp()
  68. '-----------------------得到真实IP
  69. userip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
  70. If userip = "" Then userip = Request.ServerVariables("REMOTE_ADDR")
  71. getIp=userip
  72. End function

  73. Function getIPAdress(sip)
  74. '---------------------查找ip对应的真实地址
  75. Dim iparr,iprs,country,city
  76. If sip="127.0.0.1" then sip= "192.168.0.1"   
  77. iparr=split(sip,".")
  78. sip=cint(iparr(0))*256*256*256+cint(iparr(1))*256*256+cint(iparr(2))*256+cint(iparr(3))-1
  79. Dim vibo_ipconn_STRING
  80. vibo_ipconn_STRING = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Server.MapPath(ipData_url)
  81. Set iprs = Server.CreateObject("ADODB.Recordset")
  82. iprs.ActiveConnection = vibo_ipconn_STRING
  83. iprs.Source = "SELECT Top 1 city, country FROM address WHERE ip1 <=" & sip & " and " & sip & "<=ip2"
  84. iprs.CursorType = 0
  85. iprs.CursorLocation = 2
  86. iprs.LockType = 1
  87. iprs.Open()

  88. If iprs.bof and iprs.eof then
  89.     country="未知地区"
  90.     city=""
  91. Else
  92.     country=iprs.Fields.Item("country").Value
  93.     city=iprs.Fields.Item("city").Value
  94. End If
  95. getIPAdress=country&city
  96. iprs.Close()
  97. Set iprs = Nothing
  98. End Function

  99. Function IP2Num(sip)
  100. '--------------------限制某段IP地址

  101.     dim str1,str2,str3,str4
  102.     dim num
  103.     IP2Num=0
  104.     if isnumeric(left(sip,2)) then
  105.         str1=left(sip,instr(sip,".")-1)
  106.         sip=mid(sip,instr(sip,".")+1)
  107.         str2=left(sip,instr(sip,".")-1)
  108.         sip=mid(sip,instr(sip,".")+1)
  109.         str3=left(sip,instr(sip,".")-1)
  110.         str4=mid(sip,instr(sip,".")+1)
  111.         num=cint(str1)*256*256*256+cint(str2)*256*256+cint(str3)*256+cint(str4)-1
  112.         IP2Num = num
  113.     end if
  114. end function

  115. 'userIPnum = IP2Num(Request.ServerVariables("REMOTE_ADDR"))
  116. 'if userIPnum > IP2Num("192.168.0.0") and userIPnum < IP2Num("192.168.0.255") then
  117.     'response.write ("<center>您的IP被禁止</center>")
  118.     'response.end
  119. 'end if


  120. Function chkFrom()
  121. '----------------------------防站外提交设定
  122.         Dim server_v1,server_v2, server1, server2
  123.         chkFrom=False
  124.         server1=Cstr(Request.ServerVariables("HTTP_REFERER"))
  125.         server2=Cstr(Request.ServerVariables("SERVER_NAME"))
  126.         If Mid(server1,8,len(server2))=server2 Then chkFrom=True
  127. End Function
  128. 'if not chkFrom then
  129.         'Response.write("请不要从站外提交内容!")
  130.         'Response.end
  131. 'End if

  132. function getsys()
  133. '----------------------------------操作系统检测
  134. vibo_soft=Request.ServerVariables("HTTP_USER_AGENT")
  135. if instr(vibo_soft,"Windows NT 5.0") then
  136.         msm="Win 2000"
  137. elseif instr(vibo_soft,"Windows NT 5.1") then
  138.         msm="Win XP"
  139. elseif instr(vibo_soft,"Windows NT 5.2") then
  140.         msm="Win 2003"
  141. elseif instr(vibo_soft,"4.0") then
  142.         msm="Win NT"
  143. elseif instr(vibo_soft,"NT") then
  144.         msm="Win NT"
  145. elseif instr(vibo_soft,"Windows CE") then
  146.         msm="Windows CE"
  147. elseif instr(vibo_soft,"Windows 9") then
  148.         msm="Win 9x"
  149. elseif instr(vibo_soft,"9x") then
  150.         msm="Windows ME"
  151. elseif instr(vibo_soft,"98") then
  152.         msm="Windows 98"
  153. elseif instr(vibo_soft,"Windows 95") then
  154.         msm="Windows 95"
  155. elseif instr(vibo_soft,"Win32") then
  156.         msm="Win32"
  157. elseif instr(vibo_soft,"unix") or instr(vibo_soft,"linux") or instr(vibo_soft,"SunOS") or instr(vibo_soft,"BSD") then
  158.         msm="类Unix"
  159. elseif instr(vibo_soft,"Mac") then
  160.         msm="Mac"
  161. else
  162.         msm="Other"
  163. end if
  164. getsys=msm
  165. End Function

  166. function GetBrowser()
  167. '----------------------------------浏览器版本检测
  168. dim vibo_soft
  169. vibo_soft=Request.ServerVariables("HTTP_USER_AGENT")
  170. Browser="unknown"
  171. version="unknown"
  172. 'vibo_soft="Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; TencentTraveler ; .NET CLR 1.1.4322)"       
  173. If Left(vibo_soft,7) ="Mozilla" Then '有此标识为浏览器
  174.                         vibo_soft=Split(vibo_soft,";")
  175.                         If InStr(vibo_soft(1),"MSIE")>0 Then
  176.                                 Browser="Microsoft Internet Explorer "
  177.                                 version=Trim(Left(Replace(vibo_soft(1),"MSIE",""),6))
  178.                         ElseIf InStr(vibo_soft(4),"Netscape")>0 Then
  179.                                 Browser="Netscape "
  180.                                 tmpstr=Split(vibo_soft(4),"/")
  181.                                 version=tmpstr(UBound(tmpstr))
  182.                         ElseIf InStr(vibo_soft(4),"rv:")>0 Then
  183.                                 Browser="Mozilla "
  184.                                 tmpstr=Split(vibo_soft(4),":")
  185.                                 version=tmpstr(UBound(tmpstr))
  186.                                 If InStr(version,")") > 0 Then
  187.                                         tmpstr=Split(version,")")
  188.                                         version=tmpstr(0)
  189.                                 End If
  190.                         End If
  191. ElseIf Left(vibo_soft,5) ="Opera" Then
  192.                         vibo_soft=Split(vibo_soft,"/")
  193.                         Browser="Mozilla "
  194.                         tmpstr=Split(vibo_soft(1)," ")
  195.                         version=tmpstr(0)
  196. End If
  197. If version<>"unknown" Then
  198.                         Dim Tmpstr1
  199.                         Tmpstr1=Trim(Replace(version,".",""))
  200.                         If Not IsNumeric(Tmpstr1) Then
  201.                                 version="unknown"
  202.                         End If
  203. End If
  204. GetBrowser=Browser &" "& version
  205. End function

  206. function GetSearcher()
  207. '----------------------识别搜索引擎
  208. Dim botlist,Searcher
  209. Dim vibo_soft
  210. vibo_soft=Request.ServerVariables("HTTP_USER_AGENT")

  211. Botlist="Google,Isaac,SurveyBot,Baiduspider,ia_archiver,P.Arthur,FAST-WebCrawler,Java,Microsoft-ATL-Native,TurnitinBot,WebGather,Sleipnir,TencentTraveler"
  212. Botlist=split(Botlist,",")
  213.   For i=0 to UBound(Botlist)
  214.     If InStr(vibo_soft,Botlist(i))>0  Then
  215.       Searcher=Botlist(i)&" 搜索器"
  216.       IsSearch=True
  217.       Exit For
  218.     End If
  219.   Next
  220. If IsSearch Then
  221.   GetSearcher=Searcher
  222. else
  223.   GetSearcher="unknown"
  224. End if
  225. End function


  226. '----------------------------------数据过滤 ↓---------------------------------------
  227. Function CheckSql() '防止SQL注入
  228.         Dim sql_injdata  
  229.         SQL_injdata = "'|and|exec|insert|select|delete|update|count|*|%|chr|mid|master|truncate|char|declare"
  230.         SQL_inj = split(SQL_Injdata,"|")
  231.         If Request.QueryString<>"" Then
  232.                 For Each SQL_Get In Request.QueryString
  233.                         For SQL_Data=0 To Ubound(SQL_inj)
  234.                                 if instr(Request.QueryString(SQL_Get),Sql_Inj(Sql_DATA))>0 Then
  235.                                         Response.Write "<Script Language='javascript'>{alert('请不要在参数中包含非法字符!');history.back(-1)}</Script>"
  236.                                         Response.end
  237.                                 end if
  238.                         next
  239.                 Next
  240.         End If
  241.         If Request.Form<>"" Then
  242.                 For Each Sql_Post In Request.Form
  243.                         For SQL_Data=0 To Ubound(SQL_inj)
  244.                                 if instr(Request.Form(Sql_Post),Sql_Inj(Sql_DATA))>0 Then
  245.                                         Response.Write "<Script Language='javascript'>{alert('请不要在参数中包含非法字符!');history.back(-1)}        </Script>"
  246.                                         Response.end
  247.                                 end if
  248.                         next
  249.                 next
  250.         end if
  251. End Function

  252. Function CheckStr(byVal ChkStr) '检查无效字符
  253.         Dim Str:Str=ChkStr
  254.         Str=Trim(Str)
  255.         If IsNull(Str) Then
  256.                 CheckStr = ""
  257.                 Exit Function
  258.         End If
  259.         Dim re
  260.         Set re=new RegExp
  261.         re.IgnoreCase =True
  262.         re.Global=True
  263.         re.Pattern="(\r\n){3,}"
  264.         Str=re.Replace(Str,"$1$1$1")
  265.         Set re=Nothing
  266.         Str = Replace(Str,"'","''")
  267.         Str = Replace(Str, "select", "select")
  268.         Str = Replace(Str, "join", "join")
  269.         Str = Replace(Str, "union", "union")
  270.         Str = Replace(Str, "where", "where")
  271.         Str = Replace(Str, "insert", "insert")
  272.         Str = Replace(Str, "delete", "delete")
  273.         Str = Replace(Str, "update", "update")
  274.         Str = Replace(Str, "like", "like")
  275.         Str = Replace(Str, "drop", "drop")
  276.         Str = Replace(Str, "create", "create")
  277.         Str = Replace(Str, "modify", "modify")
  278.         Str = Replace(Str, "rename", "rename")
  279.         Str = Replace(Str, "alter", "alter")
  280.         Str = Replace(Str, "cast", "cast")
  281.         CheckStr=Str
  282. End Function

  283. Function UnCheckStr(Str) '检查非法sql命令
  284.                 Str = Replace(Str, "select", "select")
  285.                 Str = Replace(Str, "join", "join")
  286.                 Str = Replace(Str, "union", "union")
  287.                 Str = Replace(Str, "where", "where")
  288.                 Str = Replace(Str, "insert", "insert")
  289.                 Str = Replace(Str, "delete", "delete")
  290.                 Str = Replace(Str, "update", "update")
  291.                 Str = Replace(Str, "like", "like")
  292.                 Str = Replace(Str, "drop", "drop")
  293.                 Str = Replace(Str, "create", "create")
  294.                 Str = Replace(Str, "modify", "modify")
  295.                 Str = Replace(Str, "rename", "rename")
  296.                 Str = Replace(Str, "alter", "alter")
  297.                 Str = Replace(Str, "cast", "cast")
  298.                 UnCheckStr=Str
  299. End Function

  300. Function Checkstr(Str) 'SQL防注入过滤涵数
  301.         If Isnull(Str) Then
  302.         CheckStr = ""
  303.         Exit Function
  304.         End If
  305.         Str = Replace(Str,Chr(0),"", 1, -1, 1)
  306.         Str = Replace(Str, """", """", 1, -1, 1)
  307.         Str = Replace(Str,"<","<", 1, -1, 1)
  308.         Str = Replace(Str,">",">", 1, -1, 1)
  309.         Str = Replace(Str, "script", "script", 1, -1, 0)
  310.         Str = Replace(Str, "SCRIPT", "SCRIPT", 1, -1, 0)
  311.         Str = Replace(Str, "Script", "Script", 1, -1, 0)
  312.         Str = Replace(Str, "script", "Script", 1, -1, 1)
  313.         Str = Replace(Str, "object", "object", 1, -1, 0)
  314.         Str = Replace(Str, "OBJECT", "OBJECT", 1, -1, 0)
  315.         Str = Replace(Str, "Object", "Object", 1, -1, 0)
  316.         Str = Replace(Str, "object", "Object", 1, -1, 1)
  317.         Str = Replace(Str, "applet", "applet", 1, -1, 0)
  318.         Str = Replace(Str, "APPLET", "APPLET", 1, -1, 0)
  319.         Str = Replace(Str, "Applet", "Applet", 1, -1, 0)
  320.         Str = Replace(Str, "applet", "Applet", 1, -1, 1)
  321.         Str = Replace(Str, "[", "[")
  322.         Str = Replace(Str, "]", "]")
  323.         Str = Replace(Str, """", "", 1, -1, 1)
  324.         Str = Replace(Str, "=", "=", 1, -1, 1)
  325.         Str = Replace(Str, "'", "''", 1, -1, 1)
  326.         Str = Replace(Str, "select", "select", 1, -1, 1)
  327.         Str = Replace(Str, "execute", "execute", 1, -1, 1)
  328.         Str = Replace(Str, "exec", "exec", 1, -1, 1)
  329.         Str = Replace(Str, "join", "join", 1, -1, 1)
  330.         Str = Replace(Str, "union", "union", 1, -1, 1)
  331.         Str = Replace(Str, "where", "where", 1, -1, 1)
  332.         Str = Replace(Str, "insert", "insert", 1, -1, 1)
  333.         Str = Replace(Str, "delete", "delete", 1, -1, 1)
  334.         Str = Replace(Str, "update", "update", 1, -1, 1)
  335.         Str = Replace(Str, "like", "like", 1, -1, 1)
  336.         Str = Replace(Str, "drop", "drop", 1, -1, 1)
  337.         Str = Replace(Str, "create", "create", 1, -1, 1)
  338.         Str = Replace(Str, "rename", "rename", 1, -1, 1)
  339.         Str = Replace(Str, "count", "count", 1, -1, 1)
  340.         Str = Replace(Str, "chr", "chr", 1, -1, 1)
  341.         Str = Replace(Str, "mid", "mid", 1, -1, 1)
  342.         Str = Replace(Str, "truncate", "truncate", 1, -1, 1)
  343.         Str = Replace(Str, "nchar", "nchar", 1, -1, 1)
  344.         Str = Replace(Str, "char", "char", 1, -1, 1)
  345.         Str = Replace(Str, "alter", "alter", 1, -1, 1)
  346.         Str = Replace(Str, "cast", "cast", 1, -1, 1)
  347.         Str = Replace(Str, "exists", "exists", 1, -1, 1)
  348.         Str = Replace(Str,Chr(13),"<br>", 1, -1, 1)
  349.         CheckStr = Replace(Str,"'","''", 1, -1, 1)
  350. End Function

  351. Function HTMLEncode(reString) '过滤转换HTML代码
  352.         Dim Str:Str=reString
  353.         If Not IsNull(Str) Then
  354.                 Str = UnCheckStr(Str)
  355.                 Str = Replace(Str, "&", "&")
  356.                 Str = Replace(Str, ">", "&gt;")
  357.                 Str = Replace(Str, "<", "&lt;")
  358.                 Str = Replace(Str, CHR(32), "&nbsp;")
  359.             Str = Replace(Str, CHR(9), "&nbsp;&nbsp;&nbsp;&nbsp;")
  360.                 Str = Replace(Str, CHR(9), "&nbsp;&nbsp;&nbsp;&nbsp;")
  361.                 Str = Replace(Str, CHR(34),""")
  362.                 Str = Replace(Str, CHR(39),"&#39;")
  363.                 Str = Replace(Str, CHR(13), "")
  364.                 Str = Replace(Str, CHR(10), "<br>")
  365.                 HTMLEncode = Str
  366.         End If
  367. End Function

  368. Function DateToStr(DateTime,ShowType)  '日期转换函数
  369.         Dim DateMonth,DateDay,DateHour,DateMinute
  370.         DateMonth=Month(DateTime)
  371.         DateDay=Day(DateTime)
  372.         DateHour=Hour(DateTime)
  373.         DateMinute=Minute(DateTime)
  374.         If Len(DateMonth)<2 Then DateMonth="0"&DateMonth
  375.         If Len(DateDay)<2 Then DateDay="0"&DateDay
  376.         Select Case ShowType
  377.         Case "Y-m-d"  
  378.                 DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay
  379.         Case "Y-m-d H:I A"
  380.                 Dim DateAMPM
  381.                 If DateHour>12 Then
  382.                         DateHour=DateHour-12
  383.                         DateAMPM="PM"
  384.                 Else
  385.                         DateHour=DateHour
  386.                         DateAMPM="AM"
  387.                 End If
  388.                 If Len(DateHour)<2 Then DateHour="0"&DateHour       
  389.                 If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
  390.                 DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&" "&DateAMPM
  391.         Case "Y-m-d H:I:S"
  392.                 Dim DateSecond
  393.                 DateSecond=Second(DateTime)
  394.                 If Len(DateHour)<2 Then DateHour="0"&DateHour       
  395.                 If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
  396.                 If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
  397.                 DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&":"&DateSecond
  398.         Case "YmdHIS"
  399.                 DateSecond=Second(DateTime)
  400.                 If Len(DateHour)<2 Then DateHour="0"&DateHour       
  401.                 If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
  402.                 If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
  403.                 DateToStr=Year(DateTime)&DateMonth&DateDay&DateHour&DateMinute&DateSecond       
  404.         Case "ym"
  405.                 DateToStr=Right(Year(DateTime),2)&DateMonth
  406.         Case "d"
  407.                 DateToStr=DateDay
  408.         Case Else
  409.                 If Len(DateHour)<2 Then DateHour="0"&DateHour
  410.                 If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
  411.                 DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute
  412.         End Select
  413. End Function

  414. Function Date2Chinese(iDate) '获得ASP的中文日期字符串
  415.     Dim num(10)
  416.     Dim iYear
  417.     Dim iMonth
  418.     Dim iDay

  419.     num(0) = "〇"
  420.     num(1) = "一"
  421.     num(2) = "二"
  422.     num(3) = "三"
  423.     num(4) = "四"
  424.     num(5) = "五"
  425.     num(6) = "六"
  426.     num(7) = "七"
  427.     num(8) = "八"
  428.     num(9) = "九"

  429.     iYear = Year(iDate)
  430.     iMonth = Month(iDate)
  431.     iDay = Day(iDate)
  432.     Date2Chinese = num(iYear \ 1000) + num((iYear \ 100) Mod 10) + num((iYear\ 10) Mod 10) + num(iYear Mod 10) + "年"
  433.     If iMonth >= 10 Then
  434.         If iMonth = 10 Then
  435.             Date2Chinese = Date2Chinese + "十" + "月"
  436.         Else
  437.             Date2Chinese = Date2Chinese + "十" + num(iMonth Mod 10) + "月"
  438.         End If
  439.     Else
  440.         Date2Chinese = Date2Chinese + num(iMonth Mod 10) + "月"
  441.     End If
  442.     If iDay >= 10 Then
  443.         If iDay = 10 Then
  444.             Date2Chinese = Date2Chinese +"十" + "日"
  445.         ElseIf iDay = 20 Or iDay = 30 Then
  446.             Date2Chinese = Date2Chinese + num(iDay \ 10) + "十" + "日"
  447.         ElseIf iDay > 20 Then
  448.             Date2Chinese = Date2Chinese + num(iDay \ 10) + "十" +num(iDay Mod 10) + "日"
  449.         Else
  450.            Date2Chinese = Date2Chinese + "十" + num(iDay Mod 10) + "日"
  451.         End If
  452.     Else
  453.         Date2Chinese = Date2Chinese + num(iDay Mod 10) + "日"
  454.     End If
  455. End Function


  456. Function lenStr(str)'计算字符串长度(字节)
  457.         dim l,t,c
  458.         dim i
  459.         l=len(str)
  460.         t=0
  461. for i=1 to l
  462.         c=asc(mid(str,i,1))
  463.         if c<0 then c=c+65536
  464.     if c<255 then t=t+1
  465.         if c>255 then t=t+2
  466. next
  467.    lenstr=t
  468. End Function

  469. Function CreateArr(str) '生成二维数组 数据如:"1,a1,b1,c1,d1|2,a2,b2,c2,d2|5,a3,b3,c3,d3|8,a4,b4,c4,d4"
  470. dim arr()
  471. str=split(str,"|")
  472. for i=0 to UBound(str)
  473.         arrstr=split(str(i),",")
  474.         for j=0 to Ubound(arrstr)
  475.                 ReDim Preserve arr(UBound(str),UBound(arrstr))
  476.                 arr(i,j)=arrstr(j)
  477.         next
  478. next
  479. CreateArr=arr
  480. End Function



复制代码

[[i] 本帖最后由 5do8 于 2007-1-6 11:53 编辑 ]

评分

参与人数 1威望 +1 收起 理由
5do8 + 1 我很赞同

查看全部评分

 楼主| 发表于 2007-1-6 02:49:33 | 显示全部楼层
接上
  1. Function ShowRsArr(rsArr) '用表格显示记录集getrows生成的数组的表结构
  2. showHtml="<table width=100% border=1 cellspacing=0 cellpadding=0>"
  3.         If Not IsEmpty(rsArr) Then
  4.                 For y=0 To Ubound(rsArr,2)
  5.                 showHtml=showHtml&"<tr>"
  6.                         for x=0 to Ubound(rsArr,1)
  7.                                 showHtml=showHtml& "<td>"&rsArr(x,y)&"</td>"
  8.                         next
  9.                 showHtml=showHtml&"</tr>"
  10.                 next
  11.         Else
  12.                 RshowHtml=showHtml&"<tr>"
  13.                 showHtml=showHtml&"<td>No Records</td>"
  14.                 showHtml=showHtml&"</tr>"
  15.         End If
  16.                 showHtml=showHtml&"</table>"
  17.         ShowRsArr=showHtml
  18. End Function


  19. '-----------------------------------------外接组件使用函数↓------------------------------------------

  20. Function sendMail(to_Email,from_Email,from_Name,mail_Subject,mail_Body,mail_htmlBody) 'Jmail 发送邮件
  21.   Set vibo_mail = Server.CreateObject("JMAIL.Message")    '建立发送邮件的对象
  22.   vibo_mail.silent = true                                 '屏蔽例外错误,返回FALSE跟TRUE两值j
  23.   vibo_mail.logging = true                                '启用邮件日志
  24.   vibo_mail.Charset = "gb2312"                            '邮件的文字编码为国标

  25.   'vibo_mail.ContentType = "text/html"                     '邮件的格式为HTML格式
  26.   'vibo_mail.Prority = 1                                   '邮件的紧急程序,1 为最快,5 为最慢, 3 为默认值

  27.   vibo_mail.AddRecipient to_Email                         '邮件收件人的地址
  28.   vibo_mail.From = from_Email                             '发件人的E-MAIL地址
  29.   vibo_mail.FromName = from_Name                          '发件人姓名
  30.   vibo_mail.MailServerUserName = "system@aaa.com"       '登录邮件服务器所需的用户名
  31.   vibo_mail.MailServerPassword = "asdasd"     '登录邮件服务器所需的密码
  32.   vibo_mail.Subject = mail_Subject                        '邮件的标题
  33.   vibo_mail.Body = mail_Body                              '正文
  34.   vibo_mail.HTMLBody = mail_htmlBody                      'HTML正文
  35.   vibo_mail.ReturnReceipt = True
  36.   vibo_mail.Send("smtp.263xmail.com")                     '执行邮件发送(通过邮件服务器地址)
  37.   vibo_mail.Close()
  38.   set vibo_mail=nothing
  39. End Function

  40. '---------------------------------------程序执行时间检测↓----------------------------------------------
  41. EndTime=Timer()
  42. If EndTime<StartTime Then
  43.     EndTime=EndTime+24*3600
  44. End if
  45. runTime=(EndTime-StartTime)*1000
  46. Response.Write("------------程序执行时间检测------------"&"<br>")
  47. Response.Write("程序执行时间"&runTime&"毫秒")


  48. '-----------------------------------------系统检测使用函数↓------------------------------------------
  49. '---------------------检测网页是否有效-----------------------
  50. Function IsValidUrl(url)
  51.         Set xl = Server.CreateObject("Microsoft.XMLHTTP")
  52.         xl.Open "HEAD",url,False
  53.         xl.Send
  54.         IsValidUrl = (xl.status=200)
  55. End Function
  56. 'If IsValidUrl(""&fileurl&"") Then
  57. '        response.redirect fileurl
  58. 'Else
  59. '        Response.Write "由于下载用户过多,程序检测到文件暂时无法下载,请更换其他下载地址!感谢您对本软件网站的支持哦^_^"
  60. 'End If
  61. '------------------检查某一目录是否存在-------------------

  62. Function getHTMLPage(filename) '获取文件内容
  63.         Dim fso,file
  64.     Set fso = Server.CreateObject("Scripting.FileSystemObject")
  65.     Set File=fso.OpenTextFile(server.mappath(filename))
  66.     showHtml=File.ReadAll
  67.     File.close
  68.     Set File=nothing
  69.     Set fso=nothing
  70.         getHTMLPage=showHtml '输出
  71. End function

  72. Function CheckDir(FolderPath)
  73.     dim fso
  74.     folderpath=Server.MapPath(".")&"\"&folderpath
  75.     Set fso = Server.CreateObject("Scripting.FileSystemObject")
  76.     If fso.FolderExists(FolderPath) then
  77.     '存在
  78.         CheckDir = True
  79.     Else
  80.     '不存在
  81.         CheckDir = False
  82.     End if
  83.     Set fso = nothing
  84. End Function

  85. Function CheckFile(FilePath) '检查某一文件是否存在
  86.     Dim fso
  87.     Filepath=Server.MapPath(FilePath)
  88.     Set fso = Server.CreateObject("Scripting.FileSystemObject")
  89.     If fso.FileExists(FilePath) then
  90.     '存在
  91.         CheckFile = True
  92.     Else
  93.     '不存在
  94.         CheckFile = False
  95.     End if
  96.     Set fso = nothing
  97. End Function

  98. '-------------根据指定名称生成目录---------
  99. Function MakeNewsDir(foldername)
  100.     dim fso,f
  101.     Set fso = Server.CreateObject("Scripting.FileSystemObject")
  102.     Set f = fso.CreateFolder(foldername)
  103.     MakeNewsDir = True
  104.     Set fso = nothing
  105. End Function

  106. Function CreateHTMLPage(filename,FileData,C_mode) '生成文件
  107.         if C_mode=0 then '使用FSO生成
  108.                 Dim fso,txt
  109.                 Set fso = CreateObject("Scripting.FileSystemObject")
  110.                 Filepath=Server.MapPath(filename)
  111.                 if CheckFile(filename) then fso.DeleteFile Filepath,True '防止续写
  112.                 Set txt=fso.OpenTextFile(Filepath,8,True)  
  113.                 txt.Write FileData
  114.                 txt.Close
  115.                 Set fso = nothing
  116.         elseif C_mode=1 then '使用Stream生成
  117.                 Dim viboStream
  118.                 On Error Resume Next
  119.                 Set viboStream = Server.createObject("ADODB.Stream")
  120.                                
  121.                 If Err.Number=-2147221005 Then
  122.                 Response.Write "<div align='center' style=""font-size:12px;font-family:Tahoma;"">非常遗憾,您的主机不支持ADODB.Stream,不能使用本程序</div>"
  123.                 Err.Clear
  124.                 Response.End
  125.             End If
  126.                
  127.             With viboStream
  128.         .Type = 2
  129.         .Open
  130.         .CharSet = "GB2312"
  131.         .Position = objStream.Size
  132.         .WriteText = FileData
  133.         .SaveToFile Server.MapPath(filename),2
  134.         .Close
  135.             End With
  136.             Set viboStream = Nothing       
  137.         end if
  138.         Response.Write "<div align='center' style=""font-size:12px;font-family:Tahoma;"">恭喜!文件 <a href="""&filename&""" target=""_blank"" style=""font-weight: bold;color: #FF0000;"">"&filename&"</a> 已经生成完毕!...</div>"
  139.         Response.Flush()
  140. End Function

  141. Function CheckBadWord(byVal ChkStr)'过滤脏字
  142.         Dim Str:Str = ChkStr
  143.         Str = Trim(Str)
  144.         If IsNull(Str) Then
  145.                 CheckBadWord = ""
  146.                 Exit Function
  147.         End If
  148.        
  149.         DIC = getHTMLPage("include/badWord.txt")'载入脏字词典
  150.         DICArr = split(DIC,CHR(10))
  151.         For i  =0 To Ubound(DICArr )
  152.                 WordDIC = split(DICArr(i),"=")
  153.                 Str = Replace(Str,WordDIC(0),WordDIC(1))
  154.         next
  155.         CheckBadWord = Str
  156. End function
  157. %>
复制代码
回复 支持 反对

使用道具 举报

发表于 2007-1-6 13:07:35 | 显示全部楼层
防注入的那个函数根本就是一个误导。

完全没有必要那样的。

只要把'换成2个''就OK了。还是就是检测一个传入的数据类型。

LZ的那个函数完全是自欺欺人。(虽然是网上流传的函数。)
回复 支持 反对

使用道具 举报

发表于 2007-1-6 14:09:23 | 显示全部楼层
function getIp()
'-----------------------得到真实IP
userip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If userip = "" Then userip = Request.ServerVariables("REMOTE_ADDR")
getIp=userip
End function
如果有多个代理呢!

'**********************
‘Get Client Ip Add
'**********************
Function getIP()
Dim strIP,IP_Ary,strIP_list
        strIP_list=Replace(Request.ServerVariables("HTTP_X_FORWARDED_FOR"),"'","")
        If InStr(strIP_list,",")<>0 Then
                IP_Ary = Split(strIP_list,",")
                strIP = IP_Ary(0)
        Else
                strIP = strIP_list
        End If
        If strIP=Empty Then strIP=Replace(Request.ServerVariables("REMOTE_ADDR"),"'","")
                getIP=strIP
End Function
回复 支持 反对

使用道具 举报

发表于 2007-1-8 01:17:27 | 显示全部楼层
对于防止SQL注入我一直有点疑问,不知道如何解决。

在 Function CheckSql() 中 If Request.Form<>"" Then 这一节,把上面 SQL_injdata 的所有字符都限制了,那么假设我的表单允许用户提交SQL语句呢?我的意思是——像我们很多朋友都有自己的Blog吧?写日志的时候日志内容里面很可能是关于SQL语句的文章吧?那么此时的SQL关键字是允许的啊?

另外对于防止站外提交的函数我也有些疑问,我感觉它仍然有漏洞:它无法检测伪造REFERER这种行为——如果有人伪造REFERER不等于这个函数就没用了么?


小弟这两个疑问,还请知道的解惑一下~
回复 支持 反对

使用道具 举报

发表于 2007-1-8 14:53:00 | 显示全部楼层
To uonun :

防注入的话就用ADO的Command对象,基本不需要过滤字符串.

防止站外提交 检测提交的主机头和来源,一般不会有问题.
回复 支持 反对

使用道具 举报

发表于 2007-1-8 16:10:27 | 显示全部楼层
Function chkFrom()
'----------------------------防站外提交设定
    Dim server_v1,server_v2, server1, server2
    chkFrom=False
    server1=Cstr(Request.ServerVariables("HTTP_REFERER"))
    server2=Cstr(Request.ServerVariables("SERVER_NAME"))
    If Mid(server1,8,len(server2))=server2 Then chkFrom=True
End Function
'if not chkFrom then
    'Response.write("请不要从站外提交内容!")
    'Response.end
'End if

这段程序怎么把我自己提交的内容都封掉了?我是用表单提交的。。。。

例如我在A页面点击链接到B页面,在B页面填写表单,添加成功后,执行:
<script language="VBScript">
msgbox "修改成功!"
location.href="A.asp?classid=<%= request("classid") %>"
</script>

结果就说:请不要从站外提交内容!

[[i] 本帖最后由 wdq4321 于 2007-1-8 16:23 编辑 ]
回复 支持 反对

使用道具 举报

发表于 2007-1-8 18:16:37 | 显示全部楼层
读取文件操作:

  1. '-------------------------------------------------
  2. '函数名称:ReadTextFile
  3. '作用:利用AdoDb.Stream对象来读取UTF-8格式的文本文件
  4. '----------------------------------------------------
  5. Function ReadFromTextFile (FileUrl,CharSet)
  6.     dim str
  7.     set stm=server.CreateObject("adodb.stream")
  8.     stm.Type=2 '以本模式读取
  9.     stm.mode=3
  10.     stm.charset=CharSet
  11.     stm.open
  12.     stm.loadfromfile server.MapPath(FileUrl)
  13.     str=stm.readtext
  14.     stm.Close
  15.     set stm=nothing
  16.     ReadFromTextFile=str
  17. End Function
复制代码

写文件操作:

  1. '-------------------------------------------------
  2. '函数名称:WriteToTextFile
  3. '作用:利用AdoDb.Stream对象来写入UTF-8格式的文本文件
  4. '----------------------------------------------------
  5. Sub WriteToTextFile (FileUrl,byval Str,CharSet)
  6.     set stm=server.CreateObject("adodb.stream")
  7.     stm.Type=2 '以本模式读取
  8.     stm.mode=3
  9.     stm.charset=CharSet
  10.     stm.open
  11.         stm.WriteText str
  12.     stm.SaveToFile server.MapPath(FileUrl),2
  13.     stm.flush
  14.     stm.Close
  15.     set stm=nothing
  16. End Sub
复制代码


创建一个config.asp的文件

  1. call WriteToTextFile("config.asp","谁是最可爱的人","utf-8")
复制代码

[[i] 本帖最后由 HmilyHeart 于 2007-1-8 18:34 编辑 ]
回复 支持 反对

使用道具 举报

发表于 2007-1-8 20:50:09 | 显示全部楼层
中级水平 估计作者属于标准科班出身,嘿嘿。

SQL过滤那里连大小写都没有考虑……
回复 支持 反对

使用道具 举报

发表于 2007-1-8 23:16:21 | 显示全部楼层
HTTP_REFERER有时取不到……
比如location.href这样跳转。

基本上只有点连接,提交表单等的时候才有。
回复 支持 反对

使用道具 举报

发表于 2007-1-9 00:11:48 | 显示全部楼层
原帖由 [i]5do8 于 2007-1-8 14:53 发表
To uonun :

防注入的话就用ADO的Command对象,基本不需要过滤字符串.

防止站外提交 检测提交的主机头和来源,一般不会有问题.


谢谢老农。

防注入的用ADO的Command对象,可是ASP里面也有吗?

防止站外提交的话,上面的函数应该是只检测了来源,请问如何检测主机头?

如果要伪造的话,是不是类似“xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"”这样的东西?
回复 支持 反对

使用道具 举报

发表于 2007-1-9 12:34:35 | 显示全部楼层
原帖由 [i]5do8 于 2007-1-8 14:53 发表
To uonun :

防注入的话就用ADO的Command对象,基本不需要过滤字符串.

防止站外提交 检测提交的主机头和来源,一般不会有问题.



这个只能对付那些只会用注入工具的小鸟

其实 主机头和来源 是可以伪造的。包括COOKIES!

最好的办法就是自身的程序要严密。
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-1-9 14:56:56 | 显示全部楼层

回复 #9 xbrr 的帖子

哈.程序我是自学的...自学出身..

我本专业与程序设计相差八千里.

asp 不区分大小写 .

[[i] 本帖最后由 vibo 于 2007-1-9 15:03 编辑 ]
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-1-9 15:12:01 | 显示全部楼层

回复 #12 laohoo 的帖子

支持.
我提供的这个只是一个基本的防护,防菜鸟防不要高手,只是给出一个原理,具体怎么用要看你自己.
asp自身的安全并不好.但你可以做一定的防护.
比如有些机密的程序可以打包为dll,通过系统调用.
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-1-9 15:15:05 | 显示全部楼层
原帖由 [i]5do8 于 2007-1-8 14:53 发表
To uonun :

防注入的话就用ADO的Command对象,基本不需要过滤字符串.

防止站外提交 检测提交的主机头和来源,一般不会有问题.


检测提交的主机头和来源 可以伪造..
回复 支持 反对

使用道具 举报

发表于 2007-1-9 18:22:20 | 显示全部楼层
比如有些机密的程序可以打包为dll


主机商会让你注册DLL吗?
回复 支持 反对

使用道具 举报

发表于 2007-1-9 18:58:56 | 显示全部楼层
为什么不制成chm 电子手册呢 这样也方便查阅啊
回复 支持 反对

使用道具 举报

发表于 2007-1-9 20:09:56 | 显示全部楼层
不错的代码哦!以后有钱了肯定自己托管主机啦,哈哈。
回复 支持 反对

使用道具 举报

发表于 2007-1-12 20:07:58 | 显示全部楼层
不错啊哈哈
回复 支持 反对

使用道具 举报

发表于 2007-1-15 00:17:19 | 显示全部楼层
我先占个位置,有空慢慢看`~~~~
回复 支持 反对

使用道具 举报

发表于 2007-1-15 09:33:55 | 显示全部楼层
经典文章,必须得收藏,拿回去好好研究学习!谢谢!
回复 支持 反对

使用道具 举报

发表于 2008-7-25 12:08:25 | 显示全部楼层
提醒:最后回贴距现在 558 天,请不要无意义回复
原帖由 [i]vibo 于 2007-1-9 14:56 发表
哈.程序我是自学的...自学出身..

我本专业与程序设计相差八千里.

asp 不区分大小写 .

"and"="AND"吗
asp中字符串的大小写还是要区分的!
回复 支持 反对

使用道具 举报

发表于 2008-8-6 21:31:21 | 显示全部楼层

回复 uonun 在 11# 的帖子

关于ADO的Command在ASP里应用防止注入,可以参考这篇文章

http://msdn.microsoft.com/en-us/library/cc676512.aspx
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|小黑屋|Archiver|手机版|blueidea.com ( 湘ICP备12001430号 )  

GMT+8, 2020-10-31 15:14 , Processed in 0.171875 second(s), 13 queries , Gzip On, Memcache On.

Powered by Discuz! X3.2 Licensed

© 2001-2013 Comsenz Inc.

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