reorganize upload files and images
This commit is contained in:
274
mondumas/static/DEVFAC/RPTViewer/modADO.vb
Normal file
274
mondumas/static/DEVFAC/RPTViewer/modADO.vb
Normal file
@@ -0,0 +1,274 @@
|
||||
'
|
||||
' Fonctions d'acc<63>s <20> la base de donn<6E>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 <20>l<EFBFBD>ment n'est pas vide ou a des prestations. Suppression ou modification impossible", MsgBoxStyle.Critical)
|
||||
|
||||
' Case Else
|
||||
MsgBox("Erreur de requ<71>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
|
||||
Reference in New Issue
Block a user