CLASS CONNEXION ADODB SECURISE

'Développé par ZAPPY zappy@gosney42.org
'Pour toute utilisation commercial, contactez l'auteur
'En cas de redistribution, vous êtes tenu de livrer tel quel, avec le copyright

Option Explicit
Public oConn As ADODB.Connection

Public bSilent As Boolean
Public strConnexionString As String
Public tCursorLocation As ADODB.CursorLocationEnum
Private bPermanant As Boolean

Private Function ExecString(strSQL As String) As ADODB.Recordset
On Error GoTo erreur

'Connection & execution
If Len(strConnexionString) > 0 Then
   If oConn Is Nothing Then
      If Not Connect Then
         Set ExecString = Nothing
         Exit Function
      End If
   End If
   Debug.Print "SQL: " & strSQL
   Set ExecString = oConn.Execute(strSQL)
End If

'Deconnection
If Not bPermanant Then
   Disconnect
End If

Exit Function
erreur:
If gError(Err, "ExecString") Then
   Resume Next
End If
End Function

Public Function Connect() As Boolean
On Error GoTo erreur
Set oConn = New ADODB.Connection

oConn.CursorLocation = tCursorLocation
oConn.Open (strConnexionString)
Connect = True

Exit Function
erreur:
gError Err, "Connect()"
End Function

Private Function Disconnect() As Boolean
On Error GoTo erreur
If Not oConn Is Nothing Then
   oConn.Close
   Set oConn = Nothing
End If
Exit Function
erreur:
gError Err, "Disconnect()"
End Function

Public Property Let Permanant(value As Boolean)
bPermanant = value
If value Then
   tCursorLocation = adUseServer
End If
End Property

Public Property Get Permanant() As Boolean
Permanant = bPermanant
End Property

Public Function ExecSQL(strSQL As String) As ADODB.Recordset
On Error GoTo erreur

Set ExecSQL = ExecString(strSQL)

Exit Function
erreur:
If gError(Err, "ExecSQL") Then
   Resume Next
End If
End Function

Public Function fExecSQL(strSQL As String, ParamArray strArgument() As Variant) As ADODB.Recordset
On Error GoTo erreur

Const MagicString = "42!42!42!42!42!42!" ' "42!" * (4+2) = leet code !!!

Dim i As Long
Dim strTmp As Variant

'Creation de la chaine de commande
For Each strTmp In strArgument
      i = i + 1
      If IsNull(strTmp) Then strTmp = "NULL"
      strSQL = Replace(strSQL, "$" & CStr(i) & "$", AddSlashes(Replace(CStr(strTmp), "$", MagicString, , , vbTextCompare)), , , vbTextCompare)
Next strTmp
strSQL = Replace(strSQL, MagicString, "$", , , vbTextCompare)

'Execution de la chaine SQL
Set fExecSQL = ExecString(strSQL)

Exit Function
erreur:
If gError(Err, "fExecSQL") Then
   Resume Next
End If
End Function

Private Function gError(oErr As ErrObject, strFunction As String) As Boolean
gError = False

Select Case strFunction
   Case Else
      If Not bSilent Then
         If vbYes = MsgBox("Une erreur est survenue !" & vbCrLf & "Voulez vous continuer ?" & String(2, vbCrLf) & CStr(Err.Number) & " : " & Err.Description, vbYesNo + vbExclamation, "Erreur contrôlé") Then
            gError = True
         End If
      End If
End Select
End Function

Private Sub Class_Initialize()
'Initialisation de la class
tCursorLocation = adUseClient
bSilent = False
bPermanant = False
End Sub

Private Sub Class_Terminate()
Call Disconnect
End Sub