• 企业400电话
  • 微网小程序
  • AI电话机器人
  • 电商代运营
  • 全 部 栏 目

    企业400电话 网络优化推广 AI电话机器人 呼叫中心 网站建设 商标✡知产 微网小程序 电商运营 彩铃•短信 增值拓展业务
    整理了一个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, ">", "gt;")
            str = Replace(str, "", "lt;")
            str = Replace(str, Chr(32), "nbsp;")
            str = Replace(str, Chr(9), "nbsp;nbsp;nbsp;nbsp;")
            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), "nbsp;")
        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, "","lt;")
        htmlStr = Replace(htmlStr, ">","gt;")
        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,"nbsp;"," "),"quot;",chr(34)),"gt;",">"),"lt;","")
        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," ","nbsp;"),chr(34),"quot;"),">","gt;"),"","lt;")
    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, "lt;", "")
         sTemp = Replace(sTemp, "gt;", ">")
         sTemp = Replace(sTemp, "quot;", 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
    %>

    上一篇:用ASP开多线程
    下一篇:ASP中Cache技术的应用
  • 相关文章
  • 

    © 2016-2020 巨人网络通讯 版权所有

    《增值电信业务经营许可证》 苏ICP备15040257号-8

    整理了一个editplus的剪辑文件(ASP方面的内容) 整理,了,一个,editplus,的,