Sécurité en VBA a travers formulaire [Résolu]

[gwendk]

Salut a tous,

J'ai parcouru, FAQ, forum et Google, mais je n'arrive pa a trouver de tuto correct. Je créer donc une BD pour une entreprise ( trés novice en informatique) je passe donc tout a travers les formulaires.

Alors j'ai déjà trouvé le code pour ajouter un nouvel utilisateur

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Function adhCreateUser(ByVal strName As String, ByVal strPID As String, ByVal strPW As String) As Boolean 
'Création d'un nouvel utilisateur 
  'Input: 
  '   strName: nom d'usager 
  '   strPID: N° d'identification personnel 
  '   strPW: mot de passe 
  'Output: 
  '   Vrai si réeussie, faux si échoué 
  On Error GoTo adhCreateUserErr 
  Dim wrk As Workspace 
  Dim usrNew As User 
  Dim strMsg As String 
  Const adhcProcName = "adhCreateUser" 
  adhCreateUser = False 
  Set wrk = DBEngine.Workspaces(0) 
'Création du nouvel usager et ajout dans le groupe de travail courant 
  Set usrNew = wrk.CreateUser(me!name, sme!pid, me!pw) 
  wrk.Users.Append usrNew 
'Ajout de l'usager dans le groupe des utilisateurs 
  'Ce groupe est obligatoire pour tout usager dand Access 
  usrNew.Groups.Append wrk.CreateGroup("Users") 
  adhCreateUser = True 
adhCreateUserDone: 
  On Error GoTo 0 
  Exit Function 
adhCreateUserErr: 
  Select Case err 
      Case adhcErrAccntAlreadyExists 
          strMsg = "Un compte avec le nom '" & strName & "' existe déjà." 
      Case adhcErrBadPid 
          strMsg = "Vous devez entrer un ID entre 4 " & "et 20 caractères." 
      Case adhcErrNoPermission 
          strMsg = "Vous n'avez pas l'autorisation pour exécuter cette opération." 
      Case Else 
          strMsg = "Erreur " & err.Number & ": " & err.Description 
  End Select 
  MsgBox strMsg, vbCritical + vbOKOnly, "Procedure " & adhcProcName 
  Resume adhCreateUserDone 
End Function

Le code pour modifier le mot de passe

Code :

1
2
3
4
 
With DBEngine.Workspaces(0)
.Users(.UserName).NewPassword "ancien", "nouveau"
End With

Et maintenant, je voudrais affecter mon utilisateur a un groupe, le choix se ferait dans une liste déroulante.
Mais je ne sais pas comment faire !!

Avez-vous la solution ou peut-étre connaissez vous un site qui montreré comment faire toutes ces manip formulaire VBA (changer de groupe un utilisateur, changer pass, nouvelle utilisateur, supprimer ....)

Merci

[Tofalu]

Il suffit d'ajouter l'utilisateur au groupe choisit ou bien d'ajouter le groupe à l'utilisateur. Un exemple

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Public Sub CreerUtilisateurDAO()
Dim oWs As DAO.Workspace
Dim oUsr As DAO.User
Dim strPid As StringDim strNom As String
Dim strPasse As String
'Définit le nomstrNom = "Utilisateur_essai"
'Définit le PID (Identifiant unique)
strPid = Format(Now(), "yyyymmddhhnnss")
'Définit le mot de passe
strPasse = "password"
'Récupère l'espace de travail
Set oWs = DBEngine.Workspaces(0)
'Crée le nouvel utilisateur
Set oUsr = oWs.CreateUser(strNom, strPid, strPasse)
'Ajoute l'utilisateur à la collection Users
oWs.Users.Append oUsr
'Ajoute l'utilisateur au groupe Admins
oWs.Groups("Admins").Users.Append oWs.CreateUser(strNom)
End Sub

On aurait pu avoir aussi dans l'autre sens :

Code :

oUsr.Groups.Append oWs.CreateGroup("Admins")

Et pour le plaisir : l'équivalent en ADO

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Public Sub CreerUtilisateurADO()
Dim oCat As ADOX.Catalog
Dim oUsr As ADOX.User
Dim strNom As String
Dim strPasse As String
'Définit le nomstrNom = "Utilisateur1000"
'Définit le mot de passestrPasse = "password"
'Instancie un nouvel objet catalogue
Set oCat = New ADOX.Catalog
With oCat 
Set .ActiveConnection = CurrentProject.Connection 
'Crée le nouvel utilisateur 
.Users.Append strNom, strPasse 
'Ajoute l'utilisateur au groupe Admins 
.Groups("Admins").Users.Append strNom
End With
End Sub

[Maxence HUBICHE]

J'ai pas ca sous la main, mais, si tu me donnes une petite heure, je te fais tout ça !
Ca te va ?

[gwendk]

ah ok merci ça fonctionne,
enfait je pensais que le fait de mettre "create" voulais dire qu'on allais créer un nouveau groupe, alor que moi je voulais simplement affecter a un groupe existant.

Et pour afficher le groupe au quel un utilisateur est affecter ?
J'ai essayer la propriete Name (group.Name ) mais je n'arrive pas a l'utiliser !
Je ne sais pas ou il faut le mettre, J'aimerais que cela s'affiche dans une zone de texte. J'ai donc essayer de mettre ça dans la zone de controle mais non ça n'affiche rien.

