关于ASP数据库的几种操作

<%
'********************************数据库*****************************************************
'定义全局变量
Public Conn, Rs, Sql, Page, i
'数据库查询次数
Public Sub DBConn()
                Select Case DB_Type
                        Case 0:Call Access(DB_Path,DB_Passwd)
                        Case 1:Call mssql(DB_IP,DB_Uid,DB_Pwd,DB_Name)
                End Select
End Sub
' ============================================
'作  用:连接Access数据库
'参  数:
'返回值:Conn对象
'格  式: Access(数据库路径,密码)
' ============================================
Public Sub Access(DBpath, PWD)
    On Error Resume Next
        '如果数据库对象已打开,不要再打开
        If IsObject(Conn) = True Then Exit Sub
    Dim conn_String
    Set conn = Server.CreateObject("ADODB.Connection")
        Set Rs = Server.CreateObject("ADODB.ReCordSet")
    conn_String = "rovider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Server.MapPath(DBpath) & ";Jet OLEDB:database Password=" & PWD & ""
    conn.Open conn_String
    If Err.Number <> 0 Then
       Response.Write ("<div align='left' style='font-size: 12px'>")
       Response.Write ("错误代码:" & Err.Number & "<br>")
       Response.Write ("错误对象:" & Err.Source & "<br>")
       Response.Write ("错误描述:" & Err.Description & "")
       Response.Write ("</div>")
       Response.End
    End If
End Sub
' ============================================
'作  用:连接MS SQL server 2000 数据库
'参  数:
'返回值:Conn对象
'格  式: Mssql(IP, 用户名, 密码, 数据库名)
' ============================================
Public Sub Mssql(ip, UID, PWD, DB)
     On Error Resume Next
         '如果数据库对象已打开,不要再打开
         If IsObject(Conn) = True Then Exit Sub
     Dim conn_String
     Set conn = Server.CreateObject("ADODB.Connection")
         Set Rs = Server.CreateObject("ADODB.ReCordSet")
     conn_String = "Driver={SQL Server};Server=" & ip & ";Uid=" & UID & "wd=" & PWD & ";Database=" & DB & ""
     conn.Open conn_String
     If Err.Number <> 0 Then
        Response.Write ("<div align='left' style='font-size: 12px'>")
        Response.Write ("错误代码:" & Err.Number & "<br>")
        Response.Write ("错误对象:" & Err.Source & "<br>")
        Response.Write ("错误描述:" & Err.Description & "")
        Response.Write ("</div>")
        Response.End
     End If
End Sub
' ============================================
'作  用:关闭清空对象
'参  数:
'返回值:清空对象
'格  式: Call DBEnd()
' ============================================
Public Sub DBEnd()
    On Error Resume Next
        If IsObject(Rs) Then
                Rs.Close
                Set Rs = Nothing
        End if
        If IsObject(Conn) Then
                Conn.Close
                Set Conn = Nothing
        end if
End Sub
'********************************数据库*****************************************************

'********************************记录集*****************************************************
' ============================================
'作  用:返回记录集对象
'参  数:RsType=1 只读 RsType=3 可写
'返回值:Rs对象
'格  式: Read(sql, RsType)
' ============================================
Public Sub Read(sql, RsLock)
    On Error Resume Next
    Rs.Open sql, conn, 1, RsLock
End Sub
' ============================================
'作  用:返回记录集对象
'参  数:
'返回值:只读Rs对象
'格  式: ExeRs(sql)
' ============================================
Public Sub ExeRs(sql)
    On Error Resume Next
    Set Rs = Conn.execute(sql)
End Sub
' ============================================
'作  用:删除一条
'参  数:
'返回值:无
'格  式: Call Del("表名", id, "返回")
' ============================================
Public Sub Del(table, id, url)
    sql = "delete from " & table & " where id=" & id
    conn.Execute (sql)
    Call DBEnd()
End Sub
' ============================================
'作  用:添加记录
'参  数:
'返回值:无
'格  式: Call Insert(table, Record, Values, url)
' ============================================
Public Sub Insert(table, Record, Values, url)
    sql = "Insert INTO " & table & "("& Record &") Values("& Values &")"
    conn.Execute (sql)
    Call DBEnd()
End Sub
' ============================================
'作  用:更新记录
'参  数:
'返回值:无
'格  式: Call Updata(table, Values, ID, url)
' ============================================
Public Sub Updata(table, Values, ID, url)
    sql = "update set " & table & " "& Values &" where ID="&ID
    conn.Execute (sql)
    Call DBEnd()
