VB6-操作数据库

平常搞数据库操作多了就想把经常用的内容放在一起，我也懒，在一本书里的工程例子挑了一个bas，修修改改，凑合这用吧。

Public strCnn As String  '数据库连接字符串
Public AdoCnn As ADODB.Connection '数据库连接
Public IsConnect As Boolean  '判断是否连接


Private Sub Connect() '连接数据库
    On Error GoTo Err:
    If IsConnect = True Then  '如果连接标记为真，则返回。否则会出错
        Exit Sub
    End If
    
    Set AdoCnn = New ADODB.Connection '关键New用于创建新对象cnn
    With AdoCnn
        .ConnectionString = strCnn
        .ConnectionTimeout = 10
        .Open
    End With
    IsConnect = True  '设置连接标记，表示已经连接到数据库
    Exit Sub
Err:
    If Err = -2147467259 Then
        Set Cnn = Nothing
        MsgBox Err.Description & "请检查数据库配置!", vbOKOnly + vbInformation, "Connect"
    Else
        MsgBox Err.Description & "请检查数据库配置!", vbExclamation, "Connect"
    End If
    
End Sub

Public Sub Disconnect() '断开与数据库的连接
    Dim rc As Long
    If IsConnect = False Then Exit Sub '如果连接标记为假，标明已经断开连接，则直接返回
    AdoCnn.Close  '关闭连接
    
    Set AdoCnn = Nothing
    IsConnect = False
End Sub

Public Sub DB_Connect() '使用Connect_Num控制数据库连接
    Connect_Num = Connect_Num + 1
    Connect
End Sub

Public Sub DB_Disconnect()
    If Connect_Num >= CONNECT_LOOP_MAX Then
        Connect_Num = 0
        Disconnect
    End If
End Sub

Public Sub DBapi_Disconnect() '强制关闭api方式访问的数据库，计数器复位
    Connect_Num = 0
    Disconnect
End Sub

Public Sub ExecSql(ByVal TmpSql As String)   '执行数据库操作语句
    On Error GoTo Err:
    Dim cmd As New ADODB.Command  '创建Command对象cmd
    DB_Connect    '连接到数据库
    Set cmd.ActiveConnection = AdoCnn  '设置cmd的ActiveConnection属性，指定与其关联的数据库连接
    cmd.CommandText = TmpSql  '设置要执行的命令文本
    cmd.Execute
    Set cmd = Nothing
    DB_Disconnect
    Exit Sub
Err:
    MsgBox Err.Description, 64, "ExecSql"
End Sub

Public Function QuerySql(ByVal TmpSql As String) As ADODB.Recordset '执行数据库查询语句
    On Error GoTo Err:
    Dim rst As New ADODB.Recordset
    DB_Connect    '连接到数据库
    If IsConnect = False Then Exit Function
    Set rst.ActiveConnection = AdoCnn    '设置rst的ActiveConnection属性，指定与其关联的数据库连接
    rst.CursorType = adOpenKeyset
    rst.LockType = adLockOptimistic   '设置锁定类型
    rst.Open TmpSql    '打开记录集
    Set QuerySql = rst    '返回记录集
    Exit Function
Err:
    MsgBox Err.Description, 64, "QuerySql"
End Function

Public Function GetFieldValue(FieldValue As Variant) As String
    GetFieldValue = IIf(Not IsNull(FieldValue), FieldValue, "")
End Function