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

'###############################################################
'┌──VIBO───────────────────┐
'│VIBOSTUDIO版权所有│
'└───────────────────────┘
'Author:Vibo
'Email:vibo_cn@hotmail.com
'-----------------ViboASP站点开发常用函数库------------------
'OpenDB(vdata_url)--------------------打开数据库
'getIp()-------------------------------得到真实IP
'getIPAdress(sip)------------------------查找ip对应的真实地址
'IP2Num(sip)----------------------------限制某段IP地址
'chkFrom()------------------------------防站外提交设定
'getsys()-------------------------------操作系统检测
'GetBrowser()---------------------------浏览器版本检测
'GetSearcher()--------------------------识别搜索引擎
'
'----------------------数据过滤↓----------------------------
'CheckStr(byValChkStr)-----------------检查无效字符
'CheckSql()-----------------------------防止SQL注入

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

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

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

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

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

'CheckBadWord(byValChkStr)-------------过滤脏字
'###############################################################

DimipData_url
ipData_url="./Ip.mdb"

Response.Write("--------------客户端信息检测------------"&"<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("--------------数据提交检测--------------"&"<br>")
ifnotchkFromthen
Response.write("请不要从站外提交内容！"&"<br>")
Response.end
else
Response.write("本站提交内容！"&"<br><br>")
Endif


functionOpenDB(vdata_url)
'------------------------------打开数据库
'使用:Conn=OpenDB("data/data.mdb")
Dimvibo_Conn
Setvibo_Conn=Server.CreateObject("ADODB.Connection")
vibo_Conn.ConnectionString="Provider=Microsoft.Jet.OLEDB.4.0;DataSource="&Server.MapPath(vdata_url)
vibo_Conn.Open
OpenDB=vibo_Conn
EndFunction

functiongetIp()
'-----------------------得到真实IP
userip=Request.ServerVariables("HTTP_X_FORWARDED_FOR")
Ifuserip=""Thenuserip=Request.ServerVariables("REMOTE_ADDR")
getIp=userip
Endfunction

FunctiongetIPAdress(sip)
'---------------------查找ip对应的真实地址
Dimiparr,iprs,country,city
Ifsip="127.0.0.1"thensip="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
Dimvibo_ipconn_STRING
vibo_ipconn_STRING="Provider=Microsoft.Jet.OLEDB.4.0;DataSource="&Server.MapPath(ipData_url)
Setiprs=Server.CreateObject("ADODB.Recordset")
iprs.ActiveConnection=vibo_ipconn_STRING
iprs.Source="SelectTop1city,countryFROMaddressWhereip1<="&sip&"and"&sip&"<=ip2"
iprs.CursorType=0
iprs.CursorLocation=2
iprs.LockType=1
iprs.Open()

Ifiprs.bofandiprs.eofthen
country="未知地区"
city=""
Else
country=iprs.Fields.Item("country").Value
city=iprs.Fields.Item("city").Value
EndIf
getIPAdress=country&city
iprs.Close()
Setiprs=Nothing
EndFunction

FunctionIP2Num(sip)
'--------------------限制某段IP地址

dimstr1,str2,str3,str4
dimnum
IP2Num=0
ifisnumeric(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
endif
endfunction

'userIPnum=IP2Num(Request.ServerVariables("REMOTE_ADDR"))
'ifuserIPnum>IP2Num("192.168.0.0")anduserIPnum<IP2Num("192.168.0.255")then
'response.write("<center>您的IP被禁止</center>")
'response.end
'endif


FunctionchkFrom()
'----------------------------防站外提交设定
Dimserver_v1,server_v2,server1,server2
chkFrom=False
server1=Cstr(Request.ServerVariables("HTTP_REFERER"))
server2=Cstr(Request.ServerVariables("SERVER_NAME"))
IfMid(server1,8,len(server2))=server2ThenchkFrom=True
EndFunction
'ifnotchkFromthen
'Response.write("请不要从站外提交内容！")
'Response.end
'Endif

functiongetsys()
'----------------------------------操作系统检测
vibo_soft=Request.ServerVariables("HTTP_USER_AGENT")
ifinstr(vibo_soft,"WindowsNT5.0")then
msm="Win2000"
elseifinstr(vibo_soft,"WindowsNT5.1")then
msm="WinXP"
elseifinstr(vibo_soft,"WindowsNT5.2")then
msm="Win2003"
elseifinstr(vibo_soft,"4.0")then
msm="WinNT"
elseifinstr(vibo_soft,"NT")then
msm="WinNT"
elseifinstr(vibo_soft,"WindowsCE")then
msm="WindowsCE"
elseifinstr(vibo_soft,"Windows9")then
msm="Win9x"
elseifinstr(vibo_soft,"9x")then
msm="WindowsME"
elseifinstr(vibo_soft,"98")then
msm="Windows98"
elseifinstr(vibo_soft,"Windows95")then
msm="Windows95"
elseifinstr(vibo_soft,"Win32")then
msm="Win32"
elseifinstr(vibo_soft,"unix")orinstr(vibo_soft,"linux")orinstr(vibo_soft,"SunOS")orinstr(vibo_soft,"BSD")then
msm="类Unix"
elseifinstr(vibo_soft,"Mac")then
msm="Mac"
else
msm="Other"
endif
getsys=msm
EndFunction

functionGetBrowser()
'----------------------------------浏览器版本检测
dimvibo_soft
vibo_soft=Request.ServerVariables("HTTP_USER_AGENT")
Browser="unknown"
version="unknown"
'vibo_soft="Mozilla/4.0(compatible;MSIE6.0;WindowsNT5.0;TencentTraveler;.NETCLR1.1.4322)"
IfLeft(vibo_soft,7)="Mozilla"Then'有此标识为浏览器
vibo_soft=Split(vibo_soft,";")
IfInStr(vibo_soft(1),"MSIE")>0Then
Browser="MicrosoftInternetExplorer"
version=Trim(Left(Replace(vibo_soft(1),"MSIE",""),6))
ElseIfInStr(vibo_soft(4),"Netscape")>0Then
Browser="Netscape"
tmpstr=Split(vibo_soft(4),"/")
version=tmpstr(UBound(tmpstr))
ElseIfInStr(vibo_soft(4),"rv:")>0Then
Browser="Mozilla"
tmpstr=Split(vibo_soft(4),":")
version=tmpstr(UBound(tmpstr))
IfInStr(version,")")>0Then
tmpstr=Split(version,")")
version=tmpstr(0)
EndIf
EndIf
ElseIfLeft(vibo_soft,5)="Opera"Then
vibo_soft=Split(vibo_soft,"/")
Browser="Mozilla"
tmpstr=Split(vibo_soft(1),"")
version=tmpstr(0)
EndIf
Ifversion<>"unknown"Then
DimTmpstr1
Tmpstr1=Trim(Replace(version,".",""))
IfNotIsNumeric(Tmpstr1)Then
version="unknown"
EndIf
EndIf
GetBrowser=Browser&""&version
Endfunction

functionGetSearcher()
'----------------------识别搜索引擎
Dimbotlist,Searcher
Dimvibo_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,",")
Fori=0toUBound(Botlist)
IfInStr(vibo_soft,Botlist(i))>0Then
Searcher=Botlist(i)&"搜索器"
IsSearch=True
ExitFor
EndIf
Next
IfIsSearchThen
GetSearcher=Searcher
else
GetSearcher="unknown"
Endif
Endfunction


'----------------------------------数据过滤↓---------------------------------------
FunctionCheckSql()'防止SQL注入
Dimsql_injdata
SQL_injdata="'|and|exec|insert|select|delete|update|count|*|%|chr|mid|master|truncate|char|declare"
SQL_inj=split(SQL_Injdata,"|")
IfRequest.QueryString<>""Then
ForEachSQL_GetInRequest.QueryString
ForSQL_Data=0ToUbound(SQL_inj)
ifinstr(Request.QueryString(SQL_Get),Sql_Inj(Sql_DATA))>0Then
Response.Write"<ScriptLanguage='javascript'>{alert('请不要在参数中包含非法字符！');history.back(-1)}</Script>"
Response.end
endif
next
Next
EndIf
IfRequest.Form<>""Then
ForEachSql_PostInRequest.Form
ForSQL_Data=0ToUbound(SQL_inj)
ifinstr(Request.Form(Sql_Post),Sql_Inj(Sql_DATA))>0Then
Response.Write"<ScriptLanguage='javascript'>{alert('请不要在参数中包含非法字符！');history.back(-1)}</Script>"
Response.end
endif
next
next
endif
EndFunction

FunctionCheckStr(byValChkStr)'检查无效字符
DimStr:Str=ChkStr
Str=Trim(Str)
IfIsNull(Str)Then
CheckStr=""
ExitFunction
EndIf
Dimre
Setre=newRegExp
re.IgnoreCase=True
re.Global=True
re.Pattern="(\r\n){3,}"
Str=re.Replace(Str,"$1$1$1")
Setre=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
EndFunction

FunctionUnCheckStr(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
EndFunction

FunctionCheckstr(Str)'SQL防注入过滤涵数
IfIsnull(Str)Then
CheckStr=""
ExitFunction
EndIf
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)
EndFunction

FunctionHTMLEncode(reString)'过滤转换HTML代码
DimStr:Str=reString
IfNotIsNull(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
EndIf
EndFunction

FunctionDateToStr(DateTime,ShowType)'日期转换函数
DimDateMonth,DateDay,DateHour,DateMinute
DateMonth=Month(DateTime)
DateDay=Day(DateTime)
DateHour=Hour(DateTime)
DateMinute=Minute(DateTime)
IfLen(DateMonth)<2ThenDateMonth="0"&DateMonth
IfLen(DateDay)<2ThenDateDay="0"&DateDay
SelectCaseShowType
Case"Y-m-d"
DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay
Case"Y-m-dH:IA"
DimDateAMPM
IfDateHour>12Then
DateHour=DateHour-12
DateAMPM="PM"
Else
DateHour=DateHour
DateAMPM="AM"
EndIf
IfLen(DateHour)<2ThenDateHour="0"&DateHour
IfLen(DateMinute)<2ThenDateMinute="0"&DateMinute
DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&""&DateHour&":"&DateMinute&""&DateAMPM
Case"Y-m-dH:I:S"
DimDateSecond
DateSecond=Second(DateTime)
IfLen(DateHour)<2ThenDateHour="0"&DateHour
IfLen(DateMinute)<2ThenDateMinute="0"&DateMinute
IfLen(DateSecond)<2ThenDateSecond="0"&DateSecond
DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&""&DateHour&":"&DateMinute&":"&DateSecond
Case"YmdHIS"
DateSecond=Second(DateTime)
IfLen(DateHour)<2ThenDateHour="0"&DateHour
IfLen(DateMinute)<2ThenDateMinute="0"&DateMinute
IfLen(DateSecond)<2ThenDateSecond="0"&DateSecond
DateToStr=Year(DateTime)&DateMonth&DateDay&DateHour&DateMinute&DateSecond
Case"ym"
DateToStr=Right(Year(DateTime),2)&DateMonth
Case"d"
DateToStr=DateDay
CaseElse
IfLen(DateHour)<2ThenDateHour="0"&DateHour
IfLen(DateMinute)<2ThenDateMinute="0"&DateMinute
DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&""&DateHour&":"&DateMinute
EndSelect
EndFunction

FunctionDate2Chinese(iDate)'获得ASP的中文日期字符串
　　Dimnum(10)
　　DimiYear
　　DimiMonth
　　DimiDay

　　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)Mod10)+num((iYear\10)Mod10)+num(iYearMod10)+"年"
　　IfiMonth>=10Then
　　　　IfiMonth=10Then
　　　　　　Date2Chinese=Date2Chinese+"十"+"月"
　　　　Else
　　　　　　Date2Chinese=Date2Chinese+"十"+num(iMonthMod10)+"月"
　　　　EndIf
　　Else
　　　　Date2Chinese=Date2Chinese+num(iMonthMod10)+"月"
　　EndIf
　　IfiDay>=10Then
　　　　IfiDay=10Then
　　　　　　Date2Chinese=Date2Chinese+"十"+"日"
　　　　ElseIfiDay=20oriDay=30Then
　　　　　　Date2Chinese=Date2Chinese+num(iDay\10)+"十"+"日"
　　　　ElseIfiDay>20Then
　　　　　　Date2Chinese=Date2Chinese+num(iDay\10)+"十"+num(iDayMod10)+"日"
　　　　Else
　　　　　　Date2Chinese=Date2Chinese+"十"+num(iDayMod10)+"日"
　　　　EndIf
　　Else
　　　　Date2Chinese=Date2Chinese+num(iDayMod10)+"日"
　　EndIf
EndFunction


