Base MS Access & ADO (VB6)
V1.1
1) Ajouter lecomposant ADO à votre projet VB
Allezdans Projet > Références puis cocher Microsoft ActiveXDataObjetcs 2.x Library
Pour l’exemple, supposons que vous choisissez Microsoft ActiveX DataObjetcs 2.8 Library
2) Connexion
Pourvous connecter à votre Base de Donnée, vous devez établir une connexion.
Jevous conseille d’écrire les codes ci-dessous dans un module, parexemple SQL puisque les codes vont vous servir dansd’autres projets.
L’objet qui permet de connecter la base est ADODB.Connectionetutilise une chaîne de connexion. Je vous propose une fonction deconnexion toute faite dont vous pouvez modifier la chaîne de connexionà votre guise. Lemodule commence donc ainsi
| Option Explicit
Option Compare Binary
Private dbPassWord As String
Public cnx As New ADODB.Connection
Private URL_BASE As String
Public Sub ConnexionBase(Optional ByVal cheminBase As String)
Dim ChaineConnexion As String
If cheminBase <> vbNullString Then URL_BASE = cheminBase
On Error GoTo erreur
ChaineConnexion = "Provider=Microsoft.Jet.OLEDB.4.0;DataSource=" & _
URL_BASE & ";Persist Security Info=False;" & _
"JetOLEDB:Database Password=" & dbPassWord
cnx.Open ChaineConnexion
Exit Sub
erreur:
If cnx.State Then cnx.Close
MsgBox "Erreur de connexion à votre base " & vbCrLf & URL_BASE, vbCritical, _
"Echec Connexion"
End Sub
' Permet de définir le mot de passe pour se connecter à la base
Public Sub setPasswordBase(Optional s As String = "") : dbPassWord = s : End Sub
' Permet de définir le chemin d’accès à la base
Public Sub setURLase(Optional s As String = "") : URL_BASE = s : End Sub |
Concrètement,si votre base nécessite un mot depasse, vous devez le définir (uneseule fois durant l’exécution de votre projeten utilisant setPasswordBase.
Par exemple, pour définir le mot de passe 1j2ep9
Call setPasswordBase("1j2ep9")
Dela même façon, vous devez renseigner au moins une fois le chemind’accès complet à la base :c:\base.mdb (une seule fois suffit).
Call setURLase("c:\base.mdb")
Ou alors lors de la première connexion :
Call ConnexionBase("c:\base.mdb")
Vous aurez compris que pour vous connecter à la base, il vous suffit de faire
Call ConnexionBase()
3) Déconnexion
Petitaparté, il existe deux écoles quand à l’ouverture et la fermeture de laconnexion.
- Unepremière méthode consiste à ouvrir la connexion à la base dés lelancement du projet et à la fermer lorsque l’appli se termine.Personnellement, je ne suis pas fan de cette méthode : C’estinutile de laisser la base ouverte lorsque l’on fait rien dessus.
L’intérêt principal de cette méthode et d’économiser le temps de connexion.
- Jepréfères ouvrir la base lorsque les traitements le demandent (ouvrir leplus tard possible) et la fermer en fin de traitement. Bien sûre,inutile d’ouvrir et de fermer la connexion pour chaque requête :pour une série de requêtes autant ouvrir à l’exécution de la premièreet fermer après la dernière.
Avous de choisir votre méthode…
Bon,maintenant comment fermer la connexion, c’est tout simple
Cnx.Close
Jen’ai pas fait de méthode volontairement puisqu’il s’agit d’une ligne àtaper …mais ça serait plus propre de définir une méthode et de placercnx en private (encapsulation des données)
4) Ajouter desdonnées :
A cestade, quelques précisions sont nécessaires sur le formatage desinformations.
a) Les dates :
MSAccess utilise le format américain (mm/dd/yyyy) et il est nécessaired’encadrer les dates par des #. Je vous propose donc pour chaqueutilisation d’une dated’appeler la fonction suivante :
' Convertie une date au format jj/mm/aaaa au format US : mm/jj/aaaa
Public Function DateSQL(ByVal datej As String) As String
Dim jour() As String
Dim poSp As Integer
' Suppression de l'heure si existe
poSp = InStr(1, datej, " ")
If poSp > 0 Then datej = Mid(datej, 1,poSp - 1)
' Mise en forme
jour = Split(datej, "/")
Dim nbVal As Single
nbVal = UBound(jour)
If nbVal = 2 Then
DateSQL = Chr(35) & jour(1) & "/" & jour(0) &"/" & jour(2) & Chr(35)
ElseIf nbVal = 1 Then
DateSQL = Chr(35) & jour(0) & "/01/" & jour(1) &Chr(35)
Else
DateSQL = "#01/01/" & datej & Chr(35)
End If
End Function
|
Elle fait quelques traitements supplémentaires mais devrait vous donner entière satisfaction.
Utilisation :
DateSQL(variableContenantUneDate)
b) Les chaînes de caractères
EnSQL, le simple quotte sert à délimiter les chaînes, il faut doncprotéger les simples quottes au sein de chaîne, par exemple, enremplaçant les simple quotte par deux simples quottes. A cet effet, jevous propose la fonction ci-dessous :
| Function TXTVersSQL(message As String) As String
message = Replace(message,"'", "''")
TXTVersSQL = Chr(39) & message & Chr(39)
End Function
|
Utilisation :
TXTVersSQL("l’écolede l’étang") vas renvoyer "'l''école de l''étang'"
c) Les booléens :
MSAccessmanipule les booléens -1 = Oui et 0 = non. De la même façon, voiciuneméthode qui vous permettra de vous simplifier les traitements :
| Public Function BoolSQL(ByVal bBool As Boolean) As String : BoolSQL = IIf(bBool,"-1", "0") : End Function
|
Utilisation :
BoolSQL(True) 'renvoi donc -1
Pourafficher un Booléen,autant utiliser une méthode qui converti la valeur Access en texte comme parexemple Oui/Non
| Public Function Affich_Bool(ByVal b As Boolean) As String : Affich_Bool= IIf(b, "Oui", "Non"): End Function
|
5) Ajouter unélément dans la base :
Bonmaintenant, nous sommes prêt à insérer un élément : Supposons que vousvoulez ajouter un nom, un date, un booléen.
Soitla table USERS telle que
| USERS |
| id | (numéro auto) |
| nom | (texte) |
| ddn | (date) |
| admin | (booléen) |
La requête SQL s’écrit donc : INSERT INTO USERS (nom, ddn, admin) VALUES ( les valeurs )
Créons la méthode pour ajouter un USER
Public Function ajoutUser(ByVal Mynom as String, ByVal Myddn as Date, ByVal Myadmin as Boolean) As Boolean
Dim sql As String
sql = "INSERT INTO USERS (nom, ddn, admin) VALUES ( "
sql = sql & TXTVersSQL(Mynom) & ", "
sql = sql & DateSQL (Myddn) & ", "
sql = sql & BoolSQL(Myadmin) & ");"
On Error GoTo erreur
Call ConnexionBase
cnx.Execute sql
cnx.Close
ajoutUser = True
Exit Function
erreur:
If cnx.State Then cnx.Close
'Debug.Print sql
ajoutUser = False
End Function |
Aupassage, cette fonction permet de tester si la requête c’est bien passé. Ainsidans votre code,
| If ajoutUser(txtNom.Text, dtpNaiss.Value, chkAdmin.Value = vbChecked) Then
MsgBox "Personne ajoutée", vbInformation, "Succés"
Else
MsgBox "Vérifiez votre saisie",vbInformation, "Echec"
End If
|
Notezque l’id de la personne est automatiquement généré par Access et qu’on n’a pasbesoin de le préciser.
Les requêtes de modifications (UPDATE) de suppressions (DELETE)fonctionnent suivant le même schéma. Je vous renvoi à de ladocumentation en ligne pour toutesinformations relatives à leurssyntaxe.
C’estbien joli, mais supposons que vous ayez besoin de récupérer l’id du dernierélément ajouté.
6) Récupérer desinformations depuis la base :
A cestade, nous allons effectuer une requête de type SELECTafin de récupérer des enregistrements. Ils sont renvoyés sous forme deligne chacune étant découpée en colonne (autant de colonnes que dechamps entre les instructions SELECT et FROM).
L’objetpermettant de récupérer des résultats d’un SELECT est le RecordSet (jeud’enregistrement)
Public Function getLastIDUser(current As client) As Integer
Dim sqlid As String
Dim rs As ADODB.Recordset 'Déclarer le RecordSet
Dim id As Integer
id = 0
sqlid = "SELECT MAX(id) AS LASTID FROM USERS;"
On Error GoTo erreur
Call ConnexionBase
cnx.Execute sql
Set rs = New ADODB.Recordset 'Créer une instance de RecordSet
rs.Open sqlid, cnx, adOpenStatic, adLockReadOnly ' L’ouvrir
id = rs("LASTID") ' Accés à la valeur
rs.Close 'Fermer le RecordSet
Set rs = Nothing 'Libérer la mem. (tout obj avec utilisé avec new doit être libéré avec set .. Nothing)
cnx.Close
getLastIDUser = id
Exit Function
erreur:
If cnx.State Then cnx.Close
getLastIDUser = -1
End Function
|
Et comment faire lorsque l’on a plus d’une ligne à afficher ?
Vous avez une méthode RecordCount quivous permet de connaître le nombre de lignes dans le Recordset.Pour Passer à la ligne suivant, MoveNext est fait pour ça. Voyons ça en pratique, et listons tous les USERS que nous ajoutons à une MSFlexGrid
Public Sub Afficher_Users(flex As MSFlexGrid)
Dim sql As String
Dim rs As ADODB.Recordset
Dim I As Integer, total As Integer
Dim txt As String
sql ="SELECT ID, NOM, DDN, ADMIN " & _
"FROM USERS " & _
"ORDER BY NOM ASC;"
'Debug.Print sql
On Error GoTo erreur
Set rs = New ADODB.Recordset
Call ConnexionBase
rs.Open sql, cnx, adOpenStatic, adLockReadOnly
'Mise en forme de la flex
With flex
.Visible = False
.Rows = 1 'Vider la flex
.Cols = 4
.Row = 0 'Se placer à la premiere ligne
For i = 0 To .Cols - 1
.col = I 'Se balader de colone en colone
Select Case i
Case0:
.Text = "ID"
.ColAlignment(i) = flexAlignLeftCenter
Case 1:
.Text = "Nom"
.ColAlignment(i) = flexAlignLeftCenter
Case 2:
.Text = "DDN"
.ColAlignment(i) = flexAlignLeftCenter
Case 3:
.Text = "Admin"
.ColAlignment(i) = flexAlignLeftCenter
End Select
.CellAlignment = flexAlignCenterCenter
Next i
End With
total = rs.RecordCount
For i = 1 To total
txt =rs("ID") & vbTab
txt = txt& rs("NOM") & vbTab
txt = txt& rs("DDN") & vbTab & Affich_Bool(rs("ADMIN"))
flex.AddItem txt
rs.MoveNext 'Passer à la ligne suivante du Recordset
Next i
rs.Close
Set rs = Nothing
cnx.Close
flex.Visible = total > 0
Exit Sub
erreur:
If cnx.State Then cnx.Close
End Sub
|
Quelquesremarques :
Pourle debug, mieux vaut prévoir un Debug.Print sql.
Ensuite, pour optimiser les traitements, il est préférable de stocker la valeur du rs.RecordCount (puisqu’elleest fixe) plutôt que l’utiliser dans la boucle. En effet, cette secondeméthode est juste mais vous aller faire appel à RecordCount à chaque tour de boucle pour rien et gaspiller du temps processeur.
Lorsquela base contient des valeur nulles (null autorisé) vous risquez avoirun bug.Personnellement, je n’aime pas trop autoriser les valeursnulles. Mais au cas où, vous pouvez protéger la récupération desvaleurs en encadrant tous les rs("..") par rs_to_flexCell(rs(".."))
| Public Function rs_to_flexCell(ByVal s As Variant) As String
rs_to_flexCell= IIf(Not IsNull(s) And s <> "", s, " ")
End Function
|
La boucle for devient alors, si le nom est facultatif
For i = 1 To total
txt = rs("ID") & vbTab
txt = txt& rs_to_flexCell(rs("NOM")) & vbTab
txt = txt& rs("DDN") & vbTab & Affich_Bool(rs("DATES"))
flex.AddItem txt
rs.MoveNext 'Passer à la ligne suivante du Recordset
Next i |
Supposons maintenant que vous vouliez disposez en en-tête de colonne le nom des champs tels qu’ils sont dans la base. Rs.Fields vous permet d’y accéder. Ainsi, la générationdes en-têtes de la flex s’écrit :
Dim nbCol As Integer
nbCol = rs.Fields.Count
'Afficher les Nom des champs dans la flex
.Row = 0
.Cols = nbCol
For i = 0 To nbCol - 1
.Col = i
.Text = rs.Fields(i).Name
.CellAlignment = flexAlignCenterCenter
.ColAlignment(i) = flexAlignLeftCenter
Next i |
Les champs sont affichés dans suivant l’ordre que vous avez défini entre le SELECT etle FROM.
Afficher_Users s’écrit donc
Public Sub Afficher_Users(flex As MSFlexGrid)
Dim sql As String
Dim rs As ADODB.Recordset
Dim i As Integer, total As Integer
Dim txt As String
Dim nbCol As Integer
sql ="SELECT ID, NOM, DDN, ADMIN " & _
"FROM USERS " & _
"ORDER BY NOM ASC;"
'Debug.Print sql
On Error GoTo erreur
Set rs = New ADODB.Recordset
Call ConnexionBase
rs.Open sql, cnx, adOpenStatic, adLockReadOnly
'Mise en forme de la flex
With flex
.Visible = False
.Rows = 1 'Vider la flex
.Cols = 4
'Afficher les Nom des champs dans la flex
.Row = 0
nbCol = rs.Fields.Count
.Cols = nbCol
For i = 0To nbCol - 1
.Col = i
.Text = rs.Fields(i).Name
.CellAlignment = flexAlignCenterCenter
.ColAlignment(i) = flexAlignLeftCenter
Next i
End With
total = rs.RecordCount
For i = 1 To total
txt = rs("ID") & vbTab
txt = txt& rs("NOM") & vbTab
txt = txt& rs("DDN") & vbTab & Affich_Bool(rs("DATES"))
flex.AddItem txt
rs.MoveNext 'Passer à la ligne suivante du Recordset
Next i
rs.Close
Set rs = Nothing
cnx.Close
flex.Visible = total > 0
Exit Sub
erreur:
If cnx.State Then cnx.Close
End Sub
|
7) Trouver le motde passe d’une base MS Access
Vousvoulez autoriser les utilisateurs de votre application à mettre un motde passesur leur base. Je vous propose le code ci-dessous afin de letrouver et de vous connecter facilement (ce code n’est pas de moi maisfonctionne très bien) :
'===========================================
' Récupérer le mot de pass de la base
Function xGetAccessPwd(ByVal FileName As String) As String
Dim n As Long, s1 As String * 1, s2 As String * 1
Dim dbname As String
Dim passw As String
Dim bckPass As String
Dim mask97 As String
Dim mask2k As String
Dim priv As String
Dim priv2 As String
Dim prviput As Boolean
Dim TrebaObavestiti As Boolean
Dim cnn1 As ADODB.Connection
mask97 = Chr(&H4E) & Chr(&H86) & Chr(&HFB) & Chr(&HEC) & _
Chr(&H37) & Chr(&H5D) & Chr(&H44) & Chr(&H9C) & _
Chr(&HFA) & Chr(&HC6) & Chr(&H5E) & Chr(&H28) & _
Chr(&HE6) & Chr(&H13)
mask2k = Chr(&H4E) & Chr(&H99) & Chr(&HEC) & Chr(&H42) &_
Chr(&H9C) & Chr(&HD9) & Chr(&H28) & Chr(&HC) & _
Chr(&H8A) & Chr(&H4B) & Chr(&H7B) & Chr(&HEA) & _
Chr(&HDF) & Chr(&H68) & Chr(&H13) & Chr(&HD0) & _
Chr(&HB1) & Chr(&H2B) & Chr(&H79) & Chr(&H8D) & _
Chr(&H7C)
' set the masking characters
dbname = FileName
passw = ""
Open dbname For Binary As #1 ' open the database
Seek #1,&H42
For n = 1 To21
' actual password recovery module
s1 = Mid(mask2k, n, 1)
s2 = Input(1, 1)
If(Asc(s1) Xor Asc(s2)) <> 0 Then
passw = passw & Chr(Asc(s1) Xor Asc(s2))
End If
If n <> 1 Then s2 = Input(1, 1)
Next
Close 1
prviput = True
TrebaObavestiti = True
If passw = vbNullString Then
' MsgBox "No Password Found"
xGetAccessPwd = passw
Else
Set cnn1= New Connection
cnn1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"DataSource=" & FileName & ";" & _
"Persist Security Info=False" & ";"
On Error Resume Next
'Before we get into rush, let see if there is password
If cnn1.State = adStateClosed Then cnn1.Open
If Err.Number = -2147217843 Then
'this means that password exists
'Debug.Print "password protected..."
Else
If Err.Number = 0 Then
'MsgBox "No Password Found", vbInformation
xGetAccessPwd = ""
End If
End If
Err.Clear
'Lets try open it with masked password in first step,
'this happens very rare
cnn1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"DataSource=" & FileName & ";" & _
"Persist Security Info=False;"& _
"Jet OLEDB:Database Password=" & passw & ";"
s1 = Chr(0)
bckPass = passw
Screen.MousePointer = vbHourglass
On Error GoTo EH
'If I pass thru this that men as that we got password if not
'we'll get into error handling routine
Ifcnn1.State = adStateClosed Then cnn1.Open
Screen.MousePointer = vbDefault
cnn1.Close
Set cnn1= Nothing
' MsgBox "The Password Is: " & passw, vbInformation
xGetAccessPwd = passw
End If
Exit Function
EH:
If Err.Number = -2147467259 Or Err.Number = -2147217805 Then
s1 =Chr(Asc(s1) + 1)
GoToskip1
End If
If Err.Number <> -2147217843 Then 'Not valid password
MsgBox "error: " & Err.Number & ", " & Err.Description, vbCritical
Else
'Watch out this little trick, We will use last character
'from the masked password and
'try to find password, lets xor it
'(this works if password is 18 chars or less)
skip1:
If Asc(s1) = 255 Then
MsgBox "mail ivan@chameleon.co.yu", vbInformation
Exit Function
End If
If prviput Then
s1 =Right(passw, 1)
Else
If TrebaObavestiti Then
MsgBox "Password is more then 18 chars long." & _
" Must use brute force attack!", vbInformation
TrebaObavestiti = False
End If
'We will get here only if password is longer then 18
s1 = Chr |