程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 網頁編程 >> ASP編程 >> 關於ASP編程 >> ASP的一些自定義函數整理第1/2頁

ASP的一些自定義函數整理第1/2頁

日期:2017/1/11 9:16:12      編輯:關於ASP編程
<% 
'============================================================================================================================ 
'函數列表: 
'1:    建立數據庫的連接 ConnOpen(DataBaseConnectStr,DBType,Conn_object) 
'2:    斷開數據庫的連接 ConnClose(Conn_object) 
'3:    防止SQL注入 SafeRequest(paraName,paraType) 
'4:    格式化日期 DateFormat(dateStr,dateType) 
'5:    顯示錯誤提示 ShowErr(errStr) 
'6:    查詢字符串中特定數據 SelectStr(contentStr,patternStr,patternNum) 
'7:    過濾指定字符 Leach(contentStr,badWords) 
'8:    遠程文件內容抓取 Seize(urlStr) 
'9:    數據流編碼處理 BytesToBstr(body,cset) 
'10:    編碼cookies codeCookie(contentStr) 
'11:    解碼cookies DecodeCookie(contentStr) 
'12:    檢驗數據提交來源是否合法 ChkPost() 
'13:    個性化加密 MyEncrypt(StrPassword) 
'14:    禁止浏覽器緩存本頁 NoBuffer() 
'15:    網頁格式化輸入文本 HTMLEncode(fString) 
'16:    從頭部截取字符串的指定長度(按字符數算) GotTopic(Str,StrLen) 
'17:    檢測驗證碼 CheckRadomPass(RadomPass) 
'18:    生成驗證碼 GetCode() 
'19:    獲取客戶端操作系統版本 GetSystem() 
'20:    數據庫事務處理 ConnManage(Conn_object) 
'21:    快速排序(遞歸) QuickSort(arr,Low,High) 
'22:    將數組的元素以特定字符串連起來 arr_join(arr,character) 
'23:    返回字符串以某分割符分割的數目 count_character(str,character) 
'24:    截取含有分割符的字符串中指定數目的字符串 inter_str_by_character_num(str,character,start,num) 
'25:    利用Stream下載文件 downloadFile(strFile) 
'26:    返回信息 send_back(ResultWords) 
'27:    獲取錯誤信息 get_err() 
'28:    與SafeRequest相反 SafeResponse(content) 
'29:    保存遠程圖片 SaveRemoteFile(LocalFileName,RemoteFileUrl) 
'30:    ... 
dim language_arr(10) 
language_arr(0) = "數據庫連接的參數設置錯誤!" 
language_arr(1) = "數據庫連接的類型參數設置錯誤!" 
language_arr(2) = "數據庫連接失敗!" 
language_arr(3) = "非法的參數值!" 
language_arr(4) = "參數值不是有效的日期格式!" 
language_arr(5) = "操作失敗!" 
language_arr(6) = "欄目有重名!" 
language_arr(7) = "欄目名稱為空!" 
language_arr(8) = "欄目文件夾創建失敗!" 
language_arr(9) = "您沒有此權限!" 
'============================================================================================================================ 
'函數ID:1 
'函數作用:建立數據庫的連接 
'作者名稱:茫仔 xiamangmang@gmail.com 博客:blog.mzoe.com 
'建立時間:2006-2-15 10:28 
'修改時間: 
'傳人參數: 
'    connectStr:數據庫連接字符串 
'    connectType:數據庫類別-數字型,0為Access,1為MS SQL 
'返回值: 
'============================================================================================================================ 
sub ConnOpen(DataBaseConnectStr,DBType,Conn_object) 
    Set Conn_object = Server.Createobject("adodb.connection") 
    if DataBaseConnectStr = "" then call ShowErr(language_arr(0)) 
    if DBType = 0 then 
        Conn_object.Open "driver={Microsoft Access Driver (*.mdb)};dbq=" & DataBaseConnectStr 
    elseif DBType = 1 then 
        Conn_object.Open "Provider=SQLOLEDB.1;" & DataBaseConnectStr 
    else 
        call ShowErr(language_arr(1)) 
    end if 
    err.clear 
