275 lines
8.9 KiB
VB.net
275 lines
8.9 KiB
VB.net
'
|
|
' 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
|