End Sub
' ============================================
'作  用:统计函数
'参  数:FieldType -- Max最大值|Min最小值|Avg平均值|Sum总和|Count记录个数
'返回值:
'格  式: GetMaxID(FieldType, FieldName,SheetName)
' ============================================
Function GetMaxID(FieldType,FieldName, SheetName)
    Dim mrs
    Set mrs = Conn.Execute("select "& FieldType &"(" & FieldName & ") from " & SheetName & "")
    If IsNull(mrs(0)) Then
        GetMaxID = 1
    Else
        GetMaxID = mrs(0) + 1
    End If
        Call DBEnd()
    Set mrs = Nothing
End Function
'********************************记录集*****************************************************

'********************************分页*******************************************************
' ============================================
'作  用:没有记录
'参  数:
'返回值:清空rs,Conn对象
'格  式: Call RSEmpty("提示")
' ============================================
Public Sub RSEmpty(Str)
    If Rs.BOF And Rs.EOF Then
        Response.Write (Str)
        Call DBEnd()
    End If
End Sub
' ============================================
'作  用:ADO分页
'参  数:
'返回值:
'格  式: Call RsPage(Num)
' ============================================
Public Sub RsPage(Num)
        Rs.pagesize = Num
        Page = GetStr("age")
        If Len(Page) = 0 Then
                Page = 1
        Else
                Page=Cint(Page)
        End If
        Rs.AbsolutePage = Page
End Sub
' ============================================
'作  用:文字类型分页
'参  数:
'返回值:Html字符串
'格  式: FontPage(Page, url)
' ============================================
Public Sub FontPage(Page, url)
    Dim Style
    Style = "Style='FONT-FAMILY: Webdings;text-decoration: none;'"
    If Page <> 1 Then
        Response.Write ("<a href='?Page=1" & url & "' " & Style & ">9</a>")
    Else
        Response.Write ("<a " & Style & ">9</a>")
    End If
        Response.Write ("  ")
    If Page > 1 Then
        Response.Write ("<a href='?Page=" & Page - 1 & "" & url & "' " & Style & ">7</a>")
    Else
        Response.Write("<a " & Style & ">7</a>")
    End If
    Response.Write ("  第 " & Page & " 页  ")
    If Page < Rs.PageCount Then
        Response.Write ("<a href='?Page=" & Page + 1 & "" & url & "' " & Style & ">8</a>")
    Else
        Response.Write ("<a " & Style & ">8</a>")
    End If
    Response.Write ("  ")
    If Page < Rs.PageCount Then
       Response.Write ("<a href='?Page=" & Rs.PageCount & "" & url & "' " & Style & ">:</a>")
    Else
        Response.Write ("<a " & Style & ">:</a>")
    End If
    Response.Write ("  总数 " & Rs.RecordCount & " 条")
End Sub
' ============================================
'作  用:显示下拉分页
'参  数:
'返回值:Html字符串
'格  式: SelectPage(Rs, Page, url)
' ============================================
Public Sub SelectPage(Page, url)
    Dim i
    Response.Write ("<select name='Page' onChange=" & Chr(34) & "location.href='?Page=' + this.options[this.selectedIndex].value + '" & url & "'" & Chr(34) & "")
    For i = 0 To Rs.PageCount
        Response.Write ("<option value='" & i & "'")
        If Page = i Then
            Response.Write ("selected")
        End If
        Response.Write (">第" & i & "页</option>")
    Next
    Response.Write ("</select>")
End Sub
'********************************分页*******************************************************

'********************************在线人数***************************************************
' ============================================
'作  用:在线人数
'参  数:数据库必须字段:IP字符型,SessionID字符型,DateNow日期型,SS_ID数字型
'返回值:数字
'格  式: GetOnline(表,间隔秒数,数据库类型,统计类别)
' ============================================
Function GetOnline(Conn,Table,TimeNum,DB,SS_ID)
        Dim IP,Online,DbDate,Session_ID
        '取得SessionID
        Session_ID = Session.SessionID
        '取得IP
        IP = Request.ServerVariables("REMOTE_ADDR")
        '查询表,判断用户可存在
        Online = Conn.execute("Select count(*) From "& Table &" where IP='"& IP &"' and SessionID='"& Session_ID &"' and SS_ID="& SS_ID &"")(0)
        
        IF online = 0 Then                '如果没有用户,则添加用户
                Conn.execute("Insert into "& Table &"(IP,SessionID,DateNow,SS_ID) values('"& IP &"','"& Session_ID &"','"& Now() &"',"& SS_ID &")")
        Else                                         '否则更新用户时间
                Conn.execute("Update "& Table &" set DateNow='"& Now &"' where SessionID='"& Session_ID &"'")
        End If
        
        if DB = 0 then                        '数据库类型
                DbDate = "Now()"                'Access                
        else
                DbDate = "getdate()"        'Mssql        
        end if
        Conn.execute("Delete From "& Table &" where DateDiff('s',DateNow,"& DbDate &")>"& TimeNum &" and SS_ID="& SS_ID &"")
        GetOnline = Conn.execute("Select count(*) from "& Table &" where SS_ID="& SS_ID &"")(0)
        Call DBEnd()
