database.cls

OA编程 源代码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "DataAccess"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private dbtDAOConnect As Connection                 'Database connection
Attribute dbtDAOConnect.VB_VarHelpID = -1
Private WithEvents dbtRDOConnect As RDOConnection   'Database Connection
Attribute dbtRDOConnect.VB_VarHelpID = -1
Private wsDAOWorkspace As Workspace                 'Database workspace
Private rdoEnv As rdoEnvironment                    'Database Environment
Private eumDatabaseEngine As DATABASE_ENGINE_TYPES  'Records database engine type
Private flgTransaction As Boolean                   'Flag indicating if a transaction is in place
Private flgReplicateDatabase As Boolean             ' flag used to indicate that the main database connection failed
                                                    ' and the user is viewing the replicate database

Public Property Get DatabaseEngine() As DATABASE_ENGINE_TYPES
On Error GoTo ErrorHandler
    DatabaseEngine = eumDatabaseEngine
    Exit Property
ErrorHandler:
    'Call gclsMessage.DisplayMessage(Err.Number, , App.EXEName & " : " & "DataAccess : DatabaseEngine")
End Property

Public Sub CloseDAODatabaseConnection()
On Error GoTo ErrorHandler
    If (eumDatabaseEngine = eDAO) Then
        If Not (dbtDAOConnect Is Nothing) Then
            dbtDAOConnect.Close
            Set dbtDAOConnect = Nothing
        End If
        If Not (wsDAOWorkspace Is Nothing) Then
            wsDAOWorkspace.Close
            Set wsDAOWorkspace = Nothing
        End If
        eumDatabaseEngine = eNONE
    Else
        'Call gclsMessage.DisplayMessage(9000, "Attempt to close a none open connection", App.EXEName & " : " & "DataAccess : CloseDAODatabaseConnection")
    End If
    Exit Sub
ErrorHandler:
    'Call gclsMessage.DisplayMessage(Err.Number, , App.EXEName & " : " & "DataAccess : CloseDAODatabaseConnection")
End Sub

Public Sub CreateDAODatabaseConnection()
On Error GoTo ErrorHandler
    If (eumDatabaseEngine = eNONE) Then
        If (wsDAOWorkspace Is Nothing) Then
           Set wsDAOWorkspace = CreateWorkspace("dh", "bkbt919", "", dbUseODBC)
        Else
            wsDAOWorkspace.Close
            Set wsDAOWorkspace = Nothing
            Set wsDAOWorkspace = CreateWorkspace("dh", "bkbt919", "", dbUseODBC)
        End If
        If (dbtDAOConnect Is Nothing) Then
            Set dbtDAOConnect = wsDAOWorkspace.OpenConnection(gcDATABASE_NAME, dbDriverNoPrompt, , _
                "ODBC;DATABASE=" & gcDATABASE_NAME & ";UID=" & "bkbt919" & ";PWD=919bkbt" & ";DSN=" & gcDSN)
        Else
            dbtDAOConnect.Close
            Set dbtDAOConnect = Nothing
            Set dbtDAOConnect = wsDAOWorkspace.OpenConnection(gcDATABASE_NAME, dbDriverNoPrompt, , _
                "ODBC;DATABASE=" & gcDATABASE_NAME & ";UID=" & "bkbt919" & ";PWD=919bkbt" & ";DSN=" & gcDSN)
        End If
        eumDatabaseEngine = eDAO
    Else
        'Call gclsMessage.DisplayMessage(9000, "Attempt to open DAO database connection. Another Connection already exists. ", App.EXEName & " : " & "DataAccess : CreateDAODatabaseConnection")
    End If
    Exit Sub
ErrorHandler:
    'Call gclsMessage.DisplayMessage(Err.Number, , App.EXEName & " : " & "DataAccess : CreateDAODatabaseConnection")
End Sub

