常用ASP函数集【经验才是最重要的】

时间：2022-09-18 14:31:19
  1. <%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>  
  2. <%  
  3. StartTime=timer() '程序执行时间检测  
  4.  
  5. '###############################################################  
  6. '┌──VIBO───────────────────┐  
  7. '│             VIBO STUDIO 版权所有             │  
  8. '└───────────────────────┘  
  9. ' Author:Vibo  
  10. ' Email:vibo_cn@hotmail.com  
  11. '----------------- Vibo ASP站点开发常用函数库 ------------------  
  12. 'OpenDB(vdata_url)   -------------------- 打开数据库  
  13. 'getIp()  ------------------------------- 得到真实IP  
  14. 'getIPAdress(sip)------------------------ 查找ip对应的真实地址  
  15. 'IP2Num(sip) ---------------------------- 限制某段IP地址  
  16. 'chkFrom() ------------------------------ 防站外提交设定  
  17. 'getsys() ------------------------------- 操作系统检测  
  18. 'GetBrowser() --------------------------- 浏览器版本检测  
  19. 'GetSearcher() -------------------------- 识别搜索引擎  
  20. '  
  21. '---------------------- 数据过滤 ↓----------------------------  
  22. 'CheckStr(byVal ChkStr) ----------------- 检查无效字符  
  23. 'CheckSql() ----------------------------- 防止SQL注入  
  24.  
  25. 'UnCheckStr(Str)------------------------- 检查非法sql命令  
  26. 'Checkstr(Str) -------------------------- ASP最新SQL防注入过滤涵数  
  27.  
  28. 'HTMLEncode(reString) ------------------- 过滤转换HTML代码  
  29. 'DateToStr(DateTime,ShowType) ----------- 日期转换函数  
  30. 'Date2Chinese(iDate) -------------------- 获得ASP的中文日期字符串  
  31. 'lenStr(str) ---------------------------- 计算字符串长度（字节）  
  32.  
  33. 'CreateArr(str) ------------------------- 生成二维数组  
  34. 'ShowRsArr(rsArr) ----------------------- 用表格显示记录集getrows生成的数组的表结构  
  35.  
  36. '---------------------- 外接组件使用函数↓------------------------  
  37. 'sendMail(to_Email,from_Email,from_Name,mail_Subject,mail_Body,mail_htmlBody) -----'Jmail组件 发送邮件  
  38.  
  39. '-----------------------------------------系统检测函数↓------------------------------------------  
  40. 'IsValidUrl(url) ------------------------ 检测网页是否有效  
  41. 'getHTMLPage(filename) ------------------ 获取文件内容  
  42. 'CheckFile(FilePath) -------------------- 检查某一文件是否存在  
  43. 'CheckDir(FolderPath) ------------------- 检查某一目录是否存在  
  44. 'MakeNewsDir(foldername) ---------------- 根据指定名称生成目录  
  45. 'CreateHTMLPage(filename,FileData,C_mode) 生成文件  
  46.  
  47. 'CheckBadWord(byVal ChkStr) ------------- 过滤脏字  
  48. '###############################################################  
  49.  
  50. Dim ipData_url  
  51. ipData_url="./Ip.mdb"  
  52.  
  53. Response.Write("--------------客户端信息检测------------"&"<br>")  
  54. Response.Write(getsys()&"<br>")  
  55. Response.Write(GetBrowser()&"<br>")  
  56. Response.Write(GetSearcher()&"<br>")  
  57. Response.Write("IP:"&getIp()&"<br>")  
  58. Response.Write("来源:"&(getIPAdress(GetIp()))&"<br>")  
  59. Response.Write("<br>")  
  60.  
  61. Response.Write("--------------数据提交检测--------------"&"<br>")  
  62. if not chkFrom then  
  63.     Response.write("请不要从站外提交内容！"&"<br>")  
  64.     Response.end  
  65. else  
  66.     Response.write("本站提交内容！"&"<br><br>")  
  67. End if  
  68.  
  69.  
  70. function OpenDB(vdata_url)  
  71. '------------------------------打开数据库  
  72. '使用:Conn = OpenDB("data/data.mdb")  
  73.   Dim vibo_Conn  
  74.   Set vibo_Conn= Server.CreateObject("ADODB.Connection")  
  75.   vibo_Conn.ConnectionString="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(vdata_url)  
  76.   vibo_Conn.Open  
  77.   OpenDB=vibo_Conn  
  78. End Function  
  79.  
  80. function getIp()  
  81. '-----------------------得到真实IP  
  82. userip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")  
  83. If userip = "" Then userip = Request.ServerVariables("REMOTE_ADDR")  
  84. getIp=userip  
  85. End function  
  86.  
  87. Function getIPAdress(sip)  
  88. '---------------------查找ip对应的真实地址  
  89. Dim iparr,iprs,country,city  
  90. If sip="127.0.0.1" then sip= "192.168.0.1"     
  91. iparr=split(sip,".")  
  92. sip=cint(iparr(0))*256*256*256+cint(iparr(1))*256*256+cint(iparr(2))*256+cint(iparr(3))-1  
  93. Dim vibo_ipconn_STRING  
  94. vibo_ipconn_STRING = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Server.MapPath(ipData_url)  
  95. Set iprs = Server.CreateObject("ADODB.Recordset")  
  96. iprs.ActiveConnection = vibo_ipconn_STRING  
  97. iprs.Source = "Select Top 1 city, country FROM address Where ip1 <=" & sip & " and " & sip & "<=ip2"  
  98. iprs.CursorType = 0  
  99. iprs.CursorLocation = 2  
  100. iprs.LockType = 1  
  101. iprs.Open()  
  102.  
  103. If iprs.bof and iprs.eof then  
  104.     country="未知地区"  
  105.     city=""  
  106. Else  
  107.     country=iprs.Fields.Item("country").Value  
  108.     city=iprs.Fields.Item("city").Value  
  109. End If  
  110. getIPAdress=country&city  
  111. iprs.Close()  
  112. Set iprs = Nothing  
  113. End Function  
  114.  
  115. Function IP2Num(sip)  
  116. '--------------------限制某段IP地址  
  117.  
  118.     dim str1,str2,str3,str4  
  119.     dim num  
  120.     IP2Num=0  
  121.     if isnumeric(left(sip,2)) then  
  122.         str1=left(sip,instr(sip,".")-1)  
  123.         sip=mid(sip,instr(sip,".")+1)  
  124.         str2=left(sip,instr(sip,".")-1)  
  125.         sip=mid(sip,instr(sip,".")+1)  
  126.         str3=left(sip,instr(sip,".")-1)  
  127.         str4=mid(sip,instr(sip,".")+1)  
  128.         num=cint(str1)*256*256*256+cint(str2)*256*256+cint(str3)*256+cint(str4)-1  
  129.         IP2Num = num  
  130.     end if  
  131. end function  
  132.  
  133. 'userIPnum = IP2Num(Request.ServerVariables("REMOTE_ADDR"))  
  134. 'if userIPnum > IP2Num("192.168.0.0") and userIPnum < IP2Num("192.168.0.255") then  
  135.     'response.write ("<center>您的IP被禁止</center>")  
  136.     'response.end  
  137. 'end if  
  138.  
  139.  
  140. Function chkFrom()  
  141. '----------------------------防站外提交设定  
  142.     Dim server_v1,server_v2, server1, server2  
  143.     chkFrom=False  
  144.     server1=Cstr(Request.ServerVariables("HTTP_REFERER"))  
  145.     server2=Cstr(Request.ServerVariables("SERVER_NAME"))  
  146.     If Mid(server1,8,len(server2))=server2 Then chkFrom=True  
  147. End Function  
  148. 'if not chkFrom then  
  149.     'Response.write("请不要从站外提交内容！")  
  150.     'Response.end  
  151. 'End if  
  152.  
  153. function getsys()  
  154. '----------------------------------操作系统检测  
  155. vibo_soft=Request.ServerVariables("HTTP_USER_AGENT")  
  156. if instr(vibo_soft,"Windows NT 5.0") then  
  157.     msm="Win 2000"  
  158. elseif instr(vibo_soft,"Windows NT 5.1") then  
  159.     msm="Win XP"  
  160. elseif instr(vibo_soft,"Windows NT 5.2") then  
  161.     msm="Win 2003"  
  162. elseif instr(vibo_soft,"4.0") then  
  163.     msm="Win NT"  
  164. elseif instr(vibo_soft,"NT") then  
  165.     msm="Win NT"  
  166. elseif instr(vibo_soft,"Windows CE") then  
  167.     msm="Windows CE"  
  168. elseif instr(vibo_soft,"Windows 9") then  
  169.     msm="Win 9x"  
  170. elseif instr(vibo_soft,"9x") then  
  171.     msm="Windows ME"  
  172. elseif instr(vibo_soft,"98") then  
  173.     msm="Windows 98"  
  174. elseif instr(vibo_soft,"Windows 95") then  
  175.     msm="Windows 95"  
  176. elseif instr(vibo_soft,"Win32") then  
  177.     msm="Win32"  
  178. elseif instr(vibo_soft,"unix") or instr(vibo_soft,"linux") or instr(vibo_soft,"SunOS") or instr(vibo_soft,"BSD") then  
  179.     msm="类Unix"  
  180. elseif instr(vibo_soft,"Mac") then  
  181.     msm="Mac"  
  182. else  
  183.     msm="Other"  
  184. end if  
  185. getsys=msm  
  186. End Function  
  187.  
  188. function GetBrowser()  
  189. '----------------------------------浏览器版本检测  
  190. dim vibo_soft  
  191. vibo_soft=Request.ServerVariables("HTTP_USER_AGENT")  
  192. Browser="unknown"  
  193. version="unknown"  
  194. 'vibo_soft="Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; TencentTraveler ; .NET CLR 1.1.4322)"      
  195. If Left(vibo_soft,7) ="Mozilla" Then '有此标识为浏览器  
  196.             vibo_soft=Split(vibo_soft,";")  
  197.             If InStr(vibo_soft(1),"MSIE")>0 Then  
  198.                 Browser="Microsoft Internet Explorer "  
  199.                 version=Trim(Left(Replace(vibo_soft(1),"MSIE",""),6))  
  200.             ElseIf InStr(vibo_soft(4),"Netscape")>0 Then  
  201.                 Browser="Netscape "  
  202.                 tmpstr=Split(vibo_soft(4),"/")  
  203.                 version=tmpstr(UBound(tmpstr))  
  204.             ElseIf InStr(vibo_soft(4),"rv:")>0 Then  
  205.                 Browser="Mozilla "  
  206.                 tmpstr=Split(vibo_soft(4),":")  
  207.                 version=tmpstr(UBound(tmpstr))  
  208.                 If InStr(version,")") > 0 Then  
  209.                     tmpstr=Split(version,")")  
  210.                     version=tmpstr(0)  
  211.                 End If  
  212.             End If  
  213. ElseIf Left(vibo_soft,5) ="Opera" Then  
  214.             vibo_soft=Split(vibo_soft,"/")  
  215.             Browser="Mozilla "  
  216.             tmpstr=Split(vibo_soft(1)," ")  
  217.             version=tmpstr(0)  
  218. End If  
  219. If version<>"unknown" Then  
  220.             Dim Tmpstr1  
  221.             Tmpstr1=Trim(Replace(version,".",""))  
  222.             If Not IsNumeric(Tmpstr1) Then  
  223.                 version="unknown"  
  224.             End If  
  225. End If  
  226. GetBrowser=Browser &" "& version  
  227. End function  
  228.  
  229. function GetSearcher()  
  230. '----------------------识别搜索引擎  
  231. Dim botlist,Searcher  
  232. Dim vibo_soft  
  233. vibo_soft=Request.ServerVariables("HTTP_USER_AGENT")  
  234.  
  235. Botlist="Google,Isaac,SurveyBot,Baiduspider,ia_archiver,P.Arthur,FAST-WebCrawler,Java,Microsoft-ATL-Native,TurnitinBot,WebGather,Sleipnir,TencentTraveler"  
  236. Botlist=split(Botlist,",")  
  237.   For i=0 to UBound(Botlist)  
  238.     If InStr(vibo_soft,Botlist(i))>0  Then  
  239.       Searcher=Botlist(i)&" 搜索器"  
  240.       IsSearch=True  
  241.       Exit For  
  242.     End If  
  243.   Next  
  244. If IsSearch Then  
  245.   GetSearcher=Searcher  
  246. else  
  247.   GetSearcher="unknown"  
  248. End if  
  249. End function  
  250.  
  251.  
  252. '----------------------------------数据过滤 ↓---------------------------------------  
  253. Function CheckSql() '防止SQL注入  
  254.     Dim sql_injdata    
  255.     SQL_injdata = "'|and|exec|insert|select|delete|update|count|*|%|chr|mid|master|truncate|char|declare"  
  256.     SQL_inj = split(SQL_Injdata,"|")  
  257.     If Request.QueryString<>"" Then  
  258.         For Each SQL_Get In Request.QueryString  
  259.             For SQL_Data=0 To Ubound(SQL_inj)  
  260.                 if instr(Request.QueryString(SQL_Get),Sql_Inj(Sql_DATA))>0 Then  
  261.                     Response.Write "<Script Language='javascript'>{alert('请不要在参数中包含非法字符！');history.back(-1)}< /Script>"  
  262.                     Response.end  
  263.                 end if  
  264.             next  
  265.         Next  
  266.     End If  
  267.     If Request.Form<>"" Then  
  268.         For Each Sql_Post In Request.Form  
  269.             For SQL_Data=0 To Ubound(SQL_inj)  
  270.                 if instr(Request.Form(Sql_Post),Sql_Inj(Sql_DATA))>0 Then  
  271.                     Response.Write "<Script Language='javascript'>{alert('请不要在参数中包含非法字符！');history.back(-1)}     </Script>"  
  272.                     Response.end  
  273.                 end if  
  274.             next  
  275.         next  
  276.     end if  
  277. End Function  
  278.  
  279. Function CheckStr(byVal ChkStr) '检查无效字符  
  280.     Dim Str:Str=ChkStr  
  281.     Str=Trim(Str)  
  282.     If IsNull(Str) Then  
  283.         CheckStr = ""  
  284.         Exit Function  
  285.     End If  
  286.     Dim re  
  287.     Set re=new RegExp  
  288.     re.IgnoreCase =True  
  289.     re.Global=True  
  290.     re.Pattern="(\r\n){3,}"  
  291.     Str=re.Replace(Str,"$1$1$1")  
  292.     Set re=Nothing  
  293.     Str = Replace(Str,"'","''")  
  294.     Str = Replace(Str, "select", "select")  
  295.     Str = Replace(Str, "join", "join")  
  296.     Str = Replace(Str, "union", "union")  
  297.     Str = Replace(Str, "where", "where")  
  298.     Str = Replace(Str, "insert", "insert")  
  299.     Str = Replace(Str, "delete", "delete")  
  300.     Str = Replace(Str, "update", "update")  
  301.     Str = Replace(Str, "like", "like")  
  302.     Str = Replace(Str, "drop", "drop")  
  303.     Str = Replace(Str, "create", "create")  
  304.     Str = Replace(Str, "modify", "modify")  
  305.     Str = Replace(Str, "rename", "rename")  
  306.     Str = Replace(Str, "alter", "alter")  
  307.     Str = Replace(Str, "cast", "cast")  
  308.     CheckStr=Str  
  309. End Function  
  310.  
  311. Function UnCheckStr(Str) '检查非法sql命令  
  312.         Str = Replace(Str, "select", "select")  
  313.         Str = Replace(Str, "join", "join")  
  314.         Str = Replace(Str, "union", "union")  
  315.         Str = Replace(Str, "where", "where")  
  316.         Str = Replace(Str, "insert", "insert")  
  317.         Str = Replace(Str, "delete", "delete")  
  318.         Str = Replace(Str, "update", "update")  
  319.         Str = Replace(Str, "like", "like")  
  320.         Str = Replace(Str, "drop", "drop")  
  321.         Str = Replace(Str, "create", "create")  
  322.         Str = Replace(Str, "modify", "modify")  
  323.         Str = Replace(Str, "rename", "rename")  
  324.         Str = Replace(Str, "alter", "alter")  
  325.         Str = Replace(Str, "cast", "cast")  
  326.         UnCheckStr=Str  
  327. End Function  
  328.  
  329. Function Checkstr(Str) 'SQL防注入过滤涵数  
  330.     If Isnull(Str) Then  
  331.     CheckStr = ""  
  332.     Exit Function  
  333.     End If  
  334.     Str = Replace(Str,Chr(0),"", 1, -1, 1)  
  335.     Str = Replace(Str, """", """", 1, -1, 1)  
  336.     Str = Replace(Str,"<","<", 1, -1, 1)  
  337.     Str = Replace(Str,">",">", 1, -1, 1)  
  338.     Str = Replace(Str, "script", "script", 1, -1, 0)  
  339.     Str = Replace(Str, "SCRIPT", "SCRIPT", 1, -1, 0)  
  340.     Str = Replace(Str, "Script", "Script", 1, -1, 0)  
  341.     Str = Replace(Str, "script", "Script", 1, -1, 1)  
  342.     Str = Replace(Str, "object", "object", 1, -1, 0)  
  343.     Str = Replace(Str, "OBJECT", "OBJECT", 1, -1, 0)  
  344.     Str = Replace(Str, "Object", "Object", 1, -1, 0)  
  345.     Str = Replace(Str, "object", "Object", 1, -1, 1)  
  346.     Str = Replace(Str, "applet", "applet", 1, -1, 0)  
  347.     Str = Replace(Str, "APPLET", "APPLET", 1, -1, 0)  
  348.     Str = Replace(Str, "Applet", "Applet", 1, -1, 0)  
  349.     Str = Replace(Str, "applet", "Applet", 1, -1, 1)  
  350.     Str = Replace(Str, "[", "[")  
  351.     Str = Replace(Str, "]", "]")  
  352.     Str = Replace(Str, """", "", 1, -1, 1)  
  353.     Str = Replace(Str, "=", "=", 1, -1, 1)  
  354.     Str = Replace(Str, "'", "''", 1, -1, 1)  
  355.     Str = Replace(Str, "select", "select", 1, -1, 1)  
  356.     Str = Replace(Str, "execute", "execute", 1, -1, 1)  
  357.     Str = Replace(Str, "exec", "exec", 1, -1, 1)  
  358.     Str = Replace(Str, "join", "join", 1, -1, 1)  
  359.     Str = Replace(Str, "union", "union", 1, -1, 1)  
  360.     Str = Replace(Str, "where", "where", 1, -1, 1)  
  361.     Str = Replace(Str, "insert", "insert", 1, -1, 1)  
  362.     Str = Replace(Str, "delete", "delete", 1, -1, 1)  
  363.     Str = Replace(Str, "update", "update", 1, -1, 1)  
  364.     Str = Replace(Str, "like", "like", 1, -1, 1)  
  365.     Str = Replace(Str, "drop", "drop", 1, -1, 1)  
  366.     Str = Replace(Str, "create", "create", 1, -1, 1)  
  367.     Str = Replace(Str, "rename", "rename", 1, -1, 1)  
  368.     Str = Replace(Str, "count", "count", 1, -1, 1)  
  369.     Str = Replace(Str, "chr", "chr", 1, -1, 1)  
  370.     Str = Replace(Str, "mid", "mid", 1, -1, 1)  
  371.     Str = Replace(Str, "truncate", "truncate", 1, -1, 1)  
  372.     Str = Replace(Str, "nchar", "nchar", 1, -1, 1)  
  373.     Str = Replace(Str, "char", "char", 1, -1, 1)  
  374.     Str = Replace(Str, "alter", "alter", 1, -1, 1)  
  375.     Str = Replace(Str, "cast", "cast", 1, -1, 1)  
  376.     Str = Replace(Str, "exists", "exists", 1, -1, 1)  
  377.     Str = Replace(Str,Chr(13),"<br>", 1, -1, 1)  
  378.     CheckStr = Replace(Str,"'","''", 1, -1, 1)  
  379. End Function  
  380.  
  381. Function HTMLEncode(reString) '过滤转换HTML代码  
  382.     Dim Str:Str=reString  
  383.     If Not IsNull(Str) Then  
  384.         Str = UnCheckStr(Str)  
  385.         Str = Replace(Str, "&", "&")  
  386.         Str = Replace(Str, ">", ">")  
  387.         Str = Replace(Str, "<", "<")  
  388.         Str = Replace(Str, CHR(32), " ")  
  389.         Str = Replace(Str, CHR(9), "    ")  
  390.         Str = Replace(Str, CHR(9), "    ")  
  391.         Str = Replace(Str, CHR(34),""")  
  392.         Str = Replace(Str, CHR(39),"'")  
  393.         Str = Replace(Str, CHR(13), "")  
  394.         Str = Replace(Str, CHR(10), "<br>")  
  395.         HTMLEncode = Str  
  396.     End If  
  397. End Function  
  398.  
  399. Function DateToStr(DateTime,ShowType)  '日期转换函数  
  400.     Dim DateMonth,DateDay,DateHour,DateMinute  
  401.     DateMonth=Month(DateTime)  
  402.     DateDay=Day(DateTime)  
  403.     DateHour=Hour(DateTime)  
  404.     DateMinute=Minute(DateTime)  
  405.     If Len(DateMonth)<2 Then DateMonth="0"&DateMonth  
  406.     If Len(DateDay)<2 Then DateDay="0"&DateDay  
  407.     Select Case ShowType  
  408.     Case "Y-m-d"    
  409.         DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay  
  410.     Case "Y-m-d H:I A"  
  411.         Dim DateAMPM  
  412.         If DateHour>12 Then  
  413.             DateHour=DateHour-12  
  414.             DateAMPM="PM"  
  415.         Else  
  416.             DateHour=DateHour  
  417.             DateAMPM="AM"  
  418.         End If  
  419.         If Len(DateHour)<2 Then DateHour="0"&DateHour      
  420.         If Len(DateMinute)<2 Then DateMinute="0"&DateMinute  
  421.         DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&" "&DateAMPM  
  422.     Case "Y-m-d H:I:S"  
  423.         Dim DateSecond  
  424.         DateSecond=Second(DateTime)  
  425.         If Len(DateHour)<2 Then DateHour="0"&DateHour      
  426.         If Len(DateMinute)<2 Then DateMinute="0"&DateMinute  
  427.         If Len(DateSecond)<2 Then DateSecond="0"&DateSecond  
  428.         DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&":"&DateSecond  
  429.     Case "YmdHIS"  
  430.         DateSecond=Second(DateTime)  
  431.         If Len(DateHour)<2 Then DateHour="0"&DateHour      
  432.         If Len(DateMinute)<2 Then DateMinute="0"&DateMinute  
  433.         If Len(DateSecond)<2 Then DateSecond="0"&DateSecond  
  434.         DateToStr=Year(DateTime)&DateMonth&DateDay&DateHour&DateMinute&DateSecond      
  435.     Case "ym"  
  436.         DateToStr=Right(Year(DateTime),2)&DateMonth  
  437.     Case "d"  
  438.         DateToStr=DateDay  
  439.     Case Else  
  440.         If Len(DateHour)<2 Then DateHour="0"&DateHour  
  441.         If Len(DateMinute)<2 Then DateMinute="0"&DateMinute  
  442.         DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute  
  443.     End Select  
  444. End Function  
  445.  
  446. Function Date2Chinese(iDate) '获得ASP的中文日期字符串  
  447. 　 　 Dim num(10)  
  448. 　 　 Dim iYear  
  449. 　 　 Dim iMonth  
  450. 　 　 Dim iDay  
  451.  
  452. 　 　 num(0) = "〇"  
  453. 　 　 num(1) = "一"  
  454. 　 　 num(2) = "二"  
  455. 　 　 num(3) = "三"  
  456. 　 　 num(4) = "四"  
  457. 　 　 num(5) = "五"  
  458. 　 　 num(6) = "六"  
  459. 　 　 num(7) = "七"  
  460. 　 　 num(8) = "八"  
  461. 　 　 num(9) = "九"  
  462.  
  463. 　 　 iYear = Year(iDate)  
  464. 　 　 iMonth = Month(iDate)  
  465. 　 　 iDay = Day(iDate)  
  466. 　 　 Date2Chinese = num(iYear \ 1000) + num((iYear \ 100) Mod 10) + num((iYear\ 10) Mod 10) + num(iYear Mod 10) + "年"  
  467. 　 　 If iMonth >= 10 Then  
  468. 　 　 　 　 If iMonth = 10 Then  
  469. 　 　 　 　 　 　 Date2Chinese = Date2Chinese + "十" + "月"  
  470. 　 　 　 　 Else  
  471. 　 　 　 　 　 　 Date2Chinese = Date2Chinese + "十" + num(iMonth Mod 10) + "月"  
  472. 　 　 　 　 End If  
  473. 　 　 Else  
  474. 　 　 　 　 Date2Chinese = Date2Chinese + num(iMonth Mod 10) + "月"  
  475. 　 　 End If  
  476. 　 　 If iDay >= 10 Then  
  477. 　 　 　 　 If iDay = 10 Then  
  478. 　 　 　 　 　 　 Date2Chinese = Date2Chinese +"十" + "日"  
  479. 　 　 　 　 ElseIf iDay = 20 or iDay = 30 Then  
  480. 　 　 　 　 　 　 Date2Chinese = Date2Chinese + num(iDay \ 10) + "十" + "日"  
  481. 　 　 　 　 ElseIf iDay > 20 Then  
  482. 　 　 　 　 　 　 Date2Chinese = Date2Chinese + num(iDay \ 10) + "十" +num(iDay Mod 10) + "日"  
  483. 　 　 　 　 Else  
  484. 　 　　 　 　 　 Date2Chinese = Date2Chinese + "十" + num(iDay Mod 10) + "日"  
  485. 　 　 　 　 End If  
  486. 　 　 Else  
  487. 　 　 　 　 Date2Chinese = Date2Chinese + num(iDay Mod 10) + "日"  
  488. 　 　 End If  
  489. End Function  
  490.  
  491.  
  492. Function lenStr(str)'计算字符串长度（字节）  
  493.     dim l,t,c  
  494.     dim i  
  495.     l=len(str)  
  496.     t=0  
  497. for i=1 to l  
  498.     c=asc(mid(str,i,1))  
  499.     if c<0 then c=c+65536  
  500.     if c<255 then t=t+1  
  501.     if c>255 then t=t+2  
  502. next  
  503.    lenstr=t  
  504. End Function  
  505.  
  506. Function CreateArr(str) '生成二维数组 数据如："1,a1,b1,c1,d1|2,a2,b2,c2,d2|5,a3,b3,c3,d3|8,a4,b4,c4,d4"  
  507. dim arr()  
  508. str=split(str,"|")  
  509. for i=0 to UBound(str)  
  510.     arrstr=split(str(i),",")  
  511.     for j=0 to Ubound(arrstr)  
  512.         ReDim Preserve arr(UBound(str),UBound(arrstr))  
  513.         arr(i,j)=arrstr(j)  
  514.     next  
  515. next  
  516. CreateArr=arr  
  517. End Function  
  518.  
  519. Function ShowRsArr(rsArr) '用表格显示记录集getrows生成的数组的表结构  
  520. showHtml="<table width=100% border=1 cellspacing=0 cellpadding=0>"  
  521.     If Not IsEmpty(rsArr) Then  
  522.         For y=0 To Ubound(rsArr,2)  
  523.         showHtml=showHtml&"<tr>"  
  524.             for x=0 to Ubound(rsArr,1)  
  525.                 showHtml=showHtml& "<td>"&rsArr(x,y)&"</td>"  
  526.             next  
  527.         showHtml=showHtml&"</tr>"  
  528.         next  
  529.     Else  
  530.         RshowHtml=showHtml&"<tr>"  
  531.         showHtml=showHtml&"<td>No Records</td>"  
  532.         showHtml=showHtml&"</tr>"  
  533.     End If  
  534.         showHtml=showHtml&"</table>"  
  535.     ShowRsArr=showHtml  
  536. End Function  
  537.  
  538.  
  539. '-----------------------------------------外接组件使用函数↓------------------------------------------  
  540.  
  541. Function sendMail(to_Email,from_Email,from_Name,mail_Subject,mail_Body,mail_htmlBody) 'Jmail 发送邮件  
  542.   Set vibo_mail = Server.CreateObject("JMAIL.Message")    '建立发送邮件的对象  
  543.   vibo_mail.silent = true                                 '屏蔽例外错误，返回FALSE跟TRUE两值j  
  544.   vibo_mail.logging = true                                '启用邮件日志  
  545.   vibo_mail.Charset = "gb2312"                            '邮件的文字编码为国标  
  546.  
  547.   'vibo_mail.ContentType = "text/html"                     '邮件的格式为HTML格式  
  548.   'vibo_mail.Prority = 1                                   '邮件的紧急程序，1 为最快，5 为最慢， 3 为默认值  
  549.  
  550.   vibo_mail.AddRecipient to_Email                         '邮件收件人的地址  
  551.   vibo_mail.From = from_Email                             '发件人的E-MAIL地址  
  552.   vibo_mail.FromName = from_Name                          '发件人姓名  
  553.   vibo_mail.MailServerUserName = "system@aaa.com"       '登录邮件服务器所需的用户名  
  554.   vibo_mail.MailServerPassword = "asdasd"     '登录邮件服务器所需的密码  
  555.   vibo_mail.Subject = mail_Subject                        '邮件的标题  
  556.   vibo_mail.Body = mail_Body                              '正文  
  557.   vibo_mail.HTMLBody = mail_htmlBody                      'HTML正文  
  558.   vibo_mail.ReturnReceipt = True  
  559.   vibo_mail.Send("smtp.263xmail.com")                     '执行邮件发送（通过邮件服务器地址）  
  560.   vibo_mail.Close()  
  561.   set vibo_mail=nothing  
  562. End Function  
  563.  
  564. '---------------------------------------程序执行时间检测↓----------------------------------------------  
  565. EndTime=Timer()  
  566. If EndTime<StartTime Then  
  567.     EndTime=EndTime+24*3600  
  568. End if  
  569. runTime=(EndTime-StartTime)*1000  
  570. Response.Write("------------程序执行时间检测------------"&"<br>")  
  571. Response.Write("程序执行时间"&runTime&"毫秒")  
  572.  
  573.  
  574. '-----------------------------------------系统检测使用函数↓------------------------------------------  
  575. '---------------------检测网页是否有效-----------------------  
  576. Function IsValidUrl(url)  
  577.         Set xl = Server.CreateObject("Microsoft.XMLHTTP")  
  578.         xl.Open "HEAD",url,False  
  579.         xl.Send  
  580.         IsValidUrl = (xl.status=200)  
  581. End Function  
  582. 'If IsValidUrl(""&fileurl&"") Then  
  583. '    response.redirect fileurl  
  584. 'Else  
  585. '    Response.Write "由于下载用户过多,程序检测到文件暂时无法下载,请更换其他下载地址!感谢您对本软件网站的支持哦^_^"  
  586. 'End If  
  587. '------------------检查某一目录是否存在-------------------  
  588.  
  589. Function getHTMLPage(filename) '获取文件内容  
  590.     Dim fso,file  
  591.     Set fso = Server.CreateObject("Scripting.FileSystemObject")  
  592.     Set File=fso.OpenTextFile(server.mappath(filename))  
  593.     showHtml=File.ReadAll  
  594.     File.close  
  595.     Set File=nothing  
  596.     Set fso=nothing  
  597.     getHTMLPage=showHtml '输出  
  598. End function  
  599.  
  600. Function CheckDir(FolderPath)  
  601.     dim fso  
  602.     folderpath=Server.MapPath(".")&"\"&folderpath  
  603.     Set fso = Server.CreateObject("Scripting.FileSystemObject")  
  604.     If fso.FolderExists(FolderPath) then  
  605.     '存在  
  606.         CheckDir = True  
  607.     Else  
  608.     '不存在  
  609.         CheckDir = False  
  610.     End if  
  611.     Set fso = nothing  
  612. End Function  
  613.  
  614. Function CheckFile(FilePath) '检查某一文件是否存在  
  615.     Dim fso  
  616.     Filepath=Server.MapPath(FilePath)  
  617.     Set fso = Server.CreateObject("Scripting.FileSystemObject")  
  618.     If fso.FileExists(FilePath) then  
  619.     '存在  
  620.         CheckFile = True  
  621.     Else  
  622.     '不存在  
  623.         CheckFile = False  
  624.     End if  
  625.     Set fso = nothing  
  626. End Function  
  627.  
  628. '-------------根据指定名称生成目录---------  
  629. Function MakeNewsDir(foldername)  
  630.     dim fso,f  
  631.     Set fso = Server.CreateObject("Scripting.FileSystemObject")  
  632.     Set f = fso.CreateFolder(foldername)  
  633.     MakeNewsDir = True  
  634.     Set fso = nothing  
  635. End Function  
  636.  
  637. Function CreateHTMLPage(filename,FileData,C_mode) '生成文件  
  638.     if C_mode=0 then '使用FSO生成  
  639.         Dim fso,txt  
  640.         Set fso = CreateObject("Scripting.FileSystemObject")  
  641.         Filepath=Server.MapPath(filename)  
  642.         if CheckFile(filename) then fso.DeleteFile Filepath,True '防止续写  
  643.         Set txt=fso.OpenTextFile(Filepath,8,True)    
  644.         txt.Write FileData  
  645.         txt.Close  
  646.         Set fso = nothing  
  647.     elseif C_mode=1 then '使用Stream生成  
  648.         Dim viboStream  
  649.         On Error Resume Next  
  650.         Set viboStream = Server.createObject("ADODB.Stream")  
  651.  
  652.         If Err.Number=-2147221005 Then  
  653.             Response.Write "<div align='center' style=""font-size:12px;font-family:Tahoma;"">非常遗憾,您的主机不支持 ADODB.Stream,不能使用本程序</div>"  
  654.             Err.Clear  
  655.             Response.End  
  656.         End If  
  657.  
  658.         With viboStream  
  659.         .Type = 2  
  660.         .Open  
  661.         .CharSet = "GB2312"  
  662.         .Position = objStream.Size  
  663.         .WriteText = FileData  
  664.         .SaveToFile Server.MapPath(filename),2  
  665.         .Close  
  666.         End With  
  667.         Set viboStream = Nothing      
  668.     end if  
  669.     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>"  
  670.     Response.Flush()  
  671. End Function  
  672.  
  673. Function CheckBadWord(byVal ChkStr)'过滤脏字  
  674.     Dim Str:Str = ChkStr  
  675.     Str = Trim(Str)  
  676.     If IsNull(Str) Then  
  677.         CheckBadWord = ""  
  678.         Exit Function  
  679.     End If  
  680.  
  681.     DIC = getHTMLPage("include/badWord.txt")'载入脏字词典  
  682.     DICArr = split(DIC,CHR(10))  
  683.     For i  =0 To Ubound(DICArr )  
  684.         WordDIC = split(DICArr(i),"=")  
  685.         Str = Replace(Str,WordDIC(0),WordDIC(1))  
  686.     next  
  687.     CheckBadWord = Str  
  688. End function  
  689. %>  
标签：

相关文章