整理了一个editplus的剪辑文件（ASP方面的内容）

#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

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

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)),"*"))

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))

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)

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

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") & ","

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