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

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. %>