写了一个数据库操作的类!有兴趣的可以看一下!

Question

Option ExplicitPrivate strConnectionString As String
Public cmd As adodb.Command
Private cnn As adodb.Connection
Private Rst As adodb.Recordset
Private para As adodb.Parameter
'**************************类本身事件*****************************
Private Sub Class_Initialize()
  Set cmd = New adodb.Command
  Set cnn = New adodb.Connection
  Set Rst = New adodb.Recordset
  cnn.CursorLocation = adUseClient
  With cmd
    .CommandType = adCmdStoredProc
   ' .ActiveConnection = Cnn
  End With
  With Rst
    '
    .CursorType = adOpenKeyset
    .LockType = adLockOptimistic
  End With
End Sub
Private Sub Class_Terminate()
  If cnn.State = adStateOpen Then
    cnn.Close
  End If
  Set Rst = Nothing
  Set cmd = Nothing
  Set cnn = Nothing
End Sub'*************************Connection对象***************************
Public Property Let ConnectionString(ConnectionString As String)  '设置连接字符串
  strConnectionString = ConnectionString
  cnn.ConnectionString = ConnectionString
End PropertyPublic Property Get ConnectionString() As String                  '返回连接字符串
  ConnectionString = strConnectionString
End Property
'*************************Command对象***************************'Public Sub AddParameter(Name As String, DataType As ADODB.DataTypeEnum, Direction As ADODB.ParameterDirectionEnum, Optional Size As Long, Optional Value As Variant)
  'If Size = 0 And Value = Null Then
    'Set Para = cmd.CreateParameter(Name, DataType, Direction, Size, Value)
  'End If
  'Set Para = cmd.CreateParameter(Name, DataType, Direction, Size, Value)
  'cmd.Parameters.Append (Para)
'End Sub
Public Sub AddParameter(para As adodb.Parameter)
  cmd.Parameters.Append para
End Sub
Public Sub RemoveParameter(Index As Integer)
  If Index >= 0 And Index < cmd.Parameters.Count Then
    cmd.Parameters.Delete Index
  Else
    MsgBox "无效的索引!", vbOKOnly, "警告"
  End If
End Sub
Public Property Get ParameterCount() As Integer
  ParameterCount = cmd.Parameters.Count
End Property
Public Property Get ParameterItem(Index As Integer) As adodb.Parameter
  If Index >= 0 And Index < cmd.Parameters.Count Then
    Set ParameterItem = cmd.Parameters.Item(Index)
  Else
    MsgBox "无效的索引!", vbOKOnly, "警告"
  End If
End Property
Public Property Set ParameterItem(Index As Integer, para As adodb.Parameter)
  If Index >= 0 And Index < cmd.Parameters.Count Then
    Set cmd.Parameters.Item(Index) = para
  Else
    MsgBox "无效的索引!", vbOKOnly, "警告"
  End If
End Property
Public Property Let CommandType(CommandType As adodb.CommandTypeEnum)
  cmd.CommandType = CommandType
End Property
Public Property Get CommandType() As adodb.CommandTypeEnum
  CommandType = cmd.CommandType
End Property
Public Sub ParameterClear()
  If cmd.Parameters.Count > 0 Then
    For i = 0 To cmd.Parameters.Count
      cmd.Parameters.Delete i
    Next
  End If
End Sub
Public Function ExecuteNonQuery(myCommandText As String) As Boolean
  ExecuteNonQuery = False
  On Error Resume Next
  If cnn.State = adStateClosed Then
    cnn.Open
    If Err.Number <> 0 Then
      MsgBox "连接服务器失败,请检查连接字符串!", vbOKOnly, "警告"
      Exit Function
    End If
  End If
  On Error GoTo 0
  On Error Resume Next
  cmd.CommandText = CommandText
  cmd.ActiveConnection = cnn
  cmd.Execute
  If Err.Number <> 0 Then
    MsgBox "查询失败,请检查参数配置!", vbOKOnly, "警告"
    Exit Function
  End If
  ExecuteNonQuery = True
End Function
Public Function ExecuteQuery(CommandText As String) As adodb.Recordset
  On Error Resume Next
  If cnn.State = adStateClosed Then
    cnn.Open
    If Err.Number <> 0 Then
      MsgBox "连接服务器失败,请检查连接字符串!", vbOKOnly, "警告"
      Exit Function
    End If
  End If
  On Error GoTo 0
  On Error Resume Next
  cmd.CommandText = CommandText
  cmd.ActiveConnection = cnn
  Set Rst = cmd.Execute
  If Err.Number <> 0 Then
    MsgBox "错误编号:!" & Err.Number & Chr(10) & Chr(13) & "错误描述:" & Err.Description, vbOKOnly, "警告"
    Exit Function
  End If
  Set ExecuteQuery = Rst