End Function
'********************************在线人数***************************************************
' ============================================
'作  用:查询条件
'参  数:
'返回值:Sql字符串
'格  式: and_where(sql)
' ============================================
Public Function and_where(sql)
    If InStr(LCase(sql), " where ") > 0 Then
        and_where = sql & " and "
    Else
        and_where = sql & " where "
    End If
End Function
' ============================================
'作  用:文本框查询处理,方式可 “A B*”“A *B*”“A B”
'参  数:
'返回值:Sql字符串
'格  式: Search_TextArr(StrKey, FildName, FildValue)
'注  意: 查询的时候 FildValue为空,显示的时候的 FildValue 不为空,则会将关键字颜色替换
' ============================================
Public Function Search_TextArr(StrKey, FildName, FildValue)
    Dim StrTmp, ArrTmp, New_StrTmp, Bol_Xin
    StrTmp = "": New_StrTmp = FildValue
    Bol_Xin = False
    ArrTmp = Split(StrKey, Chr(32))
    For Each StrTmp In ArrTmp
      If Trim(StrTmp) <> "" Then
        If New_StrTmp <> "" Then
            StrTmp = Replace(StrTmp, "*", "")
            New_StrTmp = Replace(New_StrTmp, StrTmp, "<font color=""red"">" & StrTmp & "</font>")
        Else
            If Left(StrTmp, 1) = "*" Then StrTmp = "%" & Mid(StrTmp, 2): Bol_Xin = True
            If Right(StrTmp, 1) = "*" Then StrTmp = Mid(StrTmp, 1, Len(StrTmp) - 1) & "%": Bol_Xin = True
            If Not Bol_Xin Then StrTmp = "%" & StrTmp & "%"
            New_StrTmp = New_StrTmp & " And " & FildName & " like '" & StrTmp & "' "
        End If
      End If
      Bol_Xin = False
    Next
    ''去掉得sql模式时的第一个and
    If FildValue = "" And New_StrTmp <> "" Then New_StrTmp = " (" & Mid(New_StrTmp, Len(" And ") + 1) & ") "
    Search_TextArr = New_StrTmp
End Function
'================================================
'函数名:ChkQueryStr
'作  用:过虑查询的非法字符
'参  数:str   ----原字符串
'返回值:过滤后的字符
'================================================
Public Function ChkQueryStr(ByVal str)
        On Error Resume Next
        If IsNull(str) Then
                ChkQueryStr = ""
                Exit Function
        End If
        str = Replace(str, "!", "")
        str = Replace(str, "]", "")
        str = Replace(str, "[", "")
        str = Replace(str, ")", "")
        str = Replace(str, "(", "")
        str = Replace(str, "|", "")
        str = Replace(str, "+", "")
        str = Replace(str, "=", "")
        str = Replace(str, "'", "''")
        str = Replace(str, "%", "")
        str = Replace(str, "*", "")
        str = Replace(str, "&", "")
        str = Replace(str, "@", "")
        str = Replace(str, "#", "")
        str = Replace(str, "^", "")
        str = Replace(str, "《", "")
        str = Replace(str, "》", "")
        str = Replace(str, " ", " ")
        str = Replace(str, Chr(37), "")
        str = Replace(str, Chr(0), "")
        str = Replace(str, "and", "")
        str = Replace(str, "exec", "")
        str = Replace(str, "insert", "''")
        str = Replace(str, "select", "")
        str = Replace(str, "delete", "")
        str = Replace(str, "update", "")
        str = Replace(str, "count", "")
        str = Replace(str, "chr", "")
        str = Replace(str, "mid", "")
        str = Replace(str, "master", "")
        str = Replace(str, "truncate", "")
        str = Replace(str, "char", "")
        str = Replace(str, "eclare", "")
        ChkQueryStr = str