end sub 
'============================================================================================================================ 
'函數ID:2 
'函數作用:斷開數據庫的連接 
'作者名稱:茫仔 xiamangmang@gmail.com 博客:blog.mzoe.com 
'建立時間:2006-2-16 15:10 
'修改時間: 
'傳人參數: 
'返回值: 
'============================================================================================================================ 
Sub ConnClose(Conn_object) 
    Conn_object.close 
    set Conn_object = nothing 
End sub 
'============================================================================================================================ 
'函數ID:3 
'函數作用:防止SQL注入 
'作者名稱:http://news.dvbbs.net/infoview/Article_2906.html 
'建立時間:2006-2-16 15:32 
'修改時間: 
'傳人參數: 
'    paraName:參數名稱-字符型 
'    paraType:參數類型-數字型(1表示以上參數是數字,0表示以上參數為字符)  
'返回值: 
'    過濾後的字符串 
'============================================================================================================================ 
Function SafeRequest(paraName,paraType) 
    dim paraValue 
    paraValue = Request(paraName) 
    select case paraType 
        case 0 
            paraValue = replace(paraValue,"'","[system:34]") 
            paraValue = replace(paraValue,"=","[system:61]") 
        case 1 
            if not IsNumeric(paraValue) then call ShowErr(language_arr(3)) 
        case -1 
            if not IsNumeric(paraValue) then call ShowErr(language_arr(3)) 
            if paraValue = "" then paraValue = 0 
        case else 
            if len(paraValue) > paraType then call ShowErr(language_arr(3)) 
            paraValue = replace(paraValue,"'","[system:34]") 
            paraValue = replace(paraValue,"=","[system:61]") 
    end select 
    SafeRequest = paraValue 
End function 
'============================================================================================================================ 
'函數ID:4 
'函數作用:格式化日期 
'作者名稱:茫仔 xiamangmang@gmail.com 博客:blog.mzoe.com 
'建立時間:2006-2-16 15:45 
'修改時間: 
'傳人參數: 
'    dateStr:日期字符串 
'    paraType:日期類型-數字型 
'返回值: 
'    格式化後的日期 
'============================================================================================================================ 
Function  DateFormat(dateStr,dateType) 
    Dim dateString 
    if IsDate(dateStr) = False then 
        call ShowErr(language_arr(4)) 
    end if 
    Select Case dateType 
      Case "1" 
          dateString = Year(dateStr)&"-"&Month(dateStr)&"-"&Day(dateStr) 
      Case "2" 
          dateString = Year(dateStr)&"."&Month(dateStr)&"."&Day(dateStr) 
      Case "3" 
          dateString = Year(dateStr)&"/"&Month(dateStr)&"/"&Day(dateStr) 
      Case "4" 
          dateString = Month(dateStr)&"/"&Day(dateStr)&"/"&Year(dateStr) 
      Case "5" 
          dateString = Day(dateStr)&"/"&Month(dateStr)&"/"&Year(dateStr) 
      Case "6" 
          dateString = Month(dateStr)&"-"&Day(dateStr)&"-"&Year(dateStr) 
      Case "7" 
          dateString = Month(dateStr)&"."&Day(dateStr)&"."&Year(dateStr) 
      Case "8" 
          dateString = Month(dateStr)&"-"&Day(dateStr) 
      Case "9" 
          dateString = Month(dateStr)&"/"&Day(dateStr) 
      Case "10" 
          dateString = Month(dateStr)&"."&Day(dateStr) 
      Case "11" 
          dateString = Month(dateStr)&language_arr(6)&Day(dateStr)&language_arr(7) 
      Case "12" 
          dateString = Day(dateStr)&language_arr(7)&Hour(dateStr)&language_arr(8) 
      case "13" 
          dateString = Day(dateStr)&language_arr(7)&Hour(dateStr)&language_arr(8) 
      Case "14" 
          dateString = Hour(dateStr)&language_arr(8)&Minute(dateStr)&language_arr(9) 
      Case "15" 
          dateString = Hour(dateStr)&":"&Minute(dateStr) 
      Case "16" 
          dateString = Year(dateStr)&language_arr(5)&Month(dateStr)&language_arr(6)&Day(dateStr)&language_arr(7) 
      Case Else 
          dateString = dateStr 
     End Select 
     DateFormat = dateString 