FunctionlenStr(str)'计算字符串长度（字节）
diml,t,c
dimi
l=len(str)
t=0
fori=1tol
c=asc(mid(str,i,1))
ifc<0thenc=c+65536
ifc<255thent=t+1
ifc>255thent=t+2
next
lenstr=t
EndFunction

FunctionCreateArr(str)'生成二维数组数据如："1,a1,b1,c1,d1|2,a2,b2,c2,d2|5,a3,b3,c3,d3|8,a4,b4,c4,d4"
dimarr()
str=split(str,"|")
fori=0toUBound(str)
arrstr=split(str(i),",")
forj=0toUbound(arrstr)
ReDimPreservearr(UBound(str),UBound(arrstr))
arr(i,j)=arrstr(j)
next
next
CreateArr=arr
EndFunction

FunctionShowRsArr(rsArr)'用表格显示记录集getrows生成的数组的表结构
showHtml="<tablewidth=100%border=1cellspacing=0cellpadding=0>"
IfNotIsEmpty(rsArr)Then
Fory=0ToUbound(rsArr,2)
showHtml=showHtml&"<tr>"
forx=0toUbound(rsArr,1)
showHtml=showHtml&"<td>"&rsArr(x,y)&"</td>"
next
showHtml=showHtml&"</tr>"
next
Else
RshowHtml=showHtml&"<tr>"
showHtml=showHtml&"<td>NoRecords</td>"
showHtml=showHtml&"</tr>"
EndIf
showHtml=showHtml&"</table>"
ShowRsArr=showHtml
EndFunction


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

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

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

