0/5 (7 avis)
Vue 16 183 fois - Téléchargée 2 434 fois
'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
10 sept. 2004 à 18:44
merci.
9 sept. 2004 à 20:39
cherche un peu, il y en a déjà pas mal de source pour se connecter à une base de donnée, mais en VB6.0
pour ce qui est du login et pass, regarde comme il faut, ils sont là, faut les intégré dans le string de connection
9 sept. 2004 à 20:18
serait il possible d'ecrire le debut d'un source sur l'ouverture d'une base de données access 97 ou 2000 avec un mot de passe stp (en vb6)
en fait c'est l'ouverture AVEC un password ki me chagrine...
merci.
18 août 2004 à 19:44
18 août 2004 à 18:20
PS : un ptit zip serais pas de refus car je pense que ta source va faire le tour du site ;)
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.