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


            #TITLE=ASP常用语法及函数#INFOASP常用的一些语法及自定义函数#SORT=n

#T= ===ASP常用语法===#T=============================#T=数据库相关#T=　连接ACCESS数据库<%Dim DBName,ConnDBName"^!"    '定义数据库路径及名称SET Conn = Server.CreateObject("ADODB.Connection")Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(DBName)%>

#T=　连接MS SQL数据库<%Dim ConnSET 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.CLOSESET RS=NOTHING

#T=　关闭数据库Conn.CloseSET Conn=Nothing

#T=============================#T=ServerVariables相关#T=　取上一页地址Request.ServerVariables("HTTP_REFERER")

#T=　取服务器的名称1Request.ServerVariables("SERVER_NAME")

#T=　取服务器的名称2Request.ServerVariables("HTTP_HOST")

#T=　取服务器IPRequest.ServerVariables("LOCAL_ADDR")

#T=　取用户IPRequest.ServerVariables("Remote_Host")

#T=　取用户真实IP1Request.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=　取本文件的绝对路径1Requet.ServerVariables("PATH_TRANSLATED")

#T=　取本文件的绝对路径2Server.mappath(Request.ServerVariables("SCRIPT_NAME"))

#T=　取本文件的相对路径1Request.ServerVariables("URL")

#T=　取本文件的相对路径2Request.ServerVariables("SCRIPT_NAME")

#T=　取本文件的相对路径3Request.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 = 0End 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, "&", "&amp;")        str = Replace(str, ">", ">")        str = Replace(str, "<", "<")        str = Replace(str, Chr(32), " ")        str = Replace(str, Chr(9), "    ")        str = Replace(str, Chr(34), "&quot;")        str = Replace(str, Chr(39), "&#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 = strEnd 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 IFEnd 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 = NothingEnd 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=LengthEnd 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," "," "),"&quot;",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),"&quot;"),">",">"),"<","<")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 IFEnd 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 = strNewPassEnd 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, "&amp;", "&")     sTemp = Replace(sTemp, "<br>",chr(13))     sTemp = Replace(sTemp, "<", "<")     sTemp = Replace(sTemp, ">", ">")     sTemp = Replace(sTemp, "&quot;", Chr(34))     inHTML = sTempEnd 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 = NOTHINGEnd 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=vCodesEnd 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=NOTHINGEnd Function%>

#T=　创建目录<%Function CreateFolder(strFolderName)    SET FSO=Server.CreateObject("Scripting.FileSystemObject")    IF(FSO.FolderExists(strFolderName) = False)THEN        FSO.CreateFolder(strFolderName)    END IF    SET FSO=NOTHINGEND Function%>

#T=　删除目录<%Function DeleteFolder(strFolderName)    SET FSO=Server.CreateObject("Scripting.FileSystemObject")    IF(FSO.FolderExists(strFolderName))THEN        FSO.DeleteFolder(strFolderName)    END IF    SET FSO=NOTHINGEND 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=NOTHINGEnd Function%>

#T=　删除文件<%Function DeleteFile(strFileName)    SET FSO=Server.CreateObject("Scripting.FileSystemObject")    IF(FSO.FileExists(strFileName))THEN        FSO.DeleteFile(strFileName)    END IF    SET FSO=NOTHINGEND 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=nothingEnd Function

Function StreamBytesToBstr(strBody, CodeBase)Dim objStreamSET objStream = Server.CreateObject("Adodb.Stream")With objStream    .Type = 1    .Mode = 3    .Open    .Write strBody    .Position = 0    .Type = 2    .Charset = CodeBase    StreamBytesToBstr = .ReadText    .CloseEnd WithSET objStream = NothingEnd Function%>