vibo_mail.AddRecipientto_Email'邮件收件人的地址
vibo_mail.From=from_Email'发件人的E-MAIL地址
vibo_mail.FromName=from_Name'发件人姓名
vibo_mail.MailServerUserName="system@aaa.com"'登录邮件服务器所需的用户名
vibo_mail.MailServerPassword="asdasd"'登录邮件服务器所需的密码
vibo_mail.Subject=mail_Subject'邮件的标题
vibo_mail.Body=mail_Body'正文
vibo_mail.HTMLBody=mail_htmlBody'HTML正文
vibo_mail.ReturnReceipt=True
vibo_mail.Send("smtp.263xmail.com")'执行邮件发送（通过邮件服务器地址）
vibo_mail.Close()
setvibo_mail=nothing
EndFunction

'---------------------------------------程序执行时间检测↓----------------------------------------------
EndTime=Timer()
IfEndTime<StartTimeThen
EndTime=EndTime+24*3600
Endif
runTime=(EndTime-StartTime)*1000
Response.Write("------------程序执行时间检测------------"&"<br>")
Response.Write("程序执行时间"&runTime&"毫秒")


'-----------------------------------------系统检测使用函数↓------------------------------------------
'---------------------检测网页是否有效-----------------------
FunctionIsValidUrl(url)
Setxl=Server.CreateObject("Microsoft.XMLHTTP")
xl.Open"HEAD",url,False
xl.Send
IsValidUrl=(xl.status=200)
EndFunction
'IfIsValidUrl(""&fileurl&"")Then
'response.redirectfileurl
'Else
'Response.Write"由于下载用户过多,程序检测到文件暂时无法下载,请更换其他下载地址!感谢您对本软件网站的支持哦^_^"
'EndIf
'------------------检查某一目录是否存在-------------------

