|
 Trouver une ressource
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !
 CONNECTION BASE DONNÉE JET OLEDB 4.0 EN VISUAL BASIC .NET
 Information sur la source
 Description
j'ai cherché tr`se longtemps une connection à une base de donnée accès fiable. Après avoir rien trouver, j'ai décider de fabriquer mon propre module avec ses propres outils. faut savoir qu,il y a 2 façon de se connecter à une base de donnée, soit a connections unique ou soit avec une connection permanente. moi, c'est pour se connecter à une base de donnée temporaire, donc je veux être connecté en tout temps à ma base de donnée, puisque sinon, lors de la création d'un reccordset, faut se reconnecter à la base tout le temps et ont perd un temps fou Donc avec une connection permanente, le temps de connection sest null, c'est extrêment rapide. En plus, l'accès à la base est pas exclusive dasn mon code, donc ont peut avoir une base de donnée sur nu réseau et utiliser ma connection ceux qui se sont connecter à une base ded onnée en accès sur un gros programme ont du recontrer un problème, le nombre de connections est limité. Ce qui veux dire, même si on ferme nos reccordset, les connections s'accumule et le programme fini par planter avec comme message, trop de connections. Mo module règle le problème, s'il y a un surplus de connection, il se déconnecte et se reconnecte à la base de donnée pour libérer ses connection. Après pus de problème, jusqu'à la prochaine overdose de connection. j'ai aussi remarquer, malgré que les reccordset sont pareil a VB6.0 ou VBA, certaine fonction ne marche pas. J'ai crée des parade pour avoir les même fonctionnalité. le problème avec les modules pour se connecter à une base de donnée, c'est que le nombre de reccordset est limité. moi pas. Je peux avoir autant de erccordset que je veux. un autre problème, certain module permet de récupéré quand ça plante, sauf dès qu'on ferme la base de donnée, tout les reccordset se ferme. Et s'il ré-ouvre les reccordset, ben il les repositionne pas, puisque dasn un programme, s'il a fait 10 movenext et il le remet à l'enregistrement 0, ben ça fais pleins d'erreur. Moi il connait en totu temps sa requête et sa position, s,il plante, il ferme tout, ré-ouvre chaque reccordset et les repositionne au bon endroit. Donc même si la connection plante, on verra un petit ralentissement a cause de la reconnection, mais aucune erreur va survenir et le programme plantera pas.
 Source
