<%@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
%>
可以區(qū)分多個(gè)代理的獲取ip的函數(shù) e 基本沒用 都使用多個(gè)代理了，估計(jì)有匿名的。
'**********************
‘Get Client Ip Add
'**********************
Function getIP()
Dim strIP,IP_Ary,strIP_list
strIP_list=Replace(Request.ServerVariables("HTTP_X_FORWARDED_FOR"),"'","")
If InStr(strIP_list,",")<>0 Then
IP_Ary = Split(strIP_list,",")
strIP = IP_Ary(0)
Else
strIP = strIP_list
End If
If strIP=Empty Then strIP=Replace(Request.ServerVariables("REMOTE_ADDR"),"'","")
getIP=strIP
End Function
posted on 2007-11-22 00:09
百年 閱讀(297)
評(píng)論(0) 編輯 收藏 所屬分類:
Asp Article