Public Sub CloseRDODatabaseConnection()
On Error GoTo ErrorHandler
    If (eumDatabaseEngine = eRDO) Then
        If Not (dbtRDOConnect Is Nothing) Then
            dbtRDOConnect.Close
            Set dbtRDOConnect = Nothing
        End If
        If Not (rdoEnv Is Nothing) Then
            rdoEnv.Close
            Set rdoEnv = Nothing
        End If
        eumDatabaseEngine = eNONE
    Else
        'Call gclsMessage.DisplayMessage(9000, "Attempt to close RDO Database connection. RDO Database engine is not open", App.EXEName & " : " & "DataAccess : CloseRDODatabaseConnection")
    End If
    Exit Sub
ErrorHandler:
    'Call gclsMessage.DisplayMessage(Err.Number, , App.EXEName & " : " & "DataAccess : CloseRDODatabaseConnection")
End Sub

Public Sub RDOBeginTrans()
On Error GoTo ErrorHandler
    If flgTransaction = False Then
        If gclsDatabase.DatabaseEngine = eRDO Then
            dbtRDOConnect.BeginTrans
            flgTransaction = True
        Else
            'Call gclsMessage.DisplayMessage(9000, "Databse access engine not started.", App.EXEName & " : " & "DataAccess : RDOBeginTrans")
        End If
    Else
        'Call gclsMessage.DisplayMessage(9000, "A transaction has already been started", App.EXEName & " : " & "DataAccess : RDOBeginTrans")
    End If
    Exit Sub
ErrorHandler:
    'Call gclsMessage.DisplayMessage(Err.Number, , App.EXEName & " : " & "DataAccess : RDOBeginTrans")
End Sub

Public Sub DAOBeginTrans()
On Error GoTo ErrorHandler
    If flgTransaction = False Then
        If gclsDatabase.DatabaseEngine = eDAO Then
            wsDAOWorkspace.BeginTrans
            flgTransaction = True
        Else
            'Call gclsMessage.DisplayMessage(9000, "Database access engine not started.", App.EXEName & " : " & "DataAccess : DAOBeginTrans")
        End If
    Else
        'Call gclsMessage.DisplayMessage(9000, "A transaction has already been started", App.EXEName & " : " & "DataAccess : DAOBeginTrans")
    End If
    Exit Sub
ErrorHandler:
    'Call gclsMessage.DisplayMessage(Err.Number, , App.EXEName & " : " & "DataAccess : DAOBeginTrans")
End Sub

Public Sub RDOCommitTrans()
On Error GoTo ErrorHandler
    If flgTransaction = True Then
        If gclsDatabase.DatabaseEngine = eRDO Then
            dbtRDOConnect.CommitTrans
            flgTransaction = False
        Else
            'Call gclsMessage.DisplayMessage(9000, "RDO database connection does not exist", App.EXEName & " : " & "DataAccess : RDOCommitTrans")
        End If
    Else
        'Call gclsMessage.DisplayMessage(9000, "No transaction has been started.", App.EXEName & " : " & "DataAccess : RDOCommitTrans")
    End If
    Exit Sub
ErrorHandler:
    'Call gclsMessage.DisplayMessage(Err.Number, , App.EXEName & " : " & "DataAccess : RDOCommitTrans")
End Sub

Public Sub DAOCommitTrans()
On Error GoTo ErrorHandler
    If flgTransaction = True Then
        If gclsDatabase.DatabaseEngine = eDAO Then
            wsDAOWorkspace.CommitTrans
            flgTransaction = False
        Else
            'Call gclsMessage.DisplayMessage(9000, "DAO database connection does not exist", App.EXEName & " : " & "DataAccess : DAOCommitTrans")
        End If
    Else
        'Call gclsMessage.DisplayMessage(9000, "No transaction has been started", App.EXEName & " : " & "DataAccess : DAOCommitTrans")
    End If
    Exit Sub
ErrorHandler:
    'Call gclsMessage.DisplayMessage(Err.Number, , App.EXEName & " : " & "DataAccess : DAOCommitTrans")
End Sub