End Function
'*************************RecordSet对象***************************
Public Function ExecuteSqlStatement(ByVal SqlStatement As String) As adodb.Recordset
   Dim sTokens() As String
   On Error GoTo ExecuteSQL_Error
   If cnn.State = adStateClosed Then
    cnn.Open
    If Err.Number <> 0 Then
      MsgBox "连接服务器失败,请检查连接字符串!", vbOKOnly, "警告"
      Exit Function
    End If
  End If
   sTokens = Split(SqlStatement)
   If InStr("INSERT,DELETE,UPDATE", _
      UCase$(sTokens(0))) Then
      cnn.Execute SqlStatement
      Msgstring = sTokens(0) & _
         " query successful"
   Else
      Rst.Open Trim$(SqlStatement), cnn, adOpenKeyset, adLockOptimistic
      Set ExecuteSqlStatement = Rst
   End If
   Exit Function
ExecuteSQL_Error:
    MsgBox "查询失败,请检查参数配置!", vbOKOnly, "警告"
    Exit Function
End Function

Answer 1

'Public Sub AddParameter(Name As String, DataType As ADODB.DataTypeEnum, Direction As ADODB.ParameterDirectionEnum, Optional Size As Long, Optional Value As Variant)
  'If Size = 0 And Value = Null Then
    'Set Para = cmd.CreateParameter(Name, DataType, Direction, Size, Value)
  'End If
  'Set Para = cmd.CreateParameter(Name, DataType, Direction, Size, Value)
  'cmd.Parameters.Append (Para)
'End Sub
Public Sub AddParameter(para As adodb.Parameter)
  cmd.Parameters.Append para
End Sub增加参数的问题还未解决,测试也就只试了存储过程,查询.有兴趣的朋友可以顶一下.
写出来主要是给刚接触数据库的朋友,因为刚开始的时候总是会出现连接未打开啊,或者重复打开,关闭一类的问题,也可以不用再管游标,Cnn,不用知道ADO的内部细节.
如果有人有兴趣的话,我会继续加一些功能,呵,最应该加的就是各种连接符串,这都是初学者经常会遇到的问题!
好了.如果没有人有兴趣我也就不写了.反正我自已会用ADO!:)

Answer 2

严重支持楼主，期待楼主的大作尽快出来。
小生我初涉VB，很是不熟。主要用VB写一些COM，还有EXCEL文件的导入导出，数据库操作等程序，楼主有没有经验介绍或者好的参考资料共享，不胜感激！

Answer 3

这是我写的，也贴上来吧。哈
Option ExplicitDim mcnnConnection          As ADODB.Connection
Dim mrecRecord              As ADODB.Recordset
Dim mcmmCommand             As ADODB.CommandDim mstrConnectionString    As String'******************************************************************
'*  名称    ：ufmConnectDB
'*
'*  说明    ：创建数据库连接。
'*
'*  输入    ：
'*
'*  输出    ：
'*
'*  返回    ：long
'*             0－失败
'*            -1－成功
'*
'*  历史    ：ZHOUXNWB创建于2004年08月04日
'******************************************************************
Private Function ufmConnectDB() As LongOn Error GoTo ErrHandler
    
    Set mcnnConnection = New ADODB.Connection
    
    With mcnnConnection
    
        .ConnectionString = mstrConnectionString
        .CursorLocation = adUseClient
        .Open
    
        If .State Then
            ufmConnectDB = -1
        Else
        
            '如果连接不成功，告警
            With guErrInfo
                .strErrNo = "00100002"
                .strErrMsg = "数据库连接失败。连接字串：" & mstrConnectionString
            
                upgWriteLog .strErrMsg, guLogInfo.strErrLog, .strErrNo, 0
                upgAlert frmIP.sckIP.LocalIP, .strErrNo, guLogInfo.strAlertID, guErrInfo.strErrMsg
                
            End With
            
        End If
        
    End With
    
    Exit Function
