ado_connection.cls

来自「本软件是个人的小制作」· CLS 代码 · 共 175 行

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ADO_connection"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Dim ModelName  As String
Dim DB As ADODB.Connection
Dim cnnString As String
Private Sub Class_Initialize()
    ModelName = "ADO_connection"
    cnnString = "dsn=stu_cou;uid=;pwd="
End Sub


Public Function wCnnBegin(Optional ErrInfo As clsErrorInfo) As Boolean
On Error GoTo ErrorHandle
    
    'set initial value of return
    wCnnBegin = False
    If Not (ErrInfo Is Nothing) Then
        With ErrInfo
            .ErrorID = 0
            .ErrorMsg = ""
            .ErrorModel = ModelName
            .ErrorSub = "wCnnBegin"
        End With
    End If
    'connect with database
    Set DB = New ADODB.Connection
    DB.Provider = "MSDASQL"
    DB.Open cnnString
    DB.BeginTrans
    wCnnBegin = True
    Exit Function
ErrorHandle:
    'set error massage
    If Not (ErrInfo Is Nothing) Then
        With ErrInfo
            .ErrorID = Err.Number
            .ErrorMsg = Err.Description
        End With
    End If
    If Not (DB Is Nothing) Then
        Set DB = Nothing
    End If
End Function
Public Function wCnnEnd(Optional ErrInfo As clsErrorInfo) As Boolean
On Error GoTo ErrorHandle
    'set initial value of return
    wCnnEnd = False
    If Not (ErrInfo Is Nothing) Then
        With ErrInfo
            .ErrorID = 0
            .ErrorMsg = ""
            .ErrorModel = ModelName
            .ErrorSub = "wCnnEnd"
        End With
    End If
    'end transaction
    DB.CommitTrans
    If Not (DB Is Nothing) Then
        Set DB = Nothing
    End If
    wCnnEnd = True
    Exit Function
ErrorHandle:
    'set error massage
    If Not (ErrInfo Is Nothing) Then
        With ErrInfo
            .ErrorID = Err.Number
            .ErrorMsg = Err.Description
        End With
    End If
    If Not (DB Is Nothing) Then
        'roll back
        DB.RollbackTrans
        Set DB = Nothing
    End If
End Function
Public Function WriteDB(ByVal Source As String, Optional ErrInfo As clsErrorInfo) As Boolean
On Error GoTo ErrorHandle
    Dim Cmd As ADODB.Command
    'set initial value of return
    WriteDB = False
    If Not (ErrInfo Is Nothing) Then
        With ErrInfo
            .ErrorID = 0
            .ErrorMsg = ""
            .ErrorModel = ModelName
            .ErrorSub = "WriteDB"
        End With
    End If
    'set the sql clause for writing
    Set Cmd = New ADODB.Command
    Cmd.CommandText = Source
    Cmd.CommandType = adCmdText
    Cmd.ActiveConnection = DB
    Cmd.Execute
    WriteDB = True
    Exit Function
ErrorHandle:
    'roll back
    If Not (DB Is Nothing) Then
    DB.RollbackTrans
    End If
    'set error massage
    If Not (ErrInfo Is Nothing) Then
        With ErrInfo
            .ErrorID = Err.Number
            .ErrorMsg = Err.Description
        End With
    End If
    If Not (Cmd Is Nothing) Then
        Set Cmd = Nothing
    End If
    If Not (DB Is Nothing) Then
        Set DB = Nothing
    End If
End Function




Public Function ReadDB(rs As ADODB.Recordset, ByVal Source As String, Optional ErrInfo As clsErrorInfo) As Boolean
On Error GoTo ErrorHandle
    
    Dim DB As ADODB.Connection
    
    'set initial value of return
    ReadDB = False
    If Not (ErrInfo Is Nothing) Then
        With ErrInfo
            .ErrorID = 0
            .ErrorMsg = ""
            .ErrorModel = ModelName
            .ErrorSub = "ReadDB"
        End With
    End If
    'connect with database
    Set DB = New ADODB.Connection
    DB.CursorLocation = adUseClient
    DB.Provider = "MSDASQL"
    DB.Open cnnString
    Set rs = New ADODB.Recordset
    'set the sql clause for search
    rs.Source = Source
    rs.Open , DB, adOpenStatic, adLockOptimistic
    
    If Not (DB Is Nothing) Then
        Set DB = Nothing
    End If
    ReadDB = True
    Exit Function
ErrorHandle:
    'set error massage
    If Not (ErrInfo Is Nothing) Then
        With ErrInfo
            .ErrorID = Err.Number
            .ErrorMsg = Err.Description
        End With
    End If
    If Not (DB Is Nothing) Then
        Set DB = Nothing
    End If
End Function