asp的函数集.docx
《asp的函数集.docx》由会员分享，可在线阅读，更多相关《asp的函数集.docx（15页珍藏版）》请在冰豆网上搜索。
asp的函数集
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%
StartTime=timer（） '程序执行时间检测
'###############################################################
'┌──VIBO───────────────────┐
'│ VIBO STUDIO 版权所有 │
'└───────────────────────┘
' Author:
Vibo
' Email:
vibo_cn@
'----------------- 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（"--------------客户端信息检测------------"&"
"）
Response.Write（getsys（）&"
"）
Response.Write（GetBrowser（）&"
"）
Response.Write（GetSearcher（）&"
"）
Response.Write（"IP:
"&getIp（）&"
"）
Response.Write（"来源:
"&（getIPAdress（GetIp（）））&"
"）
Response.Write（"
"）
Response.Write（"--------------数据提交检测--------------"&"
"）
if not chkFrom then
Response.write（"请不要从站外提交内容！
"&"
"）
Response.end
else
Response.write（"本站提交内容！
"&"
"）
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 （"
您的IP被禁止"）
'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 "{alert（'请不要在参数中包含非法字符！
'）;history.back（-1）}"
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 "{alert（'请不要在参数中包含非法字符！
'）;history.back（-1）} "
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"
升级会员 