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

<%@LANGUAGE="VBSCRIPT"CODEPAGE="936"%>

StartTime=timer()'程序执行时间检测

'###############################################################

'┌──VIBO───────────────────┐

'└───────────────────────┘

'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

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

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

IfIsSearchThen

GetSearcher=Searcher

else

GetSearcher="unknown"

Endif

Endfunction

'----------------------------------数据过滤↓---------------------------------------

FunctionCheckSql()'防止SQL注入

Dimsql_injdata

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

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

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="(rn){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(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(iYear1000)+num((iYear100)Mod10)+num((iYear10)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(iDay10)+"十"+"日"

ElseIfiDay>20Then

Date2Chinese=Date2Chinese+num(iDay10)+"十"+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

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)

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>"

showHtml=showHtml&"</tr>"

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'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'font-size:12px;font-family:Tahoma;"">恭喜!文件<ahref="""&filename&"""target=""_blank""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))

CheckBadWord=Str

Endfunction

http://www.zzcn.net/blog/article.asp?id=69