|
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<% StartTime=timer() '程序執(zhí)行時(shí)間檢測(cè) '############################################################### '┌──VIBO───────────────────┐ '│ VIBO STUDIO 版權(quán)所有 │ '└───────────────────────┘ ' Author:Vibo ' Email:vibo_cn@hotmail.com '----------------- Vibo ASP站點(diǎn)開發(fā)常用函數(shù)庫 ------------------ 'OpenDB(vdata_url) -------------------- 打開數(shù)據(jù)庫 'getIp() ------------------------------- 得到真實(shí)IP 'getIPAdress(sip)------------------------ 查找ip對(duì)應(yīng)的真實(shí)地址 'IP2Num(sip) ---------------------------- 限制某段IP地址 'chkFrom() ------------------------------ 防站外提交設(shè)定 'getsys() ------------------------------- 操作系統(tǒng)檢測(cè) 'GetBrowser() --------------------------- 瀏覽器版本檢測(cè) 'GetSearcher() -------------------------- 識(shí)別搜索引擎 ' '---------------------- 數(shù)據(jù)過濾 ↓---------------------------- 'CheckStr(byVal ChkStr) ----------------- 檢查無效字符 'CheckSql() ----------------------------- 防止SQL注入 'UnCheckStr(Str)------------------------- 檢查非法sql命令 'Checkstr(Str) -------------------------- ASP最新SQL防注入過濾涵數(shù) 'HTMLEncode(reString) ------------------- 過濾轉(zhuǎn)換HTML代碼 'DateToStr(DateTime,ShowType) ----------- 日期轉(zhuǎn)換函數(shù) 'Date2Chinese(iDate) -------------------- 獲得ASP的中文日期字符串 'lenStr(str) ---------------------------- 計(jì)算字符串長度（字節(jié)） 'CreateArr(str) ------------------------- 生成二維數(shù)組 'ShowRsArr(rsArr) ----------------------- 用表格顯示記錄集getrows生成的數(shù)組的表結(jié)構(gòu) '---------------------- 外接組件使用函數(shù)↓------------------------ 'sendMail(to_Email,from_Email,from_Name,mail_Subject,mail_Body,mail_htmlBody) -----'Jmail組件 發(fā)送郵件 '-----------------------------------------系統(tǒng)檢測(cè)函數(shù)↓------------------------------------------ 'IsValidUrl(url) ------------------------ 檢測(cè)網(wǎng)頁是否有效 'getHTMLPage(filename) ------------------ 獲取文件內(nèi)容 'CheckFile(FilePath) -------------------- 檢查某一文件是否存在 'CheckDir(FolderPath) ------------------- 檢查某一目錄是否存在 'MakeNewsDir(foldername) ---------------- 根據(jù)指定名稱生成目錄 'CreateHTMLPage(filename,FileData,C_mode) 生成文件 'CheckBadWord(byVal ChkStr) ------------- 過濾臟字 '############################################################### Dim ipData_url ipData_url="./Ip.mdb" Response.Write("--------------客戶端信息檢測(cè)------------"&"<br>") Response.Write(getsys()&"<br>") Response.Write(GetBrowser()&"<br>") Response.Write(GetSearcher()&"<br>") Response.Write("IP:"&getIp()&"<br>") Response.Write("來源:"&(getIPAdress(GetIp()))&"<br>") Response.Write("<br>") Response.Write("--------------數(shù)據(jù)提交檢測(cè)--------------"&"<br>") if not chkFrom then Response.write("請(qǐng)不要從站外提交內(nèi)容！"&"<br>") Response.end else Response.write("本站提交內(nèi)容！"&"<br><br>") End if function OpenDB(vdata_url) '------------------------------打開數(shù)據(jù)庫 '使用:Conn = OpenDB("data/data.mdb") Dim vibo_Conn Set vibo_Conn= Server.CreateObject("ADODB.Connection") vibo_Conn.ConnectionString="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(vdata_url) vibo_Conn.Open OpenDB=vibo_Conn End Function function getIp() '-----------------------得到真實(shí)IP userip = Request.ServerVariables("HTTP_X_FORWARDED_FOR") If userip = "" Then userip = Request.ServerVariables("REMOTE_ADDR") getIp=userip End function Function getIPAdress(sip) '---------------------查找ip對(duì)應(yīng)的真實(shí)地址 Dim iparr,iprs,country,city If sip="127.0.0.1" then sip= "192.168.0.1" iparr=split(sip,".") sip=cint(iparr(0))*256*256*256+cint(iparr(1))*256*256+cint(iparr(2))*256+cint(iparr(3))-1 Dim vibo_ipconn_STRING vibo_ipconn_STRING = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Server.MapPath(ipData_url) Set iprs = Server.CreateObject("ADODB.Recordset") iprs.ActiveConnection = vibo_ipconn_STRING iprs.Source = "SELECT Top 1 city, country FROM address WHERE ip1 <=" & sip & " and " & sip & "<=ip2" iprs.CursorType = 0 iprs.CursorLocation = 2 iprs.LockType = 1 iprs.Open() If iprs.bof and iprs.eof then country="未知地區(qū)" city="" Else country=iprs.Fields.Item("country").Value city=iprs.Fields.Item("city").Value End If getIPAdress=country&city iprs.Close() Set iprs = Nothing End Function Function IP2Num(sip) '--------------------限制某段IP地址 dim str1,str2,str3,str4 dim num IP2Num=0 if isnumeric(left(sip,2)) then str1=left(sip,instr(sip,".")-1) sip=mid(sip,instr(sip,".")+1) str2=left(sip,instr(sip,".")-1) sip=mid(sip,instr(sip,".")+1) str3=left(sip,instr(sip,".")-1) str4=mid(sip,instr(sip,".")+1) num=cint(str1)*256*256*256+cint(str2)*256*256+cint(str3)*256+cint(str4)-1 IP2Num = num end if end function 'userIPnum = IP2Num(Request.ServerVariables("REMOTE_ADDR")) 'if userIPnum > IP2Num("192.168.0.0") and userIPnum < IP2Num("192.168.0.255") then 'response.write ("<center>您的IP被禁止</center>") 'response.end 'end if Function chkFrom() '----------------------------防站外提交設(shè)定 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("請(qǐng)不要從站外提交內(nèi)容！") 'Response.end 'End if function getsys() '----------------------------------操作系統(tǒng)檢測(cè) vibo_soft=Request.ServerVariables("HTTP_USER_AGENT") if instr(vibo_soft,"Windows NT 5.0") then msm="Win 2000" elseif instr(vibo_soft,"Windows NT 5.1") then msm="Win XP" elseif instr(vibo_soft,"Windows NT 5.2") then msm="Win 2003" elseif instr(vibo_soft,"4.0") then msm="Win NT" elseif instr(vibo_soft,"NT") then msm="Win NT" elseif instr(vibo_soft,"Windows CE") then msm="Windows CE" elseif instr(vibo_soft,"Windows 9") then msm="Win 9x" elseif instr(vibo_soft,"9x") then msm="Windows ME" elseif instr(vibo_soft,"98") then msm="Windows 98" elseif instr(vibo_soft,"Windows 95") then msm="Windows 95" elseif instr(vibo_soft,"Win32") then msm="Win32" elseif instr(vibo_soft,"unix") or instr(vibo_soft,"linux") or instr(vibo_soft,"SunOS") or instr(vibo_soft,"BSD") then msm="類Unix" elseif instr(vibo_soft,"Mac") then msm="Mac" else msm="Other" end if getsys=msm End Function function GetBrowser() '----------------------------------瀏覽器版本檢測(cè) dim vibo_soft vibo_soft=Request.ServerVariables("HTTP_USER_AGENT") Browser="unknown" version="unknown" 'vibo_soft="Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; TencentTraveler ; .NET CLR 1.1.4322)" If Left(vibo_soft,7) ="Mozilla" Then '有此標(biāo)識(shí)為瀏覽器 vibo_soft=Split(vibo_soft,";") If InStr(vibo_soft(1),"MSIE")>0 Then Browser="Microsoft Internet Explorer " version=Trim(Left(Replace(vibo_soft(1),"MSIE",""),6)) ElseIf InStr(vibo_soft(4),"Netscape")>0 Then Browser="Netscape " tmpstr=Split(vibo_soft(4),"/") version=tmpstr(UBound(tmpstr)) ElseIf InStr(vibo_soft(4),"rv:")>0 Then Browser="Mozilla " tmpstr=Split(vibo_soft(4),":") version=tmpstr(UBound(tmpstr)) If InStr(version,")") > 0 Then tmpstr=Split(version,")") version=tmpstr(0) End If End If ElseIf Left(vibo_soft,5) ="Opera" Then vibo_soft=Split(vibo_soft,"/") Browser="Mozilla " tmpstr=Split(vibo_soft(1)," ") version=tmpstr(0) End If If version<>"unknown" Then Dim Tmpstr1 Tmpstr1=Trim(Replace(version,".","")) If Not IsNumeric(Tmpstr1) Then version="unknown" End If End If GetBrowser=Browser &" "& version End function function GetSearcher() '----------------------識(shí)別搜索引擎 Dim botlist,Searcher Dim vibo_soft vibo_soft=Request.ServerVariables("HTTP_USER_AGENT") Botlist="Google,Isaac,SurveyBot,Baiduspider,ia_archiver,P.Arthur,FAST-WebCrawler,Java,Microsoft-ATL-Native,TurnitinBot,WebGather,Sleipnir,TencentTraveler" Botlist=split(Botlist,",") For i=0 to UBound(Botlist) If InStr(vibo_soft,Botlist(i))>0 Then Searcher=Botlist(i)&" 搜索器" IsSearch=True Exit For End If Next If IsSearch Then GetSearcher=Searcher else GetSearcher="unknown" End if End function '----------------------------------數(shù)據(jù)過濾 ↓--------------------------------------- Function CheckSql() '防止SQL注入 Dim sql_injdata SQL_injdata = "'|and|exec|insert|select|delete|update|count|*|%|chr|mid|master|truncate|char|declare" SQL_inj = split(SQL_Injdata,"|") If Request.QueryString<>"" Then For Each SQL_Get In Request.QueryString For SQL_Data=0 To Ubound(SQL_inj) if instr(Request.QueryString(SQL_Get),Sql_Inj(Sql_DATA))>0 Then Response.Write "<Script Language='javascript'>{alert('請(qǐng)不要在參數(shù)中包含非法字符！');history.back(-1)}</Script>" Response.end end if next Next End If If Request.Form<>"" Then For Each Sql_Post In Request.Form For SQL_Data=0 To Ubound(SQL_inj) if instr(Request.Form(Sql_Post),Sql_Inj(Sql_DATA))>0 Then Response.Write "<Script Language='javascript'>{alert('請(qǐng)不要在參數(shù)中包含非法字符！');history.back(-1)} </Script>" Response.end end if next next end if End Function Function CheckStr(byVal ChkStr) '檢查無效字符 Dim Str:Str=ChkStr Str=Trim(Str) If IsNull(Str) Then CheckStr = "" Exit Function End If Dim re Set re=new RegExp re.IgnoreCase =True re.Global=True re.Pattern="(\r\n){3,}" Str=re.Replace(Str,"$1$1$1") Set re=Nothing Str = Replace(Str,"'","''") Str = Replace(Str, "select", "select") Str = Replace(Str, "join", "join") Str = Replace(Str, "union", "union") Str = Replace(Str, "where", "where") Str = Replace(Str, "insert", "insert") Str = Replace(Str, "delete", "delete") Str = Replace(Str, "update", "update") Str = Replace(Str, "like", "like") Str = Replace(Str, "drop", "drop") Str = Replace(Str, "create", "create") Str = Replace(Str, "modify", "modify") Str = Replace(Str, "rename", "rename") Str = Replace(Str, "alter", "alter") Str = Replace(Str, "cast", "cast") CheckStr=Str End Function Function UnCheckStr(Str) '檢查非法sql命令 Str = Replace(Str, "select", "select") Str = Replace(Str, "join", "join") Str = Replace(Str, "union", "union") Str = Replace(Str, "where", "where") Str = Replace(Str, "insert", "insert") Str = Replace(Str, "delete", "delete") Str = Replace(Str, "update", "update") Str = Replace(Str, "like", "like") Str = Replace(Str, "drop", "drop") Str = Replace(Str, "create", "create") Str = Replace(Str, "modify", "modify") Str = Replace(Str, "rename", "rename") Str = Replace(Str, "alter", "alter") Str = Replace(Str, "cast", "cast") UnCheckStr=Str End Function Function Checkstr(Str) 'SQL防注入過濾涵數(shù) If Isnull(Str) Then CheckStr = "" Exit Function End If Str = Replace(Str,Chr(0),"", 1, -1, 1) Str = Replace(Str, """", """", 1, -1, 1) Str = Replace(Str,"<","<", 1, -1, 1) Str = Replace(Str,">",">", 1, -1, 1) Str = Replace(Str, "script", "script", 1, -1, 0) Str = Replace(Str, "SCRIPT", "SCRIPT", 1, -1, 0) Str = Replace(Str, "Script", "Script", 1, -1, 0) Str = Replace(Str, "script", "Script", 1, -1, 1) Str = Replace(Str, "object", "object", 1, -1, 0) Str = Replace(Str, "OBJECT", "OBJECT", 1, -1, 0) Str = Replace(Str, "Object", "Object", 1, -1, 0) Str = Replace(Str, "object", "Object", 1, -1, 1) Str = Replace(Str, "applet", "applet", 1, -1, 0) Str = Replace(Str, "APPLET", "APPLET", 1, -1, 0) Str = Replace(Str, "Applet", "Applet", 1, -1, 0) Str = Replace(Str, "applet", "Applet", 1, -1, 1) Str = Replace(Str, "[", "[") Str = Replace(Str, "]", "]") Str = Replace(Str, """", "", 1, -1, 1) Str = Replace(Str, "=", "=", 1, -1, 1) Str = Replace(Str, "'", "''", 1, -1, 1) Str = Replace(Str, "select", "select", 1, -1, 1) Str = Replace(Str, "execute", "execute", 1, -1, 1) Str = Replace(Str, "exec", "exec", 1, -1, 1) Str = Replace(Str, "join", "join", 1, -1, 1) Str = Replace(Str, "union", "union", 1, -1, 1) Str = Replace(Str, "where", "where", 1, -1, 1) Str = Replace(Str, "insert", "insert", 1, -1, 1) Str = Replace(Str, "delete", "delete", 1, -1, 1) Str = Replace(Str, "update", "update", 1, -1, 1) Str = Replace(Str, "like", "like", 1, -1, 1) Str = Replace(Str, "drop", "drop", 1, -1, 1) Str = Replace(Str, "create", "create", 1, -1, 1) Str = Replace(Str, "rename", "rename", 1, -1, 1) Str = Replace(Str, "count", "count", 1, -1, 1) Str = Replace(Str, "chr", "chr", 1, -1, 1) Str = Replace(Str, "mid", "mid", 1, -1, 1) Str = Replace(Str, "truncate", "truncate", 1, -1, 1) Str = Replace(Str, "nchar", "nchar", 1, -1, 1) Str = Replace(Str, "char", "char", 1, -1, 1) Str = Replace(Str, "alter", "alter", 1, -1, 1) Str = Replace(Str, "cast", "cast", 1, -1, 1) Str = Replace(Str, "exists", "exists", 1, -1, 1) Str = Replace(Str,Chr(13),"<br>", 1, -1, 1) CheckStr = Replace(Str,"'","''", 1, -1, 1) End Function Function HTMLEncode(reString) '過濾轉(zhuǎn)換HTML代碼 Dim Str:Str=reString If Not IsNull(Str) Then Str = UnCheckStr(Str) Str = Replace(Str, "&", "&") Str = Replace(Str, ">", ">") Str = Replace(Str, "<", "<") Str = Replace(Str, CHR(32), " ") Str = Replace(Str, CHR(9), " ") Str = Replace(Str, CHR(9), " ") Str = Replace(Str, CHR(34),""") Str = Replace(Str, CHR(39),"'") Str = Replace(Str, CHR(13), "") Str = Replace(Str, CHR(10), "<br>") HTMLEncode = Str End If End Function Function DateToStr(DateTime,ShowType) '日期轉(zhuǎn)換函數(shù) Dim DateMonth,DateDay,DateHour,DateMinute DateMonth=Month(DateTime) DateDay=Day(DateTime) DateHour=Hour(DateTime) DateMinute=Minute(DateTime) If Len(DateMonth)<2 Then DateMonth="0"&DateMonth If Len(DateDay)<2 Then DateDay="0"&DateDay Select Case ShowType Case "Y-m-d" DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay Case "Y-m-d H:I A" Dim DateAMPM If DateHour>12 Then DateHour=DateHour-12 DateAMPM="PM" Else DateHour=DateHour DateAMPM="AM" End If If Len(DateHour)<2 Then DateHour="0"&DateHour If Len(DateMinute)<2 Then DateMinute="0"&DateMinute DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&" "&DateAMPM Case "Y-m-d H:I:S" Dim DateSecond DateSecond=Second(DateTime) If Len(DateHour)<2 Then DateHour="0"&DateHour If Len(DateMinute)<2 Then DateMinute="0"&DateMinute If Len(DateSecond)<2 Then DateSecond="0"&DateSecond DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&":"&DateSecond Case "YmdHIS" DateSecond=Second(DateTime) If Len(DateHour)<2 Then DateHour="0"&DateHour If Len(DateMinute)<2 Then DateMinute="0"&DateMinute If Len(DateSecond)<2 Then DateSecond="0"&DateSecond DateToStr=Year(DateTime)&DateMonth&DateDay&DateHour&DateMinute&DateSecond Case "ym" DateToStr=Right(Year(DateTime),2)&DateMonth Case "d" DateToStr=DateDay Case Else If Len(DateHour)<2 Then DateHour="0"&DateHour If Len(DateMinute)<2 Then DateMinute="0"&DateMinute DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute End Select End Function Function Date2Chinese(iDate) '獲得ASP的中文日期字符串 Dim num(10) Dim iYear Dim iMonth Dim iDay num(0) = "〇" num(1) = "一" num(2) = "二" num(3) = "三" num(4) = "四" num(5) = "五" num(6) = "六" num(7) = "七" num(8) = "八" num(9) = "九" iYear = Year(iDate) iMonth = Month(iDate) iDay = Day(iDate) Date2Chinese = num(iYear \ 1000) + num((iYear \ 100) Mod 10) + num((iYear\ 10) Mod 10) + num(iYear Mod 10) + "年" If iMonth >= 10 Then If iMonth = 10 Then Date2Chinese = Date2Chinese + "十" + "月" Else Date2Chinese = Date2Chinese + "十" + num(iMonth Mod 10) + "月" End If Else Date2Chinese = Date2Chinese + num(iMonth Mod 10) + "月" End If If iDay >= 10 Then If iDay = 10 Then Date2Chinese = Date2Chinese +"十" + "日" ElseIf iDay = 20 Or iDay = 30 Then Date2Chinese = Date2Chinese + num(iDay \ 10) + "十" + "日" ElseIf iDay > 20 Then Date2Chinese = Date2Chinese + num(iDay \ 10) + "十" +num(iDay Mod 10) + "日" Else Date2Chinese = Date2Chinese + "十" + num(iDay Mod 10) + "日" End If Else Date2Chinese = Date2Chinese + num(iDay Mod 10) + "日" End If End Function Function lenStr(str)'計(jì)算字符串長度（字節(jié)） dim l,t,c dim i l=len(str) t=0 for i=1 to l c=asc(mid(str,i,1)) if c<0 then c=c+65536 if c<255 then t=t+1 if c>255 then t=t+2 next lenstr=t End Function Function CreateArr(str) '生成二維數(shù)組 數(shù)據(jù)如："1,a1,b1,c1,d1|2,a2,b2,c2,d2|5,a3,b3,c3,d3|8,a4,b4,c4,d4" dim arr() str=split(str,"|") for i=0 to UBound(str) arrstr=split(str(i),",") for j=0 to Ubound(arrstr) ReDim Preserve arr(UBound(str),UBound(arrstr)) arr(i,j)=arrstr(j) next next CreateArr=arr End Function Function ShowRsArr(rsArr) '用表格顯示記錄集getrows生成的數(shù)組的表結(jié)構(gòu)
showHtml="<table width=100% border=1 cellspacing=0 cellpadding=0>" If Not IsEmpty(rsArr) Then For y=0 To Ubound(rsArr,2) showHtml=showHtml&"<tr>" for x=0 to Ubound(rsArr,1) showHtml=showHtml& "<td>"&rsArr(x,y)&"</td>" next showHtml=showHtml&"</tr>" next Else RshowHtml=showHtml&"<tr>" showHtml=showHtml&"<td>No Records</td>" showHtml=showHtml&"</tr>" End If showHtml=showHtml&"</table>" ShowRsArr=showHtml End Function '-----------------------------------------外接組件使用函數(shù)↓------------------------------------------ Function sendMail(to_Email,from_Email,from_Name,mail_Subject,mail_Body,mail_htmlBody) 'Jmail 發(fā)送郵件 Set vibo_mail = Server.CreateObject("JMAIL.Message") '建立發(fā)送郵件的對(duì)象 vibo_mail.silent = true '屏蔽例外錯(cuò)誤，返回FALSE跟TRUE兩值j vibo_mail.logging = true '啟用郵件日志 vibo_mail.Charset = "gb2312" '郵件的文字編碼為國標(biāo) 'vibo_mail.ContentType = "text/html" '郵件的格式為HTML格式 'vibo_mail.Prority = 1 '郵件的緊急程序，1 為最快，5 為最慢， 3 為默認(rèn)值 vibo_mail.AddRecipient to_Email '郵件收件人的地址 vibo_mail.From = from_Email '發(fā)件人的E-MAIL地址 vibo_mail.FromName = from_Name '發(fā)件人姓名 vibo_mail.MailServerUserName = "system@aaa.com" '登錄郵件服務(wù)器所需的用戶名 vibo_mail.MailServerPassword = "asdasd" '登錄郵件服務(wù)器所需的密碼 vibo_mail.Subject = mail_Subject '郵件的標(biāo)題 vibo_mail.Body = mail_Body '正文 vibo_mail.HTMLBody = mail_htmlBody 'HTML正文 vibo_mail.ReturnReceipt = True vibo_mail.Send("smtp.263xmail.com") '執(zhí)行郵件發(fā)送（通過郵件服務(wù)器地址） vibo_mail.Close() set vibo_mail=nothing End Function '---------------------------------------程序執(zhí)行時(shí)間檢測(cè)↓---------------------------------------------- EndTime=Timer() If EndTime<StartTime Then EndTime=EndTime+24*3600 End if runTime=(EndTime-StartTime)*1000 Response.Write("------------程序執(zhí)行時(shí)間檢測(cè)------------"&"<br>") Response.Write("程序執(zhí)行時(shí)間"&runTime&"毫秒") '-----------------------------------------系統(tǒng)檢測(cè)使用函數(shù)↓------------------------------------------ '---------------------檢測(cè)網(wǎng)頁是否有效----------------------- Function IsValidUrl(url) Set xl = Server.CreateObject("Microsoft.XMLHTTP") xl.Open "HEAD",url,False xl.Send IsValidUrl = (xl.status=200) End Function 'If IsValidUrl(""&fileurl&"") Then ' response.redirect fileurl 'Else ' Response.Write "由于下載用戶過多,程序檢測(cè)到文件暫時(shí)無法下載,請(qǐng)更換其他下載地址!感謝您對(duì)本軟件網(wǎng)站的支持哦^_^" 'End If '------------------檢查某一目錄是否存在------------------- Function getHTMLPage(filename) '獲取文件內(nèi)容 Dim fso,file Set fso = Server.CreateObject("Scripting.FileSystemObject") Set File=fso.OpenTextFile(server.mappath(filename)) showHtml=File.ReadAll File.close Set File=nothing Set fso=nothing getHTMLPage=showHtml '輸出 End function Function CheckDir(FolderPath) dim fso folderpath=Server.MapPath(".")&"\"&folderpath Set fso = Server.CreateObject("Scripting.FileSystemObject") If fso.FolderExists(FolderPath) then '存在 CheckDir = True Else '不存在 CheckDir = False End if Set fso = nothing End Function Function CheckFile(FilePath) '檢查某一文件是否存在 Dim fso Filepath=Server.MapPath(FilePath) Set fso = Server.CreateObject("Scripting.FileSystemObject") If fso.FileExists(FilePath) then '存在 CheckFile = True Else '不存在 CheckFile = False End if Set fso = nothing End Function '-------------根據(jù)指定名稱生成目錄--------- Function MakeNewsDir(foldername) dim fso,f Set fso = Server.CreateObject("Scripting.FileSystemObject") Set f = fso.CreateFolder(foldername) MakeNewsDir = True Set fso = nothing End Function Function CreateHTMLPage(filename,FileData,C_mode) '生成文件 if C_mode=0 then '使用FSO生成 Dim fso,txt Set fso = CreateObject("Scripting.FileSystemObject") Filepath=Server.MapPath(filename) if CheckFile(filename) then fso.DeleteFile Filepath,True '防止續(xù)寫 Set txt=fso.OpenTextFile(Filepath,8,True) txt.Write FileData txt.Close Set fso = nothing elseif C_mode=1 then '使用Stream生成 Dim viboStream On Error Resume Next Set viboStream = Server.createObject("ADODB.Stream") If Err.Number=-2147221005 Then Response.Write "<div align='center' style=""font-size:12px;font-family:Tahoma;"">非常遺憾,您的主機(jī)不支持ADODB.Stream,不能使用本程序</div>" Err.Clear Response.End End If With viboStream .Type = 2 .Open .CharSet = "GB2312" .Position = objStream.Size .WriteText = FileData .SaveToFile Server.MapPath(filename),2 .Close End With Set viboStream = Nothing end if 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> 已經(jīng)生成完畢!...</div>" Response.Flush() End Function Function CheckBadWord(byVal ChkStr)'過濾臟字 Dim Str:Str = ChkStr Str = Trim(Str) If IsNull(Str) Then CheckBadWord = "" Exit Function End If DIC = getHTMLPage("include/badWord.txt")'載入臟字詞典 DICArr = split(DIC,CHR(10)) For i =0 To Ubound(DICArr ) WordDIC = split(DICArr(i),"=") Str = Replace(Str,WordDIC(0),WordDIC(1)) next CheckBadWord = Str End function %> '------------------------------------------------- '函數(shù)名稱:ReadTextFile '作用:利用AdoDb.Stream對(duì)象來讀取UTF-8格式的文本文件 '---------------------------------------------------- Function ReadFromTextFile (FileUrl,CharSet) dim str set stm=server.CreateObject("adodb.stream") stm.Type=2 '以本模式讀取 stm.mode=3 stm.charset=CharSet stm.open stm.loadfromfile server.MapPath(FileUrl) str=stm.readtext stm.Close set stm=nothing ReadFromTextFile=str End Function '-------------------------------------------------
'函數(shù)名稱:WriteToTextFile '作用:利用AdoDb.Stream對(duì)象來寫入U(xiǎn)TF-8格式的文本文件 '---------------------------------------------------- Sub WriteToTextFile (FileUrl,byval Str,CharSet) set stm=server.CreateObject("adodb.stream") stm.Type=2 '以本模式讀取 stm.mode=3 stm.charset=CharSet stm.open stm.WriteText str stm.SaveToFile server.MapPath(FileUrl),2 stm.flush stm.Close set stm=nothing End Sub |
|
|