End Function
'================================================
'函数名:CheckInfuse
'作  用:防止SQL注入
'参  数:str   ----原字符串
'        strLen  ----提交字符串长度
'================================================
Public Function CheckInfuse(str,strLen)
        Dim strUnsafe, arrUnsafe
        Dim i
        If Trim(str) = "" Then
                CheckInfuse = ""
                Exit Function
        End If
        str = Left(str, strLen)
        On Error Resume Next
        strUnsafe = "'|^|;|and|exec|insert|select|delete|update|count|*|%|chr|mid|master|truncate|char|declare"
        If Trim(str) <> "" Then
                If Len(str) > strLen Then
                        Response.Write "<Script Language=JavaScript>alert('安全系统提示↓\n\n您提交的字符数超过了限制!');history.back(-1)</Script>"
                        CheckInfuse = ""
                        Response.End
                End If
                arrUnsafe = Split(strUnsafe, "|")
                For i = 0 To UBound(arrUnsafe)
                        If InStr(1, str, arrUnsafe(i), 1) > 0 Then
                                Response.Write "<Script Language=JavaScript>alert('安全系统提示↓\n\n请不要在参数中包含非法字符!');history.back(-1)</Script>"
                                CheckInfuse = ""
                                Response.End
                        End If
                Next
                End If
                CheckInfuse = Trim(str)
                Exit Function
                If Err.Number <> 0 Then
                        Err.Clear
                        Response.Write "<Script Language=JavaScript>alert('安全系统提示↓\n\n请不要在参数中包含非法字符!');history.back(-1)</Script>"
                        CheckInfuse = ""
                        Response.End
                End If
End Function
'================================================
'过程名:CheckQuery
'作  用:限制搜索的关键字
'参  数:str ----搜索的字符串
'返回值:True; False
'================================================
Public Function CheckQuery(ByVal str)
        Dim FobWords, i, keyword
        keyword = str
        On Error Resume Next
        FobWords = Array(91, 92, 304, 305, 430, 431, 437, 438, 12460, 12461, 12462, 12463, 12464, 12465, 12466, 12467, 12468, 12469, 12470, 12471, 12472, 12473, 12474, 12475, 12476, 12477, 12478, 12479, 12480, 12481, 12482, 12483, 12485, 12486, 12487, 12488, 12489, 12490, 12496, 12497, 12498, 12499, 12500, 12501, 12502, 12503, 12504, 12505, 12506, 12507, 12508, 12509, 12510, 12532, 12533, 65339, 65340)
        For i = 1 To UBound(FobWords, 1)
                If InStr(keyword, ChrW(FobWords(i))) > 0 Then
                        CheckQuery = False
                        Exit Function
                End If
        Next
        FobWords = Array("~", "!", "@", "#", "$", "%", "^", "&", "*", "(", ")", "_", "+", "=", "`", "[", "]", "{", "}", ";", ":", """", "'", "<", ">", ".", "/", "\", "|", "?", "about", "after", "all", "also", "an", "and", "another", "any", "are", "as", "at", "be", "because", "been", "before", "being", "between", "both", "but", "by", "came", "can", "come", "could", "did", "do", "each", "for", "from", "get", "got", "had", "has", "have", "he", "her", "here", "him", "himself", "his", "how", "if", "in", "into", "is", "it", "like", "make", "many", "me", "might", "more", "most", "much", "must", "my", "never", "now", "of", "on", "only", "or", "other", "our", "out", "over", "said", "same", "see", "should", "since", "some", "still", "such", "take", "than", "that", "the", "their", "them", "then", "there", "these", "they", "this")
        keyword = Left(keyword, 100)
        keyword = Replace(keyword, "!", " ")
        keyword = Replace(keyword, "]", " ")
        keyword = Replace(keyword, "[", " ")
        keyword = Replace(keyword, ")", " ")
        keyword = Replace(keyword, "(", " ")
        keyword = Replace(keyword, " ", " ")
        keyword = Replace(keyword, "-", " ")
        keyword = Replace(keyword, "/", " ")
        keyword = Replace(keyword, "=", " ")
        keyword = Replace(keyword, ",", " ")
        keyword = Replace(keyword, "'", " ")
        For i = 0 To UBound(FobWords, 1)
                If keyword = FobWords(i) Then
                        CheckQuery = False
                        Exit Function
                End If
        Next
        CheckQuery = True
End Function

%>



文章来自: 本站原创
引用通告: 查看所有引用 | 我要引用此文章
Tags:
评论: 2 | 引用: 0 | 查看次数: 5415
  • 1
kamon [2008-08-12 08:25 PM]
这些代码都是博客的源代码吧。很熟悉的样子
小辫子旺仔 [2008-08-06 08:01 AM]
支持一下,这代码可以做网页聊天了
  • 1
发表评论
昵 称:
密 码: 游客发言不需要密码.
验证码: 验证码
内 容:
选 项:
虽然发表评论不用注册,但是为了保护您的发言权,建议您注册帐号.
字数限制 2000 字 | UBB代码 开启 | [img]标签 关闭