ErrHandler:
        
    guLogInfo.bolUpdateEnd = True    ufmConnectDB = 0
    
    '记录错误信息
    guErrInfo.strErrMsg = Err.Description: guErrInfo.strErrNo = Err.Number
    '记录日志和发送告警
    upgWriteLog guErrInfo.strErrNo & "-" & guErrInfo.strErrMsg, guLogInfo.strErrLog, guLogInfo.strAlertID & "010001", 1
    upgAlert frmIP.sckIP.LocalIP, guLogInfo.strAlertID & "010001", guErrInfo.strErrNo, guErrInfo.strErrMsg
    
End Function'******************************************************************
'*  名称    ：ufmCloseConnect
'*
'*  说明    ：断开与数据库的连接。
'*
'*  输入    ：
'*
'*  输出    ：
'*
'*  返回    ：long
'*             0－失败
'*            -1－成功
'*
'*  历史    ：ZHOUXNWB创建于2004年08月06日
'******************************************************************
Private Function ufmCloseConnect() As LongOn Error GoTo ErrHandler
    
    '判断是否在连接状态
    With mcnnConnection
    
        If .State <> 1 Then
        
            guErrInfo.strErrMsg = "当前数据库已经是断开状态"
            ufmCloseConnect = 0
            Exit Function
        
        End If
        
        .Close
        
        Set mcnnConnection = Nothing
        
        ufmCloseConnect = -1
        
    End With
    
    Exit Function
ErrHandler:
            
    guLogInfo.bolUpdateEnd = True    ufmCloseConnect = 0
    
    '记录错误信息
    guErrInfo.strErrMsg = Err.Description: guErrInfo.strErrNo = Err.Number
    '记录日志和发送告警
    upgWriteLog guErrInfo.strErrNo & "-" & guErrInfo.strErrMsg, guLogInfo.strErrLog, guLogInfo.strAlertID & "010001", 5
    upgAlert frmIP.sckIP.LocalIP, guLogInfo.strAlertID & "010001", guErrInfo.strErrNo, guErrInfo.strErrMsg
    
End Function'******************************************************************
'*  名称    ：ufgDoSQLReturn
'*
'*  说明    ：执行SQL语句，并返回记录集。
'*
'*  输入    ：bstrSQL（string）  SQL语句。
'*
'*  输出    ：bvarReturn（variant） 返回的记录集。
'*
'*  返回    ：long
'*            -1－成功
'*             0－失败
'*
'*  历史    ：ZHOUXNWB创建于2004年08月06日
'******************************************************************
Public Function ufgDoSQLReturn(ByVal bstrSQL As String, ByRef bvarReturn As Variant) As Long
On Error GoTo ErrHandler
    
    Call ufmConnectDB
    
    Set mcmmCommand = New ADODB.Command
    
    With mcmmCommand
        
        .ActiveConnection = mcnnConnection
        .CommandType = adCmdText
        .CommandText = bstrSQL
        Set mrecRecord = .Execute()
        
    End With
    
    If mrecRecord.EOF Then
    
        '写错误日志
        upgWriteLog "执行SQL语句无返回记录：" & bstrSQL, guLogInfo.strErrLog, guLogInfo.strAlertID & "010010", 3
        
        guLogInfo.bolUpdateEnd = True
        
        ufgDoSQLReturn = 0
        Exit Function
        
    Else
        bvarReturn = mrecRecord.GetRows()
    End If
    
    Call ufmCloseConnect
    
    ufgDoSQLReturn = -1
    
    Exit Function
ErrHandler:
            
    guLogInfo.bolUpdateEnd = True    ufgDoSQLReturn = 0
    
    '记录错误信息
    guErrInfo.strErrMsg = Err.Description: guErrInfo.strErrNo = Err.Number
    '记录日志和发送告警
    upgWriteLog guErrInfo.strErrNo & "-" & guErrInfo.strErrMsg, guLogInfo.strErrLog, guLogInfo.strAlertID & "010001", 3
    upgAlert frmIP.sckIP.LocalIP, guLogInfo.strAlertID & "010001", guErrInfo.strErrNo, guErrInfo.strErrMsg
    
End Function

Answer 4

