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

Option Explicit

Private 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 Property

Public 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

22 个解决方案

#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!:)

#2

晕.没有人有兴趣啊?

#3

谢谢共享！

支持下:D

#4

支持！

#5

楼主好强啊，严重支持！
向楼主学习。。

#6

强，学习

#7

有人支持就好.呵.

全写好了,列出文档和示例再发出来.

谢谢捧场!

#8

#9

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

#10

谢谢楼主，我正在找这样的列子了！

#11

#12

#13

强烈关注与等待中！！！

#14

收藏。up！

#15

这是我写的，也贴上来吧。哈。。。
Option Explicit

Dim mcnnConnection          As ADODB.Connection
Dim mrecRecord              As ADODB.Recordset
Dim mcmmCommand             As ADODB.Command

Dim mstrConnectionString    As String

'******************************************************************
'*  名称    ：ufmConnectDB
'*
'*  说明    ：创建数据库连接。
'*
'*  输入    ：
'*
'*  输出    ：
'*
'*  返回    ：long
'*             0－失败
'*            -1－成功
'*
'*  历史    ：ZHOUXNWB创建于2004年08月04日
'******************************************************************
Private Function ufmConnectDB() As Long

On 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 Long

On 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

#16

'******************************************************************
'*  名称    ：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 Property

Public Property Let gstrConnectString(ByVal bstrConnect As String)
    mstrConnectionString = bstrConnect
End Property
'******************************************************************

#17

对了，我这里不用存储过程，可用话直接传 ?,?...进去就可以了

#18

...up

#19

写一个带有存储过程的塞。
严重关注继续的代码和示例。

#20

我也用类连接数据库同好支持楼主。

#21

学习！

#22

严重关注
请楼主尽快发布

#1

#2