Public Sub RDORollbackTrans()
On Error GoTo ErrorHandler
    If flgTransaction = True Then
        If gclsDatabase.DatabaseEngine = eRDO Then
            dbtRDOConnect.RollbackTrans
            flgTransaction = False
        Else
            'Call gclsMessage.DisplayMessage(9000, "RDO Database connection does not exist ", App.EXEName & " : " & "DataAccess : RDORollbackTrans")
        End If
    Else
        'Call gclsMessage.DisplayMessage(9000, "No RDO Transaction has been started.", App.EXEName & " : " & "DataAccess : RDORollbackTrans")
    End If
    Exit Sub
ErrorHandler:
    'Call gclsMessage.DisplayMessage(Err.Number, , App.EXEName & " : " & "DataAccess : RDORollbackTrans")
End Sub

Public Sub DAORollbackTrans()
On Error GoTo ErrorHandler
    If flgTransaction = True Then
        If gclsDatabase.DatabaseEngine = eDAO Then
            wsDAOWorkspace.Rollback
            flgTransaction = False
        Else
            'Call gclsMessage.DisplayMessage(9000, "DAO Database connection does not exist ", App.EXEName & " : " & "DataAccess : DAORollbackTrans")
        End If
    Else
        'Call gclsMessage.DisplayMessage(9000, "NO DAO transaction has been started. ", App.EXEName & " : " & "DataAccess : DAORollbackTrans")
    End If
    Exit Sub
ErrorHandler:
    'Call gclsMessage.DisplayMessage(Err.Number, , App.EXEName & " : " & "DataAccess : DAORollbackTrans")
End Sub

Public Sub CreateRDODatabaseConnection()
On Error GoTo ErrorHandler
    If (eumDatabaseEngine = eNONE) Then
        Set rdoEnv = rdoEngine.rdoEnvironments(0)
        With rdoEnv
            .CursorDriver = rdUseOdbc
            .LoginTimeout = 5
            .Username = "bkbt919"
            .Password = "919bkbt"
        End With
        If (dbtRDOConnect Is Nothing) Then
            Set dbtRDOConnect = rdoEnv.OpenConnection(dsname:=gcDSN, _
                prompt:=rdDriverNoPrompt, _
                Connect:="UID:=" & "bkbt919" & "; PWD=919bkbt" & ";")
                
        Else
            dbtRDOConnect.Close
            Set dbtRDOConnect = Nothing
            Set dbtRDOConnect = rdoEnv.OpenConnection(dsname:=gcDSN, _
                prompt:=rdDriverNoPrompt, _
                Connect:="UID:=" & "bkbt919" & "; PWD=919BKBT" & ";")
        End If
        eumDatabaseEngine = eRDO
    Else
        'Call gclsMessage.DisplayMessage(9000, "Database connection already exists", App.EXEName & " : " & "DataAccess : CreateRDODatabaseConnection")
    End If
    Exit Sub
ErrorHandler:
'    Call gclsMessage.DisplayMessage(err.Number, , App.EXEName & " : " & "DataAccess : CreateRDODatabaseConnection")
End Sub

Private Sub Class_Initialize()
    flgTransaction = False
End Sub

Private Sub Class_Terminate()
On Error GoTo ErrorHandler
    Select Case eumDatabaseEngine
        Case eDAO:
            If Not (dbtDAOConnect Is Nothing) Then
                dbtDAOConnect.Close
                Set dbtDAOConnect = Nothing
            End If
            If Not (wsDAOWorkspace Is Nothing) Then
                wsDAOWorkspace.Close
                Set wsDAOWorkspace = Nothing
            End If
            eumDatabaseEngine = Null
        Case eRDO:
             If Not (dbtRDOConnect Is Nothing) Then
                dbtRDOConnect.Close
                Set dbtRDOConnect = Nothing
             End If
             If Not (rdoEnv Is Nothing) Then
                rdoEnv.Close
                Set rdoEnv = Nothing
             End If
             eumDatabaseEngine = Null
        Case eADO:
        Case eNONE:
        Case Else:
    End Select
    Exit Sub
ErrorHandler:
    'Call gclsMessage.DisplayMessage(Err.Number, , App.EXEName & " : " & "DataAccess : Class_Terminate")
End Sub

Public Property Get DAOConnection() As Connection