#TITLE=ASP常用語法及函數(shù)
#INFO
ASP常用的一些語法及自定義函數(shù)
#SORT=n

#T= ===ASP常用語法===
#T=============================
#T=數(shù)據(jù)庫相關
#T=　連接ACCESS數(shù)據(jù)庫
%
Dim DBName,Conn
DBName"^!"    '定義數(shù)據(jù)庫路徑及名稱
SET Conn = Server.CreateObject("ADODB.Connection")
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" Server.MapPath(DBName)
%>

#T=　連接MS SQL數(shù)據(jù)庫
%
Dim Conn
SET Conn=Server.CreateObject("ADODB.connection")
Conn.Open "PROVIDER=SQLOLEDB;DATA SOURCE=SQL服務器名稱或IP地址;UID=數(shù)據(jù)庫登錄帳號;PWD=數(shù)據(jù)庫密碼;DATABASE=數(shù)據(jù)庫名稱"
%>

#T=　建立記錄集
SET ^!=Server.CreateObject("ADODB.recordset")

#T=　執(zhí)行SQL命令
RS.Open SQL,conn,1,1

#T=　執(zhí)行SQL命令
Conn.Execute("^!")

#T=　RS直接執(zhí)行SQL命令
SET RS = Conn.Execute("^!")

#T=　關閉記錄集
RS.CLOSE
SET RS=NOTHING

#T=　關閉數(shù)據(jù)庫
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函數(shù)
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=　取服務器操作系統(tǒng)
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=　取地址欄后的參數(shù)
Request.ServerVariables("QUERY_STRING")

#T=　取服務器系統(tǒng)信息
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=　取客戶端語言環(huán)境
^!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=自定義函數(shù)
#T=　過濾HTML字符
%
'過濾HTML字符函數(shù)
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=　取字符串長度
%
'求字符串長度函數(shù)
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=　獲取安全的提交參數(shù)
%
'===============================================================
'SQL Injection Check
'函數(shù)功能：過濾字符參數(shù)中的單引號，對于數(shù)字參數(shù)進行判斷，如果不是數(shù)值類型，則賦值0
'參數(shù)意義：str ---- 要過濾的參數(shù)
'strType ---- 參數(shù)類型，分為字符型和數(shù)字型，字符型為"s"，數(shù)字型為"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 = "我操|(zhì)操你|操他|你媽的|他媽的|狗|雜種|屄|屌|王八|強奸|做愛|處女|澤民|法輪|法倫|洪志|法輪"
    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格式，用于從數(shù)據(jù)庫中取出值填入輸入框時
'注意：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=　正則表表達式驗證函數(shù)
%
'正則表表達式驗證函數(shù) patrn-正則表達式　strng-需要驗證的字符串
'===============================================================
Function RegExpTest(patrn, strng)
    Dim regEx, retVal ' 建立變量。
    SET regEx = New RegExp ' 建立正則表達式。
    regEx.Pattern = patrn ' 設置模式。
    regEx.IgnoreCase = False ' 設置是否區(qū)分大小寫。
    retVal = regEx.Test(strng) ' 執(zhí)行搜索測試。
    RegExpTest = retVal '返回值，不符合就返回false，符合為true
    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
%>