'******************************************************************
'*  名称    ：ufgDoSQL
'*
'*  说明    ：执行SQL语句，不返回记录集。
'*
'*  输入    ：bstrSQL（string）  SQL语句。
'*
'*  输出    ：
'*
'*  返回    ：long
'*            -1－成功
'*             0－失败
'*
'*  历史    ：ZHOUXNWB创建于2004年08月06日
'******************************************************************
Public Function ufgDoSQL(ByVal bstrSQL As String) As Long
On Error GoTo ErrHandler
    
    '执行的SQL为空
    If bstrSQL = "" Then
        With guErrInfo
            .strErrNo = "00100003"
            .strErrMsg = "执行的SQL为空"
        
            upgWriteLog .strErrMsg, guLogInfo.strErrLog, .strErrNo, 2
            upgAlert frmIP.sckIP.LocalIP, .strErrNo, guLogInfo.strAlertID, guErrInfo.strErrMsg
            
        End With
    End If
    
    Call ufmConnectDB
    
    Set mcmmCommand = New ADODB.Command
    
    With mcmmCommand
        
        .ActiveConnection = mcnnConnection
        .CommandType = adCmdText
        .CommandText = bstrSQL
        .Execute
        
    End With
    
    Call ufmCloseConnect
    
    ufgDoSQL = -1
    
    Exit Function
ErrHandler:
            
    guLogInfo.bolUpdateEnd = True    ufgDoSQL = 0
    
    '记录错误信息
    guErrInfo.strErrMsg = Err.Description: guErrInfo.strErrNo = Err.Number
    '记录日志和发送告警
    upgWriteLog guErrInfo.strErrNo & "-" & guErrInfo.strErrMsg, guLogInfo.strErrLog, "00100001", 3
    upgAlert frmIP.sckIP.LocalIP, "00100001", guLogInfo.strAlertID, guErrInfo.strErrNo & "-" & guErrInfo.strErrMsg
    
End Function'******************************************************************
'*  名称    ：ufgDoSQLbyTrans
'*
'*  说明    ：打开事务机制执行SQL语句，不返回记录集。
'*
'*  输入    ：barySQL（array）  SQL语句组。
'*
'*  输出    ：
'*
'*  返回    ：long
'*            -1－成功
'*             0－失败
'*
'*  历史    ：ZHOUXNWB创建于2004年08月06日
'******************************************************************
Public Function ufgDoSQLbyTrans(ByRef barySQL As Variant) As Long
Dim plngI       As Long
Dim plngCount   As Long
    
    On Error GoTo ErrHandler
    
    If Not IsArray(barySQL) Then
        '事务处理传入的参数不是数组
        With guErrInfo
            .strErrNo = "00100004"
            .strErrMsg = "事务处理传入的参数不是数组"
        
            upgWriteLog .strErrMsg, guLogInfo.strErrLog, .strErrNo, 2
            upgAlert frmIP.sckIP.LocalIP, .strErrNo, guLogInfo.strAlertID, guErrInfo.strErrMsg
            
        End With
    End If
    
    Call ufmConnectDB
    
    Set mcmmCommand = New ADODB.Command
    
    With mcnnConnection
        
        .BeginTrans
        
        plngCount = UBound(barySQL)
        With mcmmCommand
        
            .ActiveConnection = mcnnConnection
            .CommandType = adCmdText
            
            For plngI = 0 To plngCount
              
                .CommandText = barySQL(plngI)
                .Execute
            
            Next
            
        End With
        
        .CommitTrans
        
    End With
    
    Call ufmCloseConnect
    
    ufgDoSQLbyTrans = -1
    
    Exit Function
ErrHandler:
            
    guLogInfo.bolUpdateEnd = True    ufgDoSQLbyTrans = 0
    
    '记录错误信息
    guErrInfo.strErrMsg = Err.Description: guErrInfo.strErrNo = Err.Number
    '记录日志和发送告警
    upgWriteLog guErrInfo.strErrNo & "-" & guErrInfo.strErrMsg, guLogInfo.strErrLog, guLogInfo.strAlertID & "010001", 3
    upgAlert frmIP.sckIP.LocalIP, guLogInfo.strAlertID & "010001", guErrInfo.strErrNo, guErrInfo.strErrMsg
    
End Function'******************************************************************
'*  名称    ：gstrConnectString
'*
'*  说明    ：数据库连接字串。
'*
'*  关联    ：mstrConnectionString
'*
'*  类型    ：string
'*
'*  历史    ：ZHOUXNWB创建于2004年08月05日
Public Property Get gstrConnectString() As String
    gstrConnectString = mstrConnectionString
End PropertyPublic Property Let gstrConnectString(ByVal bstrConnect As String)
    mstrConnectionString = bstrConnect
End Property
'******************************************************************