-
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
-
<%
-
StartTime=timer() '程序执行时间检测
-
-
'###############################################################
-
'┌──VIBO───────────────────┐
-
'│ VIBO STUDIO 版权所有 │
-
'└───────────────────────┘
-
' Author:Vibo
-
' Email:vibo_cn@hotmail.com
-
'----------------- Vibo ASP站点开发常用函数库 ------------------
-
'OpenDB(vdata_url) -------------------- 打开数据库
-
'getIp() ------------------------------- 得到真实IP
-
'getIPAdress(sip)------------------------ 查找ip对应的真实地址
-
'IP2Num(sip) ---------------------------- 限制某段IP地址
-
'chkFrom() ------------------------------ 防站外提交设定
-
'getsys() ------------------------------- 操作系统检测
-
'GetBrowser() --------------------------- 浏览器版本检测
-
'GetSearcher() -------------------------- 识别搜索引擎
-
'
-
'---------------------- 数据过滤 ↓----------------------------
-
'CheckStr(byVal ChkStr) ----------------- 检查无效字符
-
'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(byVal ChkStr) ------------- 过滤脏字
-
'###############################################################
-
-
Dim ipData_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>")
-
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=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()
-
'----------------------------防站外提交设定
-
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 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防注入过滤涵数
-
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) '过滤转换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)&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)'计算字符串长度(字节)
-
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) '生成二维数组 数据如:"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
-
-
-
'-----------------------------------------外接组件使用函数↓------------------------------------------
-
-
Function sendMail(to_Email,from_Email,from_Name,mail_Subject,mail_Body,mail_htmlBody) 'Jmail 发送邮件
-
Set vibo_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.AddRecipient to_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()
-
set vibo_mail=nothing
-
End Function
-
-
'---------------------------------------程序执行时间检测↓----------------------------------------------
-
EndTime=Timer()
-
If EndTime<StartTime 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
-
%>