'
' Fonctions d'accès à la base de données
' par ADO
'
Option Explicit On

Module modADO

    Private m_bInsideTransaction As Boolean

    Private m_oConnection As ADODB.Connection

    '=======================================================================
    'Synopsis:              This function begins a new transaction
    'Function input:        none
    'Function output:       Returns TRUE if the function succeeds
    'Remarks
    '=======================================================================
    Public Function BeginTrans() As Boolean
        Dim lErrNo As Long
        Dim sErrDesc As String

        'assume failure
        BeginTrans = False
        m_bInsideTransaction = False

        'enable error handler
        On Error GoTo ErrorHandler

        'signal beginning of transaction
        m_oConnection.BeginTrans()

        'signal transactional success
        m_bInsideTransaction = True

        'we're out of here
        BeginTrans = True
        Exit Function

        'if we're here there then's been an error so process
ErrorHandler:

        MsgBox("Erreur de transaction : " & Err.Number & vbCrLf & Err.Description, MsgBoxStyle.Critical)

    End Function

    '=======================================================================
    'Synopsis:              This function closes a previously opened connection
    'Function input:        none
    'Function output:       Returns TRUE if the function succeeds
    'Remarks
    '=======================================================================
    Public Function CloseConnection() As Boolean

        If Not m_oConnection Is Nothing Then
            m_oConnection.Close()
            m_oConnection = Nothing
        End If
        CloseConnection = True
    End Function

    '=======================================================================
    'Synopsis:              This function commits a previously begun transaction
    'Function input:        Connect string which is a registered DSN. If supplied
    '                       then previously established connection is closed
    'Function output:       Returns TRUE if the function succeeds
    '=======================================================================
    Public Function CommitTrans() As Boolean
        Dim lErrNo As Long
        Dim sErrDesc As String

        'assume failure
        CommitTrans = False

        'enable error handler
        On Error GoTo ErrorHandler

        'commit the transaction
        m_oConnection.CommitTrans()

        'signal closure of transaction, success of function AND we're out of here
        m_bInsideTransaction = False
        CommitTrans = True
        Exit Function

        'if we're here there then's been an error so process
ErrorHandler:
        MsgBox("Erreur de commit BD : " & Err.Number & vbCrLf & Err.Description, MsgBoxStyle.Critical)

    End Function



    '=======================================================================
    'Synopsis:              This function opens a connection using ADO and
    '                       executes the action query passed to it.
    'Function input:        Connect string which is a registered DSN
    '                       Query string to be executed.
    'Function output:       Returns TRUE if the function succeeds
    '=======================================================================
    Public Function ExecQuery( _
                        ByVal Connect As String, _
                        ByVal SQLQuery As String) As Boolean
        Dim oConn As ADODB.Connection
        Dim lErrNo As Long
        Dim sErrDesc As String

        'assume failure
        ExecQuery = False

        'enable error handler
        On Error GoTo ErrorHandler

        'Get connection
        If Connect <> vbNullString Then
            oConn = New ADODB.Connection
            oConn.Open(Connect)
        Else
            oConn = m_oConnection
        End If

        'set up for transaction, execute query, commit transaction, AND clean up
        ' adExecuteNoRecords = 128
        oConn.Execute(SQLQuery, , 128)
        If Connect <> vbNullString Then
            oConn.Close()
        End If
        oConn = Nothing

        'signal success of function AND we're out of here
        ExecQuery = True
        Exit Function

        'if we're here there then's been an error so process
ErrorHandler:
        'Select Case Err.Number
        '    Case -2147467259
        '        MsgBox("Cet élément n'est pas vide ou a des prestations. Suppression ou modification impossible", MsgBoxStyle.Critical)

        '    Case Else
        MsgBox("Erreur de requête BD : " & Err.Number & vbCrLf & Err.Description, MsgBoxStyle.Critical)

        'End Select

        'close connection, AND raise error
        On Error Resume Next
        If Connect <> vbNullString Then
            oConn.Close()
        End If

    End Function



    '=======================================================================
    'Synopsis:              Function opens a connection using ADO AND executes
    '                       a query passed to it. This function returns
    '                       records in a DISCONNECTED recordset.
    'Function input:        Connect string which is a registered DSN
    '                       Query string to be executed.
    '                       A recordset to return records in
    'Function output:       Returns TRUE if the function succeeds
    '=======================================================================
    Public Function GetRecordset( _
                        ByVal Connect As String, _
                        ByVal SQLQuery As String, _
                        ByRef Recordset As ADODB.Recordset) As Boolean

        'assume failure
        GetRecordset = False

        'enable error handler
        On Error GoTo ErrorHandler

        'Get connection AND set up for recordset
        OpenConnection(Connect)

        'set up query
        Recordset = New ADODB.Recordset
        Recordset.ActiveConnection = m_oConnection
        Recordset.CursorLocation = ADODB.CursorLocationEnum.adUseClient
        Recordset.CursorType = ADODB.CursorTypeEnum.adOpenForwardOnly
        Recordset.LockType = ADODB.LockTypeEnum.adLockBatchOptimistic
        Recordset.StayInSync = False

        'execute query AND get recordset
        Recordset.Open(SQLQuery)

        'clean up
        Recordset.ActiveConnection = Nothing

        CloseConnection()

        'signal success of function AND we're out of here
        GetRecordset = True
        Exit Function

        'if we're here there then's been an error so process
ErrorHandler:
        MsgBox("Erreur de lecture BD : " & Err.Number & vbCrLf & Err.Description, MsgBoxStyle.Critical)

    End Function



    '=======================================================================
    'Synopsis:              This function creates AND opens a new connection
    'Function input:        Connect string which is a registered DSN
    'Function output:       Returns TRUE if the function succeeds
    'Remarks
    '=======================================================================
    Public Function OpenConnection(ByVal Connect As String) As Boolean
        Dim lErrNo As Long
        Dim sErrDesc As String

        'assume failure
        OpenConnection = False

        'enable error handler
        On Error GoTo ErrorHandler

        'establish the transaction if DSN specified
        If Connect <> vbNullString Then
            CloseConnection()
            m_oConnection = New ADODB.Connection
            m_oConnection.Open(Connect)
        End If

        'we're out of here
        OpenConnection = True
        Exit Function

        'if we're here there then's been an error so process
ErrorHandler:

        MsgBox("Erreur de connection BD : " & Err.Number & vbCrLf & Err.Description, MsgBoxStyle.Critical)


    End Function


    '=======================================================================
    'Synopsis:              This function rolls back a previously begun transaction
    '
    'Function input:        Connect string which is a registered DSN. If supplied
    '                       then previously established connection is closed
    'Function output:       Returns TRUE if the function succeeds
    '=======================================================================
    Public Function RollbackTrans() As Boolean
        Dim lErrNo As Long
        Dim sErrDesc As String

        'assume failure
        RollbackTrans = False

        'enable error handler
        On Error GoTo ErrorHandler

        'roll back the transaction
        m_oConnection.RollbackTrans()

        'signal closure of transaction, success of function AND we're out of here
        m_bInsideTransaction = False
        RollbackTrans = True
        Exit Function

        'if we're here there then's been an error so process
ErrorHandler:
        MsgBox("Erreur de Rollback : " & Err.Number & vbCrLf & Err.Description, MsgBoxStyle.Critical)

    End Function


End Module