- 'Imports DAO
-
- Module BaseDonnee
-
- Public drd1() As ADODB.Recordset
- Private OleDbConnection1 As ADODB.Connection
- Private SelectRSTtemp() As String
- Private nbFois() As Boolean 'savoir si c'est la première lecture
- Private position() As Integer 'connaitre la position dasn le reccordset
- Private ouvert As Boolean = False 'savoir si la base de donnée est ouverte
-
-
- #Region "Connection à la base de donnée"
- Private Sub connection()
- OleDbConnection1 = New ADODB.Connection
- OleDbConnection1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;User ID=secure;Data Source=" & Constante.baseDonnee & _
- ";Persist Security Info=False;Jet OLEDB:System database=" & Constante.SystemData & ";Password=" & Constante.pass & ";User ID=" & Constante.logon
- OleDbConnection1.Open()
- End Sub
- #End Region 'Connection à la base de donnée
-
- #Region "Création du Reccordset"
- Public Sub ouvertureRST(ByVal SelectRST As String, Optional ByVal numero As Integer = 0, Optional ByVal execute As Boolean = True)
- '#Zone " redimentionnement des tableaux (lors des nouveau reccordset non créé) "
- Try
- If UBound(drd1) < numero Then
- ReDim Preserve drd1(numero)
- ReDim Preserve nbFois(numero)
- ReDim Preserve SelectRSTtemp(numero)
- ReDim Preserve position(numero)
- End If
- Catch
- ReDim drd1(numero)
- ReDim nbFois(numero)
- ReDim SelectRSTtemp(numero)
- ReDim position(numero)
- End Try
- '#End Zone
- '#Zone " Connection et initialisation à fermer "
- If Not ouvert Then
- connection()
- drd1(numero) = New ADODB.Recordset
- drd1(numero).ActiveConnection = OleDbConnection1
- ouvert = True
- Else
- Try
- drd1(numero).Close()
- Catch
- End Try
- End If
- '#End Zone
- '#Zone " Zome mémoire pour connaitre la position "
- position(numero) = 0
- SelectRSTtemp(numero) = SelectRST
- nbFois(numero) = True
- '#End Zone
- If LCase(Mid(SelectRST, 1, 6)) = "select" Then
- '#Zone " Si la requête SQL est un Select "
- Try
- drd1(numero).Source = OleDbConnection1.Execute(SelectRST)
- Catch
- '#Zone " Risque d'erreur "
- drd1(numero) = New ADODB.Recordset
- drd1(numero).ActiveConnection = OleDbConnection1
- Try
- drd1(numero).Source = OleDbConnection1.Execute(SelectRST)
- Catch
- ErreurRéouverture()
- End Try
- '#End Zone
- End Try
- Try
- drd1(numero).Open()
- Catch
- End Try
- '#End Zone
- ElseIf execute Then
- '#Zone " Si la requête SQL est un exécute (delete, insert, ...) "
- Try
- OleDbConnection1.Execute(SelectRST)
- Catch
- ErreurRéouverture()
- End Try
- '#End Zone
- End If
- End Sub
- #End Region 'Création du Reccordset
-
- #Region "Une erreur majeur est survenu, redémarrer la conncetion"
- Private Function ErreurRéouverture()
- Dim i As Integer, j As Integer
- Dim temp As Integer, temp2 As Boolean
-
- ouvert = False 'base de donnée initialiser à fermer
- '#Zone " fermer tout les reccordsets "
- For j = 0 To UBound(drd1)
- Try
- drd1(j).Close()
- Catch
- End Try
- Next j
- '#End Zone
- '#Zone " fermer la conection "
- Try
- OleDbConnection1.Close()
- Catch
- End Try
- '#End Zone
- '#Zone " ré-ouvrir les reccordsets et les positionner "
- For j = 0 To UBound(drd1)
- temp = position(j)
- temp2 = nbFois(j)
- ouvertureRST(SelectRSTtemp(j), j, False)
- For i = 1 To temp
- drd1(j).MoveNext()
- Next i
- position(j) = temp
- nbFois(j) = temp2
- Next j
- '#End Zone
- End Function
- #End Region 'Une erreur majeur est survenu, redémarrer la conncetion
-
- 'ici c'est pour faire des boucle While
- 'while basedonne.read(1)
- ' 'évênement
- 'End While
- #Region "Lecture du reccordset (moveNext) et validation s'il a toujours des reccords"
- Public Function read(Optional ByVal numero As Integer = 0) As Boolean
- Try
- '#Zone " changer la position du reccorset "
- If Not nbFois(numero) Then
- '#Zone " pas la première fois, donc move next "
- drd1(numero).MoveNext()
- position(numero) += 1
- '#End Zone
- Else
- '#Zone " première fois, donc reste à sa place "
- nbFois(numero) = False
- '#End Zone
- End If
- '#End Zone
- '#Zone " validation s'il reste un reccord "
- If drd1(numero).EOF Then
- Return False
- Else
- Return True
- End If
- '#End Zone
- Catch
- Return False
- End Try
- End Function
- #End Region 'Lecture du reccordset (moveNext) et validation s'il a toujours des reccords
-
- #Region "positionner à la fin, puis retourne le nombre de reccord"
- Public Function moveLast(Optional ByVal numero As Integer = 0) As Integer
- Dim i As Integer = 0
- While read(numero)
- i += 1
- End While
- Return i
- End Function
- #End Region 'positionner à la fin, puis retourne le nombre de reccord
-
- #Region "positionne au dernier reccord, mais sans le dépasser"
- Public Function moveLastMoins1(Optional ByVal numero As Integer = 0) As Integer
- Dim nb As Integer
- Dim i As Integer
- nb = moveLast(numero)
- moveFirst(numero)
- For i = 0 To nb - 2
- drd1(numero).MoveNext()
- Next i
- position(numero) = i
- End Function
- #End Region 'positionne au dernier reccord, mais sans le dépasser
-
- #Region "retourner au premier reccord"
- Public Function moveFirst(Optional ByVal numero As Integer = 0)
- ouvertureRST(SelectRSTtemp(numero), numero)
- End Function
- #End Region 'retourner au premier reccord
-
- #Region "recevoir le valeur d'un item, mais grâce à sa position dans la requête (rapide)"
- Public Function item(ByVal texte As Integer, Optional ByVal numero As Integer = 0) As Object
- Return drd1(numero).Fields(texte).Value
- End Function
- #End Region 'recevoir le valeur d'un item, mais grâce à sa position dans la requête (rapide)
-
- #Region "recevoir le valeur d'un item, mais grâce à son nom ou alias dans la requête (lent)"
- Public Function item(ByVal texte As String, Optional ByVal numero As Integer = 0) As Object
- Dim i As Integer
- For i = 0 To drd1(numero).Fields.Count - 1
- If LCase(drd1(numero).Fields(i).Name) = LCase(texte) Then
- Return drd1(numero).Fields(i).Value
- End If
- Next i
- End Function
- #End Region 'recevoir le valeur d'un item, mais grâce à son nom ou alias dans la requête (lent)
-
- 'Toujorus fermer la base quand on s,en sert pus, ça évite les bugs
- 'En lpus, ça libère des ressources
- #Region "Fermer la base de donnée"
- Public Function Fermer()
- Dim i As Integer
- For i = 0 To UBound(drd1)
- Try
- drd1(i).Close()
- Catch
- End Try
- Next i
- Try
- OleDbConnection1.Close()
- Catch
- End Try
- ouvert = False
- ReDim drd1(-1)
- ReDim nbFois(-1)
- ReDim SelectRSTtemp(-1)
- ReDim position(-1)
- End Function
- #End Region 'Fermer la base de donnée
-
- End Module
'Imports DAO
Module BaseDonnee
Public drd1() As ADODB.Recordset
Private OleDbConnection1 As ADODB.Connection
Private SelectRSTtemp() As String
Private nbFois() As Boolean 'savoir si c'est la première lecture
Private position() As Integer 'connaitre la position dasn le reccordset
Private ouvert As Boolean = False 'savoir si la base de donnée est ouverte
#Region "Connection à la base de donnée"
Private Sub connection()
OleDbConnection1 = New ADODB.Connection
OleDbConnection1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;User ID=secure;Data Source=" & Constante.baseDonnee & _
";Persist Security Info=False;Jet OLEDB:System database=" & Constante.SystemData & ";Password=" & Constante.pass & ";User ID=" & Constante.logon
OleDbConnection1.Open()
End Sub
#End Region 'Connection à la base de donnée
#Region "Création du Reccordset"
Public Sub ouvertureRST(ByVal SelectRST As String, Optional ByVal numero As Integer = 0, Optional ByVal execute As Boolean = True)
'#Zone " redimentionnement des tableaux (lors des nouveau reccordset non créé) "
Try
If UBound(drd1) < numero Then
ReDim Preserve drd1(numero)
ReDim Preserve nbFois(numero)
ReDim Preserve SelectRSTtemp(numero)
ReDim Preserve position(numero)
End If
Catch
ReDim drd1(numero)
ReDim nbFois(numero)
ReDim SelectRSTtemp(numero)
ReDim position(numero)
End Try
'#End Zone
'#Zone " Connection et initialisation à fermer "
If Not ouvert Then
connection()
drd1(numero) = New ADODB.Recordset
drd1(numero).ActiveConnection = OleDbConnection1
ouvert = True
Else
Try
drd1(numero).Close()
Catch
End Try
End If
'#End Zone
'#Zone " Zome mémoire pour connaitre la position "
position(numero) = 0
SelectRSTtemp(numero) = SelectRST
nbFois(numero) = True
'#End Zone
If LCase(Mid(SelectRST, 1, 6)) = "select" Then
'#Zone " Si la requête SQL est un Select "
Try
drd1(numero).Source = OleDbConnection1.Execute(SelectRST)
Catch
'#Zone " Risque d'erreur "
drd1(numero) = New ADODB.Recordset
drd1(numero).ActiveConnection = OleDbConnection1
Try
drd1(numero).Source = OleDbConnection1.Execute(SelectRST)
Catch
ErreurRéouverture()
End Try
'#End Zone
End Try
Try
drd1(numero).Open()
Catch
End Try
'#End Zone
ElseIf execute Then
'#Zone " Si la requête SQL est un exécute (delete, insert, ...) "
Try
OleDbConnection1.Execute(SelectRST)
Catch
ErreurRéouverture()
End Try
'#End Zone
End If
End Sub
#End Region 'Création du Reccordset
#Region "Une erreur majeur est survenu, redémarrer la conncetion"
Private Function ErreurRéouverture()
Dim i As Integer, j As Integer
Dim temp As Integer, temp2 As Boolean
ouvert = False 'base de donnée initialiser à fermer
'#Zone " fermer tout les reccordsets "
For j = 0 To UBound(drd1)
Try
drd1(j).Close()
Catch
End Try
Next j
'#End Zone
'#Zone " fermer la conection "
Try
OleDbConnection1.Close()
Catch
End Try
'#End Zone
'#Zone " ré-ouvrir les reccordsets et les positionner "
For j = 0 To UBound(drd1)
temp = position(j)
temp2 = nbFois(j)
ouvertureRST(SelectRSTtemp(j), j, False)
For i = 1 To temp
drd1(j).MoveNext()
Next i
position(j) = temp
nbFois(j) = temp2
Next j
'#End Zone
End Function
#End Region 'Une erreur majeur est survenu, redémarrer la conncetion
'ici c'est pour faire des boucle While
'while basedonne.read(1)
' 'évênement
'End While
#Region "Lecture du reccordset (moveNext) et validation s'il a toujours des reccords"
Public Function read(Optional ByVal numero As Integer = 0) As Boolean
Try
'#Zone " changer la position du reccorset "
If Not nbFois(numero) Then
'#Zone " pas la première fois, donc move next "
drd1(numero).MoveNext()
position(numero) += 1
'#End Zone
Else
'#Zone " première fois, donc reste à sa place "
nbFois(numero) = False
'#End Zone
End If
'#End Zone
'#Zone " validation s'il reste un reccord "
If drd1(numero).EOF Then
Return False
Else
Return True
End If
'#End Zone
Catch
Return False
End Try
End Function
#End Region 'Lecture du reccordset (moveNext) et validation s'il a toujours des reccords
#Region "positionner à la fin, puis retourne le nombre de reccord"
Public Function moveLast(Optional ByVal numero As Integer = 0) As Integer
Dim i As Integer = 0
While read(numero)
i += 1
End While
Return i
End Function
#End Region 'positionner à la fin, puis retourne le nombre de reccord
#Region "positionne au dernier reccord, mais sans le dépasser"
Public Function moveLastMoins1(Optional ByVal numero As Integer = 0) As Integer
Dim nb As Integer
Dim i As Integer
nb = moveLast(numero)
moveFirst(numero)
For i = 0 To nb - 2
drd1(numero).MoveNext()
Next i
position(numero) = i
End Function
#End Region 'positionne au dernier reccord, mais sans le dépasser
#Region "retourner au premier reccord"
Public Function moveFirst(Optional ByVal numero As Integer = 0)
ouvertureRST(SelectRSTtemp(numero), numero)
End Function
#End Region 'retourner au premier reccord
#Region "recevoir le valeur d'un item, mais grâce à sa position dans la requête (rapide)"
Public Function item(ByVal texte As Integer, Optional ByVal numero As Integer = 0) As Object
Return drd1(numero).Fields(texte).Value
End Function
#End Region 'recevoir le valeur d'un item, mais grâce à sa position dans la requête (rapide)
#Region "recevoir le valeur d'un item, mais grâce à son nom ou alias dans la requête (lent)"
Public Function item(ByVal texte As String, Optional ByVal numero As Integer = 0) As Object
Dim i As Integer
For i = 0 To drd1(numero).Fields.Count - 1
If LCase(drd1(numero).Fields(i).Name) = LCase(texte) Then
Return drd1(numero).Fields(i).Value
End If
Next i
End Function
#End Region 'recevoir le valeur d'un item, mais grâce à son nom ou alias dans la requête (lent)
'Toujorus fermer la base quand on s,en sert pus, ça évite les bugs
'En lpus, ça libère des ressources
#Region "Fermer la base de donnée"
Public Function Fermer()
Dim i As Integer
For i = 0 To UBound(drd1)
Try
drd1(i).Close()
Catch
End Try
Next i
Try
OleDbConnection1.Close()
Catch
End Try
ouvert = False
ReDim drd1(-1)
ReDim nbFois(-1)
ReDim SelectRSTtemp(-1)
ReDim position(-1)
End Function
#End Region 'Fermer la base de donnée
End Module
 Conclusion
comment l'utiliser, faite une module et copier le code faite un 2e module avec les 4 constantes de connection (et toute les autre constante du programme Module Constante Public logon As String Public pass As String Public Const SystemData = "c:\windows\system.mdw" Public Const baseDonnee = "Basedonne.mdb" End Module le path des base dedonnée et fichier system peuvent être absolu (C:\......) ou relatif (à partir du dossier de l'application) une fois le login et le pass d'entré, reste plus qu'à faire basedonnee.ouvertureRST(SQL) le champs numéro sert à avoir plusieurs reccordset en même temps. le restant est pas mal commenter, mais n'hésiter pas a donner vos commentaires, amélioration, bugs
 Fichier Zip
Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !
 Télécharger le zip
 Historique
- 18 août 2004 19:25:34 :
- ajout d,une source test
- 18 août 2004 19:43:55 :
- pour voir les commentaire de mon gestionnaire de donner dans une base de donnée, mais sans ouvrir Access avec une protection au maximum voir ici
http://www.vbfrance.com/code.aspx?ID=25509
 Sources du même auteur
 Sources de la même categorie
 Commentaires et avis
|
|