#TITLE=ASP常用语法及函数
#INFO
ASP常用的一些语法及自定义函数
#SORT=n
#T= ===ASP常用语法===
#T=============================
#T=数据库相关
#T= 连接ACCESS数据库
<%
Dim DBName,Conn
DBName^! '定义数据库路径及名称
SET Conn = Server.CreateObject(ADODB.Connection)
Conn.Open Provider=Microsoft.Jet.OLEDB.4.0;Data Source= & Server.MapPath(DBName)
%>
#T= 连接MS SQL数据库
<%
Dim Conn
SET Conn=Server.CreateObject(ADODB.connection)
Conn.Open PROVIDER=SQLOLEDB;DATA SOURCE=SQL服务器名称或IP地址;UID=数据库登录帐号;PWD=数据库密码;DATABASE=数据库名称
%>
#T= 建立记录集
SET ^!=Server.CreateObject(ADODB.recordset)
#T= 执行SQL命令
RS.Open SQL,conn,1,1
#T= 执行SQL命令
Conn.Execute(^!)
#T= RS直接执行SQL命令
SET RS = Conn.Execute(^!)
#T= 关闭记录集
RS.CLOSE
SET RS=NOTHING
#T= 关闭数据库
Conn.Close
SET Conn=Nothing
#T=============================
#T=ServerVariables相关
#T= 取上一页地址
Request.ServerVariables(HTTP_REFERER)
#T= 取服务器的名称1
Request.ServerVariables(SERVER_NAME)
#T= 取服务器的名称2
Request.ServerVariables(HTTP_HOST)
#T= 取服务器IP
Request.ServerVariables(LOCAL_ADDR)
#T= 取用户IP
Request.ServerVariables(Remote_Host)
#T= 取用户真实IP1
Request.serverVariables(REMOTE_ADDR)
#T= 取用户真实IP函数
Function GetRealIP()
GetRealIP = Request.ServerVariables(HTTP_X_FORWARDED_FOR)
IF(GetRealIP = )THEN GetRealIP = Request.ServerVariables(REMOTE_ADDR)
End Function
#T= 取服务器端口
Request.ServerVariables(SERVER_PORT)
#T= 取服务器操作系统
Request.ServerVariables(OS)
#T= 取服务器的绝对路径
Request.ServerVariables(APPL_PHYSICAL_PATH)
#T= 取本文件的绝对路径1
Requet.ServerVariables(PATH_TRANSLATED)
#T= 取本文件的绝对路径2
Server.mappath(Request.ServerVariables(SCRIPT_NAME))
#T= 取本文件的相对路径1
Request.ServerVariables(URL)
#T= 取本文件的相对路径2
Request.ServerVariables(SCRIPT_NAME)
#T= 取本文件的相对路径3
Request.ServerVariables(PATH_INFO)
#T= 取地址栏后的参数
Request.ServerVariables(QUERY_STRING)
#T= 取服务器系统信息
Request.ServerVariables(HTTP_USER_AGENT)
#T= 服务器组件检测
<%
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
SET xTestObj = Server.CreateObject(strClassString)
IF(0 = Err)THEN IsObjInstalled = True
SET xTestObj = Nothing
Err = 0
End Function
'IF(IsObjInstalled(Persits.Upload)=True)THEN
' Response.Write 支持AspUpload组件
'ELSE
' Response.Write 不支持AspUpload组件
'END IF
%>
#T= 取客户端语言环境
^!Request.ServerVariables(HTTP_ACCEPT_LANGUAGE)
#T= 取客户端信息:HTTP_USER_AGENT
^!Request.ServerVariables(HTTP_USER_AGENT)
#T= 取表单(Form)值元素值
Request.Form(^!)
#T= 取URL传递的值
Request.QueryString(^!)
#T= 取完整URL地址
Function GetUrl()
GetUrl=http://&Request.ServerVariables(SERVER_N ... .ServerVariables(URL)
IF(Request.ServerVariables(QUERY_STRING)<>)THEN GetURL=GetUrl&?& Request.ServerVariables(QUERY_STRING)
End Function
#T=============================
#T=自定义函数
#T= 过滤HTML字符
<%
'过滤HTML字符函数
Function HTMLEncode(str)
IF(str <> )THEN
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) & Chr(10), </P><P>)
str = Replace(str, Chr(10), <BR>)
str = Replace(str, Chr(255), )
END IF
HTMLEncode = str
End Function
%>
#T= 检测上页是否从本站提交
<%
'检测上页是否从本站提交
'返回:True,False
'===============================================================
Function IsSelfRefer()
Dim sHttp_Referer, sServer_Name
sHttp_Referer = CStr(Request.ServerVariables(HTTP_REFERER))
sServer_Name = CStr(Request.ServerVariables(SERVER_NAME))
IF(Mid(sHttp_Referer, 8, Len(sServer_Name)) = sServer_Name)THEN
IsSelfRefer = True
ELSE
IsSelfRefer = False
END IF
End Function
%>
#T= 清除所有HTML标记
<%
'清除HTML标记
Function stripHTML(htmlStr)
Dim regEx
SET regEx = New Regexp
regEx.IgnoreCase = True
regEx.Global = True
regEx.Pattern = <.+?>
htmlStr = regEx.Replace(htmlStr,)
htmlStr = Replace(htmlStr, <,<)
htmlStr = Replace(htmlStr, >,>)
htmlStr = Replace(htmlStr,chr(10),)
htmlStr = Replace(htmlStr,chr(13),)
stripHTML = htmlStr
SET regEx = Nothing
End Function
%>
#T= 取字符串长度
<%
'求字符串长度函数
Function GetLength(str)
Dim Length
For i=1 to Len(str)
IF(Asc(Mid(str,i,1))<0 or Asc(Mid(str,i,1))>256)THEN
Length=Length+2
ELSE
Length=Length+1
END IF
Next
GetLength=Length
End Function
%>
#T= 截取指定长度字符串
<%
'截取指定长度的字符串，多余的用...代替
Function StrLeft(str,strlen)
IF(str = )THEN
StrLeft =
Exit Function
END IF
Dim l,t,c,i
str = Replace(Replace(Replace(Replace(str, , ),,chr(34)),>,>),<,<)
l=len(str)
t=0
For i=1 to l
c=Abs(Asc(Mid(str,i,1)))
IF(c>255)THEN
t=t+2
ELSE
t=t+1
END IF
IF(t>strlen)THEN
StrLeft = left(str,i) & ...
Exit For
ELSE
StrLeft = str
END IF
Next
StrLeft = Replace(Replace(Replace(Replace(StrLeft, , ),chr(34),),>,>),<,<)
End Function
%>
#T= 获取安全的提交参数
<%
'===============================================================
'SQL Injection Check
'函数功能：过滤字符参数中的单引号，对于数字参数进行判断，如果不是数值类型，则赋值0
'参数意义：str ---- 要过滤的参数
'strType ---- 参数类型，分为字符型和数字型，字符型为s，数字型为i
'===============================================================
Function CheckStr(str,strType)
Dim strTmp
strTmp =
IF(strType =s)THEN
strTmp = Replace(Trim(str),','')
ELSEIF(strType=i)THEN
IF(IsNumeric(str)=False)THEN str=False
strTmp = str
ELSE
strTmp = str
End IF
CheckStr= strTmp
End Function
%>
#T= 过滤不良字符(BadWord)
<%
'过滤不良字符(BadWords)
Function ChkBadWords(fString)
Dim BadWords,bwords,i
BadWords = 我操|操你|操他|你妈的|他妈的|狗|杂种|屄|屌|王八|强奸|做爱|处女|泽民|法轮|法伦|洪志|法輪
IF(Not(IsNull(BadWords) or IsNull(fString)))THEN
bwords = Split(BadWords, |)
For i = 0 to UBound(bwords)
fString = Replace(fString, bwords(i), string(Len(bwords(i)),*))
Next
ChkBadWords = fString
END IF
End Function
%>
#T= 生成随机自定义长度密码
<%
'生成随机自定义长度密码
Function makePassword(maxLen)
Dim strNewPass
Dim whatsNext, upper, lower, intCounter
Randomize
For intCounter = 1 To maxLen
whatsNext = Int((1 - 0 + 1) * Rnd + 0)
IF(whatsNext = 0)THEN
'character
upper = 90
lower = 65
ELSE
upper = 57
lower = 48
END IF
strNewPass = strNewPass & Chr(Int((upper - lower + 1) * Rnd + lower))
Next
makePassword = strNewPass
End Function
'Response.Write makepassword(8)
%>
#T= 填入Textarea时保持格式inHTML
<%
'===============================================================
'去除Html格式，用于从数据库中取出值填入输入框时
'注意：value=?这边一定要用双引号
'===============================================================
Function inHTML(str)
Dim sTemp
sTemp = str
inHTML =
If IsNull(sTemp) = True Then
Exit Function
End If
sTemp = Replace(sTemp, &, &)
sTemp = Replace(sTemp, <br>,chr(13))
sTemp = Replace(sTemp, <, <)
sTemp = Replace(sTemp, >, >)
sTemp = Replace(sTemp, , Chr(34))
inHTML = sTemp
End Function
%>
#T= 正则表表达式验证函数
<%
'正则表表达式验证函数 patrn-正则表达式 strng-需要验证的字符串
'===============================================================
Function RegExpTest(patrn, strng)
Dim regEx, retVal ' 建立变量。
SET regEx = New RegExp ' 建立正则表达式。
regEx.Pattern = patrn ' 设置模式。
regEx.IgnoreCase = False ' 设置是否区分大小写。
retVal = regEx.Test(strng) ' 执行搜索测试。
RegExpTest = retVal '返回值，不符合就返回false，符合为true
SET regEx = NOTHING
End Function
%>
#T= 生成随机字符串
<%
'生成随机字符串
Function RndCode()
Dim CodeSet,AmountSet
CodeSet = 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz
AmountSet = 62 ' 文字数量
Randomize
Dim vCode(10), vCodes,i
For i = 0 To 9
vCode(i) = Int(Rnd * AmountSet)
vCodes = vCodes & Mid(CodeSet, vCode(i) + 1, 1)
Next
RndCode=vCodes
End Function
%>
#T=============================
#T=FSO相关操作
#T= 判断目录是否存在
<%
Function IsFloderExist(strFolderName)
SET FSO=Server.CreateObject(Scripting.FileSystemObject)
IF(FSO.FolderExists(strFolderName))THEN
IsFloderExist = True
ELSE
IsFloderExist = False
END IF
SET FSO=NOTHING
End Function
%>
#T= 创建目录
<%
Function CreateFolder(strFolderName)
SET FSO=Server.CreateObject(Scripting.FileSystemObject)
IF(FSO.FolderExists(strFolderName) = False)THEN
FSO.CreateFolder(strFolderName)
END IF
SET FSO=NOTHING
END Function
%>
#T= 删除目录
<%
Function DeleteFolder(strFolderName)
SET FSO=Server.CreateObject(Scripting.FileSystemObject)
IF(FSO.FolderExists(strFolderName))THEN
FSO.DeleteFolder(strFolderName)
END IF
SET FSO=NOTHING
END Function
%>
#T= 判断文件是否存在
<%
Function IsFileExist(strFileName)
SET FSO=Server.CreateObject(Scripting.FileSystemObject)
IF(FSO.FileExists(strFileName))THEN
IsFileExist = True
ELSE
IsFileExist = False
END IF
SET FSO=NOTHING
End Function
%>
#T= 删除文件
<%
Function DeleteFile(strFileName)
SET FSO=Server.CreateObject(Scripting.FileSystemObject)
IF(FSO.FileExists(strFileName))THEN
FSO.DeleteFile(strFileName)
END IF
SET FSO=NOTHING
END Function
%>
#T=============================
#T= ASP小偷常用的几个函数
<%
Function ByteToStr(vIn)
Dim strReturn,i,ThisCharCode,innerCode,Hight8,Low8,NextCharCode
strReturn =
For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
IF(ThisCharCode < &H80)THEN
strReturn = strReturn & Chr(ThisCharCode)
ELSE
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i = i + 1
END IF
Next
ByteToStr = strReturn
End Function
Function GetHttpPageContent(url,Method,SendStr)
Dim Retrieval
SET Retrieval = Server.CreateObject(Microsoft.XMLHTTP)
With Retrieval
.Open Method, url, False , ,
.setRequestHeader Content-Type,application/x-www-form-urlencoded
.Send(SendStr)
GetHttpPageContent = .ResponseBody
End With
SET Retrieval = Nothing
GetHttpPageContent=ByteToStr(GetHttpPageContent)
End Function
Function RegExpText(strng,regStr)
Dim regEx,Match,Matches,RetStr
SET regEx = New RegExp
regEx.Pattern = regStr
regEx.IgnoreCase = True
regEx.Global = True
SET Matches = regEx.Execute(strng)
For Each Match in Matches
RetStr = RetStr & regEx.Replace(Match.Value,$1) & ,
Next
RegExpText = RetStr
set regEx=nothing
End Function
Function StreamBytesToBstr(strBody, CodeBase)
Dim objStream
SET objStream = Server.CreateObject(Adodb.Stream)
With objStream
.Type = 1
.Mode = 3
.Open
.Write strBody
.Position = 0
.Type = 2
.Charset = CodeBase
StreamBytesToBstr = .ReadText
.Close
End With
SET objStream = Nothing
End Function
%>