FunctiongetHTMLPage(filename)'获取文件内容
Dimfso,file
Setfso=Server.CreateObject("Scripting.FileSystemObject")
SetFile=fso.OpenTextFile(server.mappath(filename))
showHtml=File.ReadAll
File.close
SetFile=nothing
Setfso=nothing
getHTMLPage=showHtml'输出
Endfunction

FunctionCheckDir(FolderPath)
dimfso
folderpath=Server.MapPath(".")&"\"&folderpath
Setfso=Server.CreateObject("Scripting.FileSystemObject")
Iffso.FolderExists(FolderPath)then
'存在
CheckDir=True
Else
'不存在
CheckDir=False
Endif
Setfso=nothing
EndFunction

FunctionCheckFile(FilePath)'检查某一文件是否存在
Dimfso
Filepath=Server.MapPath(FilePath)
Setfso=Server.CreateObject("Scripting.FileSystemObject")
Iffso.FileExists(FilePath)then
'存在
CheckFile=True
Else
'不存在
CheckFile=False
Endif
Setfso=nothing
EndFunction

'-------------根据指定名称生成目录---------
FunctionMakeNewsDir(foldername)
dimfso,f
Setfso=Server.CreateObject("Scripting.FileSystemObject")
Setf=fso.CreateFolder(foldername)
MakeNewsDir=True
Setfso=nothing
EndFunction

