ASP数据库操作类

<%
'==========================================================================
'文件名称：clsDbCtrl.asp
'功　　能：数据库操作类
'作　　者：coldstone (coldstone[在]qq.com)
'程序版本：v1.0.5
'完成时间：2005.09.23
'修改时间：2007.10.30
'版权声明：可以在任意作品中使用本程序代码，但请保留此版权信息。
'          如果你修改了程序中的代码并得到更好的应用，请发送一份给我，谢谢。
'轉自:http://www.ezsaler.com/Blog/post/158.html
'==========================================================================

Dim a : a = CreatConn(0, "master", "localhost", "sa", "")    'MSSQL数据库
'Dim a : a = CreatConn(1, "Data/%TestDB%.mdb", "", "", "")    'Access数据库
'Dim a : a = CreatConn(1, "E:\MyWeb\Data\%TestDB%.mdb", "", "", "mdbpassword")
Dim Conn
'OpenConn()    '在加载时就建立的默认连接对象Conn,默认使用数据库a
Sub OpenConn : Set Conn = Oc(a) : End Sub
Sub CloseConn : Co(Conn) : End Sub

Function Oc(ByVal Connstr)
    On Error Resume Next
    Dim objConn
    Set objConn = Server.CreateObject("ADODB.Connection")
    objConn.Open Connstr
    If Err.number <> 0 Then
        Response.Write("<div id=""DBError"">数据库服务器端连接错误，请与网站管理员联系。</div>")
        'Response.Write("错误信息：" & Err.Description)
        objConn.Close
        Set objConn = Nothing
        Response.End
    End If
    Set Oc = objConn
End Function

Sub Co(obj)
    On Error Resume Next
    Set obj = Nothing
End Sub

Function CreatConn(ByVal dbType, ByVal strDB, ByVal strServer, ByVal strUid, ByVal strPwd)
    Dim TempStr
    Select Case dbType
        Case "0","MSSQL"
            TempStr = "driver={sql server};server="&strServer&";uid="&strUid&";pwd="&strPwd&";database="&strDB
        Case "1","ACCESS"
            Dim tDb : If Instr(strDB,":")>0 Then : tDb = strDB : Else : tDb = Server.MapPath(strDB) : End If
            TempStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&tDb&";Jet OLEDB:Database Password="&strPwd&";"
        Case "3","MYSQL"
            TempStr = "Driver={mySQL};Server="&strServer&";Port=3306;Option=131072;Stmt=; Database="&strDB&";Uid="&strUid&";Pwd="&strPwd&";"
        Case "4","ORACLE"
            TempStr = "Driver={Microsoft ODBC for Oracle};Server="&strServer&";Uid="&strUid&";Pwd="&strPwd&";"
    End Select
    CreatConn = TempStr
End Function


