operatdatabase.bas

入库新书管理模块：用于登记新购图书和受赠图书两部分信息

Attribute VB_Name = "OPeratDataBase"
Public Function GetConnStr() As String
'得到数据库连接字符串，用户可以在此处设置连接字符串
'User ID 是数据库用户ID，Password是登陆密码
'Initial Catalog是数据库名，Data Source是服务器名称
    GetConnStr = ConnectionString
End Function
Public Function OpenConn(ByRef Conn As ADODB.Connection) As Boolean
'打开数据库连接，连接成功返回true，出错时返回false
    Set Conn = New ADODB.Connection
    '出错处理
    On Error GoTo ErrorHandle
    Conn.Open GetConnStr
    OpenConn = True
    Exit Function
ErrorHandle:
    MsgBox "连接数据库失败！请重新连接！"
    OpenConn = False
    Exit Function
End Function
Public Sub ExecuteSQL(ByVal SQL As String, ByRef msg As String)
'执行SQL语句
    Dim Conn As ADODB.Connection
    Dim sTokens() As String
    '出错处理
    On Error GoTo ErrorHandle
    '判断SQL语句
    sTokens = Split(SQL)
    If InStr("INSERT,DELETE,UPDATE", UCase((sTokens(0)))) Then
        '打开数据库连接
        If OpenConn(Conn) Then
            Conn.Execute SQL
            msg = sTokens(0) & "操作执行成功！"
        End If
    Else
        msg = "SQL语句有误：" & SQL
    End If
Finally_Exit:
    Set rst = Nothing
    Set Conn = Nothing
    Exit Sub
ErrorHandle:
    msg = "执行错误: " & Err.Description
    Resume Finally_Exit
End Sub
Public Function SelectSQL(ByVal SQL _
As String, ByRef msg As String) As ADODB.Recordset
'执行SQL语句，返回ADODB.Recordset
    Dim Conn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim sTokens() As String
    '出错处理
    On Error GoTo ErrorHandle
    '判断SQL语句
    sTokens = Split(SQL)
    If InStr("SELECT", UCase((sTokens(0)))) Then
        '打开数据库连接
        If OpenConn(Conn) Then
            Set rst = New ADODB.Recordset
            rst.CursorLocation = adUseClient
            rst.Open Trim$(SQL), Conn, adOpenDynamic, adLockOptimistic
            Set SelectSQL = rst
            msg = "查询到" & rst.RecordCount & " 条记录! "
        End If
    Else
        msg = "SQL语句有误：" & SQL
    End If
Finally_Exit:
    Set rst = Nothing
    Set Conn = Nothing
    Exit Function
ErrorHandle:
    MsgString = "查询错误: " & _
    Err.Description
    Resume Finally_Exit
End Function
Public Function BatchSelectSQL(ByVal SQL _
   As String, ByRef msg As String) As ADODB.Recordset
'执行SQL语句，返回批处理的ADODB.Recordset
    Dim Conn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim sTokens() As String
    '出错处理
    On Error GoTo ErrorHandle
    '判断SQL语句
    sTokens = Split(SQL)
    If InStr("SELECT", UCase((sTokens(0)))) Then
        '打开数据库连接
        If OpenConn(Conn) Then
            Set rst = New ADODB.Recordset
            rst.CursorLocation = adUseClient
            rst.Open Trim$(SQL), Conn, adOpenDynamic, adLockBatchOptimistic
            Set BatchSelectSQL = rst
            msg = "查询到" & rst.RecordCount & " 条记录! "
        End If
    Else
        msg = "SQL语句有误：" & SQL
    End If
Finally_Exit:
    Set rst = Nothing
    Set Conn = Nothing
    Exit Function
ErrorHandle:
    MsgString = "批查询错误: " & _
    Err.Description
    Resume Finally_Exit
End Function