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
% >