FunctionCreateHTMLPage(filename,FileData,C_mode)'生成文件
ifC_mode=0then'使用FSO生成
Dimfso,txt
Setfso=CreateObject("Scripting.FileSystemObject")
Filepath=Server.MapPath(filename)
ifCheckFile(filename)thenfso.DeleteFileFilepath,True'防止续写
Settxt=fso.OpenTextFile(Filepath,8,True)
txt.WriteFileData
txt.Close
Setfso=nothing
elseifC_mode=1then'使用Stream生成
DimviboStream
OnErrorResumeNext
SetviboStream=Server.createObject("ADODB.Stream")

IfErr.Number=-2147221005Then
Response.Write"<divalign='center'style=""font-size:12px;font-family:Tahoma;"">非常遗憾,您的主机不支持ADODB.Stream,不能使用本程序</div>"
Err.Clear
Response.End
EndIf

WithviboStream
.Type=2
.Open
.CharSet="GB2312"
.Position=objStream.Size
.WriteText=FileData
.SaveToFileServer.MapPath(filename),2
.Close
EndWith
SetviboStream=Nothing
endif
Response.Write"<divalign='center'style=""font-size:12px;font-family:Tahoma;"">恭喜!文件<ahref="""&filename&"""target=""_blank""style=""font-weight:bold;color:#FF0000;"">"&filename&"</a>已经生成完毕!...</div>"
Response.Flush()
EndFunction

FunctionCheckBadWord(byValChkStr)'过滤脏字
DimStr:Str=ChkStr
Str=Trim(Str)
IfIsNull(Str)Then
CheckBadWord=""
ExitFunction
EndIf

DIC=getHTMLPage("include/badWord.txt")'载入脏字词典
DICArr=split(DIC,CHR(10))
Fori=0ToUbound(DICArr)
WordDIC=split(DICArr(i),"=")
Str=Replace(Str,WordDIC(0),WordDIC(1))
next
CheckBadWord=Str
Endfunction
%>
http://www.zzcn.net/blog/article.asp?id=69