Response.Write("--------------数据提交检测--------------""br>") if not chkFrom then Response.write("请不要从站外提交内容！""br>") Response.end else Response.write("本站提交内容！""br>br>") End if
function OpenDB(vdata_url) '------------------------------打开数据库 '使用: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() '-----------------------得到真实IP userip = Request.ServerVariables("HTTP_X_FORWARDED_FOR") If userip = "" Then userip = Request.ServerVariables("REMOTE_ADDR") getIp=userip End function
Function getIPAdress(sip) '---------------------查找ip对应的真实地址 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="未知地区" city="" Else country=iprs.Fields.Item("country").Value city=iprs.Fields.Item("city").Value End If getIPAdress=countrycity 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() '----------------------------防站外提交设定 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("请不要从站外提交内容！") 'Response.end 'End if
function getsys() '----------------------------------操作系统检测 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() '----------------------------------浏览器版本检测 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 '有此标识为浏览器 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() '----------------------识别搜索引擎 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
'----------------------------------数据过滤 ↓--------------------------------------- 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('请不要在参数中包含非法字符！');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('请不要在参数中包含非法字符！');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 HTMLEncode(reString) '过滤转换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) '日期转换函数 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)DateMonthDateDayDateHourDateMinuteDateSecond 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
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)'计算字符串长度（字节） dim l,t,c dim i l=len(str) t=0 for i=1 to l c=asc(mid(str,i,1)) if c0 then c=c+65536 if c255 then t=t+1 if c>255 then t=t+2 next lenstr=t End Function
Function CreateArr(str) '生成二维数组 数据如："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生成的数组的表结构 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
'---------------------------------------程序执行时间检测↓---------------------------------------------- EndTime=Timer() If EndTimeStartTime Then EndTime=EndTime+24*3600 End if runTime=(EndTime-StartTime)*1000 Response.Write("------------程序执行时间检测------------""br>") Response.Write("程序执行时间"runTime"毫秒")
'-----------------------------------------系统检测使用函数↓------------------------------------------ '---------------------检测网页是否有效----------------------- 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 "由于下载用户过多,程序检测到文件暂时无法下载,请更换其他下载地址!感谢您对本软件网站的支持哦^_^" 'End If '------------------检查某一目录是否存在-------------------
Function getHTMLPage(filename) '获取文件内容 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
'-------------根据指定名称生成目录--------- 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 '防止续写 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;"">非常遗憾,您的主机不支持 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> 已经生成完毕!.../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 %> http://www.zzcn.net/blog/article.asp?id=69
咨 询 客 服