Merci

[gwendk]

Envoyé par Maxence HUBICHE

J'ai pas ca sous la main, mais, si tu me donnes une petite heure, je te fais tout ça !
Ca te va ?

J'accepte toute les propositions moi , j'ai encore plein de truc a faire avec cette sécurité lol !

[Tofalu]

Envoyé par gwendk

ah ok merci ça fonctionne,
enfait je pensais que le fait de mettre "create" voulais dire qu'on allais créer un nouveau groupe, alor que moi je voulais simplement affecter a un groupe existant.

Et pour afficher le groupe au quel un utilisateur est affecter ?
J'ai essayer la propriete Name (group.Name ) mais je n'arrive pas a l'utiliser !
Je ne sais pas ou il faut le mettre, J'aimerais que cela s'affiche dans une zone de texte. J'ai donc essayer de mettre ça dans la zone de controle mais non ça n'affiche rien.

Merci

Voici un exmple de procédure permettant d'afficher les noms des groupes auxquels appartient l'utilisateur passé en paramètre.


Important : Pour que ce code fonctionne vous devez ajouter la référence Microsoft DAO 3.X Object Library.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Public Sub ListerGroupeUtilisateurDAO(strNomUtilisateur As String)
On Error GoTo err
Dim oWs As DAO.Workspace
Dim oGrp As DAO.Group
Dim oUsr As DAO.User
Dim strMessageErreur As String
'Récupère l'espace de travail
Set oWs = DBEngine.Workspaces(0)
'Récupère le groupe
Set oUsr = oWs.Users(strNomUtilisateur)
'Parcours les utilisateurs du groupe
For Each oGrp In oUsr.Groups
    'Affiche leur nom
    MsgBox oGrp.Name
Next oGrp
fin:
Exit Sub
err:
Select Case err.Number
    Case 3265
        strMessageErreur = "Cet utilisateur n'existe pas"
    Case Else
        strMessageErreur = "Erreur inconnue"
End Select
MsgBox strMessageErreur, vbCritical, "Erreur"
Resume fin
End Sub

[Maxence HUBICHE]

Bon, désolé pour le timing, mais, un certain tofalu m'a intercepté apr MSN, et ensuite, j'avais plus le temps.
Je m'y suis donc remis ce soir ...
Donc, voici 3 fichiers.
Ceux en V2000 et V2003 fonctionnent très bien.
Celui en V97 n'a pas été testé. Donc, si on pouvait m'en parler rapidement, ce serait cool.

Je pense que tu trouveras toutes les fonctions de base.

Pour coder ça proprement, j'ai tout mis dans une classe.
Voilà voilà !

Bonne lecture et bonne application !

[Tofalu]

Bon, désolé pour le timing, mais, un certain tofalu m'a intercepté apr MSN, et ensuite, j'avais plus le temps.
Je m'y suis donc remis ce soir ...

[gwendk]

Envoyé par Maxence HUBICHE

Bon, désolé pour le timing, mais, un certain tofalu m'a intercepté apr MSN, et ensuite, j'avais plus le temps.
Je m'y suis donc remis ce soir ...
Donc, voici 3 fichiers.
Ceux en V2000 et V2003 fonctionnent très bien.
Celui en V97 n'a pas été testé. Donc, si on pouvait m'en parler rapidement, ce serait cool.

Je pense que tu trouveras toutes les fonctions de base.

Pour coder ça proprement, j'ai tout mis dans une classe.
Voilà voilà !

Bonne lecture et bonne application !

vraiment trés bien fait ton formulaire, et tout fonctionne trés bien !!!

Merci beaucoup, me reste plus qu'a lire tout ça !!!

[Mike1979]

J'ai voulu tester le formulaire de Maxence HUBICHE dans une base deja securisé. lors de l'execution de ce formulaire une erreur d'execution '13' s'affiche avec une incompatibilite de type. avec le debogueur, j'arrive sur cette partie de commande:
Private Sub RemplirLesListes()
lstUsers.RowSource = SECURITE.ListerUsers(mh_SecurMethodListingString)
lstGroups.RowSource = SECURITE.ListerGroups(mh_SecurMethodListingString)
lstGroups2.RowSource = lstGroups.RowSource
cboUsers.RowSource = lstUsers.RowSource
End Sub
avec en jaune :
lstUsers.RowSource = SECURITE.ListerUsers(mh_SecurMethodListingString). d'ou peu provenir l'erreur?

merci de votre reponse

[FRED.G]

mh_SecurMethodListingString est énumération qui n'a pas été déclarée ou dont la visibilité échappe au module duquel est extrait ton code.

Enfin c'est mon hypothèse. Donc a priori, rien à voir avec le fait que la base soit déjà sécurisée ou non.

D'ailleurs ça doit planter rien qu'à l'exécution, non ? (si tu as Option Explicit dans tes modules VBA)


Plus sérieusement (et blague à part), il faut se méfier des constantes débutant par mh_ car sous l'apparence sophistiquée de l'anglais et de la pseudo normalisation due à l'underscore, se cache l'arbitraire incontrôlé d'un génie douteux.


(mouarf)

[Mike1979]

Le code fournis fonctionne tres bien quand il n'y as pas de fichier groupe de travail (system.mdw). Par contre, lorsque la base est securisée par ce fichier l'erreur s'affiche.