Class dbCtrl
    Private debug
    Private idbConn
    Private idbErr
    
    Private Sub Class_Initialize()
        debug = true                    '调试模式是否开启
        idbErr = "出现错误："
        If IsObject(Conn) Then
            Set idbConn = Conn
        End If
    End Sub
    
    Private Sub Class_Terminate()
        Set idbConn = Nothing
        If debug And idbErr<>"出现错误：" Then Response.Write(idbErr)
    End Sub
    
    Public Property Let dbConn(pdbConn)
        If IsObject(pdbConn) Then
            Set idbConn = pdbConn
        Else
            Set idbConn = Conn
        End If
    End Property
    
    Public Property Get dbErr()
        dbErr = idbErr
    End Property
    
    Public Property Get Version
        Version = "ASP Database Ctrl V1.0 By ColdStone"
    End Property

    Public Function AutoID(ByVal TableName)
        On Error Resume Next
        Dim m_No,Sql, m_FirTempNo
        Set m_No=Server.CreateObject("adodb.recordset")
        Sql="SELECT * FROM ["&TableName&"]"
        m_No.Open Sql,idbConn,3,3
        If m_No.EOF Then
            AutoID=1
        Else
            Do While Not m_No.EOF
                m_FirTempNo=m_No.Fields(0).Value 
                m_No.MoveNext
                  If m_No.EOF Then 
                        AutoID=m_FirTempNo+1
                  End If
            Loop
        End If
        If Err.number <> 0 Then
            idbErr = idbErr & "无效的查询条件！<br />"
            If debug Then idbErr = idbErr & "错误信息："& Err.Description
            Response.End()
            Exit Function
        End If
        m_No.close
        Set m_No = Nothing
    End Function

    Public Function GetRecord(ByVal TableName,ByVal FieldsList,ByVal Condition,ByVal OrderField,ByVal ShowN)
        On Error Resume Next
        Dim rstRecordList
        Set rstRecordList=Server.CreateObject("adodb.recordset")
            With rstRecordList
            .ActiveConnection = idbConn
            .CursorType = 3
            .LockType = 3
            .Source = wGetRecord(TableName,FieldsList,Condition,OrderField,ShowN)
            .Open 
            If Err.number <> 0 Then
                idbErr = idbErr & "无效的查询条件！<br />"
                If debug Then idbErr = idbErr & "错误信息："& Err.Description
                .Close
                Set rstRecordList = Nothing
                Response.End()
                Exit Function
            End If    
        End With
        Set GetRecord=rstRecordList
    End Function
    
    Public Function wGetRecord(ByVal TableName,ByVal FieldsList,ByVal Condition,ByVal OrderField,ByVal ShowN)
        Dim strSelect
        strSelect="select "
        If ShowN > 0 Then
            strSelect = strSelect & " top " & ShowN & " "
        End If
        If FieldsList<>"" Then
            strSelect = strSelect & FieldsList
        Else
            strSelect = strSelect & " * "
        End If
        strSelect = strSelect & " from [" & TableName & "]"
        If Condition <> "" Then
            strSelect = strSelect & " where " & ValueToSql(TableName,Condition,1)
        End If
        If OrderField <> "" Then
            strSelect = strSelect & " order by " & OrderField
        End If
        wGetRecord = strSelect
    End Function

    Public Function GetRecordBySQL(ByVal strSelect)
        On Error Resume Next
        Dim rstRecordList
        Set rstRecordList=Server.CreateObject("adodb.recordset")
            With rstRecordList
            .ActiveConnection =idbConn
            .CursorType = 3
            .LockType = 3
            .Source = strSelect
            .Open 
            If Err.number <> 0 Then
                idbErr = idbErr & "无效的查询条件！<br />"
                If debug Then idbErr = idbErr & "错误信息："& Err.Description
                .Close
                Set rstRecordList = Nothing
                Response.End()
                Exit Function
            End If    
        End With
        Set GetRecordBySQL = rstRecordList
    End Function

    Public Function GetRecordDetail(ByVal TableName,ByVal Condition)
        On Error Resume Next
        Dim rstRecordDetail, strSelect
        Set rstRecordDetail=Server.CreateObject("adodb.recordset")
        With rstRecordDetail
            .ActiveConnection =idbConn
            strSelect = "select * from [" & TableName & "] where " & ValueToSql(TableName,Condition,1)
            .CursorType = 3
            .LockType = 3
            .Source = strSelect
            .Open 
            If Err.number <> 0 Then
                idbErr = idbErr & "无效的查询条件！<br />"
                If debug Then idbErr = idbErr & "错误信息："& Err.Description
                .Close
                Set rstRecordDetail = Nothing
                Response.End()
                Exit Function
            End If
        End With
        Set GetRecordDetail=rstRecordDetail
    End Function

    Public Function AddRecord(ByVal TableName, ByVal ValueList)
        On Error Resume Next
        DoExecute(wAddRecord(TableName,ValueList))
        If Err.number <> 0 Then
            idbErr = idbErr & "写入数据库出错！<br />"
            If debug Then idbErr = idbErr & "错误信息："& Err.Description
            'DoExecute "ROLLBACK TRAN Tran_Insert"    '如果存在添加事务（事务滚回）
            AddRecord = 0
            Exit Function
        End If
        AddRecord = AutoID(TableName)-1
    End Function
    
    Public Function wAddRecord(ByVal TableName, ByVal ValueList)
        Dim TempSQL, TempFiled, TempValue
        TempFiled = ValueToSql(TableName,ValueList,2)
        TempValue = ValueToSql(TableName,ValueList,3)
        TempSQL = "Insert Into [" & TableName & "] (" & TempFiled & ") Values (" & TempValue & ")"
        wAddRecord = TempSQL
    End Function

    Public Function UpdateRecord(ByVal TableName,ByVal Condition,ByVal ValueList)
        On Error Resume Next
        DoExecute(wUpdateRecord(TableName,Condition,ValueList))
        If Err.number <> 0 Then
            idbErr = idbErr & "更新数据库出错！<br />"
            If debug Then idbErr = idbErr & "错误信息："& Err.Description
            'DoExecute "ROLLBACK TRAN Tran_Update"    '如果存在添加事务（事务滚回）
            UpdateRecord = 0
            Exit Function
        End If
        UpdateRecord = 1
    End Function

    Public Function wUpdateRecord(ByVal TableName,ByVal Condition,ByVal ValueList)
        Dim TmpSQL
        TmpSQL = "Update ["&TableName&"] Set "
        TmpSQL = TmpSQL & ValueToSql(TableName,ValueList,0)
        TmpSQL = TmpSQL & " Where " & ValueToSql(TableName,Condition,1)
        wUpdateRecord = TmpSQL
    End Function

    Public Function DeleteRecord(ByVal TableName,ByVal IDFieldName,ByVal IDValues)
        On Error Resume Next
        Dim Sql
        Sql = "Delete From ["&TableName&"] Where ["&IDFieldName&"] In ("
        If IsArray(IDValues) Then
            Sql = Sql & "Select ["&IDFieldName&"] From ["&TableName&"] Where " & ValueToSql(TableName,IDValues,1)
        Else
            Sql = Sql & IDValues
        End If
        Sql = Sql & ")"
        DoExecute(Sql)
        If Err.number <> 0 Then
            idbErr = idbErr & "删除数据出错！<br />"
            If debug Then idbErr = idbErr & "错误信息："& Err.Description
            'DoExecute "ROLLBACK TRAN Tran_Delete"    '如果存在添加事务（事务滚回）
            DeleteRecord = 0 
            Exit Function
        End If
        DeleteRecord = 1
    End Function
    
    Public Function wDeleteRecord(ByVal TableName,ByVal IDFieldName,ByVal IDValues)
        On Error Resume Next
        Dim Sql
        Sql = "Delete From ["&TableName&"] Where ["&IDFieldName&"] In ("
        If IsArray(IDValues) Then
            Sql = Sql & "Select ["&IDFieldName&"] From ["&TableName&"] Where " & ValueToSql(TableName,IDValues,1)
        Else
            Sql = Sql & IDValues
        End If
        Sql = Sql & ")"
        wDeleteRecord = Sql
    End Function 

    Public Function ReadTable(ByVal TableName,ByVal Condition,ByVal GetFieldNames)
        On Error Resume Next
        Dim rstGetValue,Sql,BaseCondition,arrTemp,arrStr,TempStr,i
        TempStr = "" : arrStr = ""
        '给出SQL条件语句
        BaseCondition = ValueToSql(TableName,Condition,1)
        '读取数据
        Set rstGetValue = Server.CreateObject("ADODB.Recordset")
        Sql = "Select "&GetFieldNames&" From ["&TableName&"] Where "&BaseCondition
        rstGetValue.Open Sql,idbConn,3,3
        If rstGetValue.RecordCount > 0 Then
            If Instr(GetFieldNames,",")>0 Then
                arrTemp = Split(GetFieldNames,",")
                For i = 0 To Ubound(arrTemp)
                    If i<>0 Then arrStr = arrStr &Chr(112)&Chr(112)&Chr(113)
                    arrStr = arrStr & rstGetValue.Fields(i).Value
                Next
                TempStr = Split(arrStr,Chr(112)&Chr(112)&Chr(113))
            Else
                TempStr = rstGetValue.Fields(0).Value
            End If
        End If
        If Err.number <> 0 Then
            idbErr = idbErr & "获取数据出错！<br />"
            If debug Then idbErr = idbErr & "错误信息："& Err.Description
            rstGetValue.close()
            Set rstGetValue = Nothing
            Exit Function
        End If
        rstGetValue.close()
        Set rstGetValue = Nothing
        ReadTable = TempStr
    End Function

    Public Function C(ByVal ObjRs)
        ObjRs.close()
        Set ObjRs = Nothing
    End Function
    
    Private Function ValueToSql(ByVal TableName, ByVal ValueList, ByVal sType)
        Dim StrTemp
        StrTemp = ValueList
        If IsArray(ValueList) Then
            StrTemp = ""
            Dim rsTemp, CurrentField, CurrentValue, i
            Set rsTemp = Server.CreateObject("adodb.recordset")
            With rsTemp
                .ActiveConnection = idbConn
                .CursorType = 3
                .LockType = 3
                .Source ="select * from [" & TableName & "] where 1 = -1"
                .Open
                For i = 0 to Ubound(ValueList)
                    CurrentField = Left(ValueList(i),Instr(ValueList(i),":")-1)
                    CurrentValue = Mid(ValueList(i),Instr(ValueList(i),":")+1)
                    If i <> 0 Then
                        Select Case sType
                            Case 1
                                StrTemp = StrTemp & " And "
                            Case Else
                                StrTemp = StrTemp & ", "
                        End Select
                    End If
                    If sType = 2 Then
                        StrTemp = StrTemp & "[" & CurrentField & "]"
                    Else
                        Select Case .Fields(CurrentField).Type
                            Case 7,133,134,135,8,129,200,201,202,203
                                If sType = 3 Then
                                    StrTemp = StrTemp & "'"&CurrentValue&"'"
                                Else
                                    StrTemp = StrTemp & "[" & CurrentField & "] = '"&CurrentValue&"'"
                                End If
                            Case 11
                                If UCase(cstr(Trim(CurrentValue)))="TRUE" Then
                                    If sType = 3 Then
                                        StrTemp = StrTemp & "1"
                                    Else
                                        StrTemp = StrTemp & "[" & CurrentField & "] = 1"
                                    End If
                                Else 
                                    If sType = 3 Then
                                        StrTemp = StrTemp & "0"
                                    Else
                                        StrTemp = StrTemp & "[" & CurrentField & "] = 0"
                                    End If
                                End If
                            Case Else
                                If sType = 3 Then
                                    StrTemp = StrTemp & CurrentValue
                                Else
                                    StrTemp = StrTemp & "[" & CurrentField & "] = " & CurrentValue
                                End If
                        End Select
                    End If
                Next
            End With
            If Err.number <> 0 Then
                idbErr = idbErr & "生成SQL语句出错！<br />"
                If debug Then idbErr = idbErr & "错误信息："& Err.Description
                rsTemp.close()
                Set rsTemp = Nothing
                Exit Function
            End If
            rsTemp.Close()
            Set rsTemp = Nothing
        End If
        ValueToSql = StrTemp
    End Function

    Private Function DoExecute(ByVal sql)
        Dim ExecuteCmd
        Set ExecuteCmd = Server.CreateObject("ADODB.Command")
        With ExecuteCmd
            .ActiveConnection = idbConn
            .CommandText = sql
            .Execute
        End With
        Set ExecuteCmd = Nothing
    End Function
End Class
%>