End Function 
'============================================================================================================================ 
'函數ID:5 
'函數作用:顯示錯誤提示 
'作者名稱:茫仔 xiamangmang@gmail.com 博客:blog.mzoe.com 
'建立時間:2006-2-16 16:29 
'修改時間: 
'傳人參數: 
'    errStr:錯誤提示-字符型 
'返回值:返回提交頁面 
'============================================================================================================================ 
sub ShowErr(errStr) 
    Response.Write("<script>alert("""&errStr&""");location.href=""javascript:history.back()"";</script>") 
    Response.End 
End sub 
'============================================================================================================================ 
'函數ID:6 
'函數作用:查詢字符串中特定數據 
'作者名稱:茫仔 xiamangmang@gmail.com 博客:blog.mzoe.com 
'建立時間:2006-2-16 16:40 
'修改時間: 
'傳人參數: 
'    contentStr:查詢字符串 
'    patternStr:匹配式字符串 
'    patternNum:查詢定位-數字型 
'返回值: 
'    找不到返回false 
'    patternNum為-1返回所有匹配字符串並以[10]隔開 
'    否則返回指定位置的字符串 
'============================================================================================================================ 
Function SelectStr(contentStr,patternStr,patternNum) 
    dim objRegExp,matches,matche 
    if contentStr = "" then 
        call ShowErr(language_arr(12)) 
    end if 
    Set objRegExp=new RegExp   '建立正則表達式 
    objRegExp.pattern = patternStr    '設置模式 
    objRegExp.IgnoreCase =False    '設置是否區分字符大小寫 
    objRegExp.Global=true    '設置全局可用性 
    objRegExp.pattern = patternStr    '匹配式 

    if objRegExp.test(contentStr) = false then    '全局匹配 
        SelectStr = false 
    else 
        Set matches = objRegExp.Execute(contentStr)    '執行搜索 
        if patternNum = -1 then 
            for each matche in matches 
                SelectStr = SelectStr &"[10]"& matche.value 
            next 
        else 
            SelectStr = matches.Item(patternNum).value 
        end if 
    end if 

    Set objRegExp=Nothing 
End Function 
'============================================================================================================================ 
'函數ID:7 
'函數作用:過濾指定字符 
'作者名稱:茫仔 xiamangmang@gmail.com 博客:blog.mzoe.com 
'建立時間:2006-2-16 16:59 
'修改時間: 
'傳人參數: 
'    contentStr:源字符串 
'    badWords:要過濾的字符串,若數目大於1則用英文狀態的"^"隔開 
'返回值: 
'    返回過濾後的字符串 
'============================================================================================================================ 
Function Leach(contentStr,badWords) 
    dim badWordsArr,i 
    badWordsArr = Split(badWords,"^") 
    for i = 0 to UBound(badWordsArr) 
        contentStr = replace(contentStr,badWordsArr(i),"") 
    next 
    leach = contentStr 
end Function 
'============================================================================================================================ 
'函數ID:8 
'函數作用:遠程文件內容抓取 
'作者名稱:茫仔 xiamangmang@gmail.com 博客:blog.mzoe.com 
'建立時間:2006-2-16 17:24 
'修改時間: 
'傳人參數: 
'    urlStr:遠程文件地址 
'返回值: 
'    返回遠程文件內容 
'============================================================================================================================ 
function Seize(urlStr) 
    dim connect 
    if urlStr = "" then 
        call ShowErr(language_arr(13)) 
    else 
        Set connect = CreateObject("Microsoft.XMLHTTP")    '建立XMLHTTP對象 
        connect.open "GET",urlStr,false    '設置參數,通信方式為get,請求為同步,後面還有兩個可選屬性:userID,password用於用戶驗證 
        connect.send()     '數據發送,Send方法的參數類型可以是字符串、DOM樹或任意數據流 
        Seize = BytesToBStr(connect.responseBody,"GB2312")    '返回信息,編碼為中文 
        set connect = nothing 
    end if 
end function 
'============================================================================================================================ 
'函數ID:9 
'函數作用:數據流編碼處理 
'作者名稱:茫仔 xiamangmang@gmail.com 博客:blog.mzoe.com 
'建立時間:2006-2-16 17:30 
'修改時間: 
'傳人參數: 
'    body:數據內容 
'    cset:編碼格式     
'返回值: 
'    編碼處理後的信息 
'============================================================================================================================ 
Function BytesToBstr(body,cset) 
    dim objstream 
    set objstream = Server.CreateObject("adodb.stream") 
    objstream.Type = 1    '以二進制模式打開 
    objstream.Mode =3 
    objstream.Open 
    objstream.Write body 
    objstream.Position = 0 
    objstream.Type = 2 
    objstream.Charset = cset 
    BytesToBstr = objstream.ReadText 
    objstream.Close 
    set objstream = nothing 
End Function 
'============================================================================================================================ 
'函數ID:10 
'函數作用:編碼cookies 
'作者名稱:茫仔 xiamangmang@gmail.com 博客:blog.mzoe.com 
'建立時間:2006-2-16 17:36 
'修改時間: 
'傳人參數: 
'    contentStr:數據內容 
'返回值: 
'    編碼處理後的信息,字符以"a"隔開 
'============================================================================================================================ 
Function codeCookie(contentStr) 
    Dim i,returnStr 
    For i = Len(contentStr) to 1 Step -1 
        returnStr = returnStr & Ascw(Mid(contentStr,i,1)) 
        If (i <> 1) Then returnStr = returnStr & "a" 
    Next 
    CodeCookie = returnStr 
End Function 
'============================================================================================================================ 
'函數ID:11 
'函數作用:解碼cookies 
'作者名稱:茫仔 xiamangmang@gmail.com 博客:blog.mzoe.com 
'建立時間:2006-2-17 16:58 
'修改時間: 
'傳人參數: 
'    contentStr:數據內容         
'返回值: 
'    解碼處理後的信息         
'============================================================================================================================ 
Function DecodeCookie(contentStr) 
    Dim i 
    Dim StrArr,StrRtn 
    StrArr = Split(contentStr,"a") 
    For i = 0 to UBound(StrArr) 
        If isNumeric(StrArr(i)) = True Then 
            StrRtn = Chrw(StrArr(i)) & StrRtn 
        Else 
            StrRtn = contentStr 
            Exit Function 
        End If 
    Next 
    DecodeCookie = StrRtn 
End Function 
'============================================================================================================================ 
'函數ID:12 
'函數作用:檢驗數據提交來源是否合法 
'作者名稱:茫仔 xiamangmang@gmail.com 博客:blog.mzoe.com 
'建立時間:2006-2-18 18:55 
'修改時間: 
'傳人參數: 

'返回值: 
'    Boolean 
'============================================================================================================================ 
Function ChkPost() 
    Dim server_v1,server_v2 
    Chkpost=False 
    server_v1=Cstr(Request.ServerVariables("HTTP_REFERER")) 
    server_v2=Cstr(Request.ServerVariables("SERVER_NAME")) 
    If Mid(server_v1,8,len(server_v2))=server_v2 Then Chkpost=True 
End Function 
'============================================================================================================================  當前1/2頁 12下一頁閱讀全文
  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved