ACCESS : solution de connexion intégrant la traçabilité et la gestion des utilisateurs

Private Sub Form_Open(Cancel As Integer) 'Récupération identifiant de session Windows de l'utilisateur
  Me.txt_user = Environ$("username")
End Sub

Private Sub Connect() 'Procédure de connexion suivant les critères de validation de la connexion
Dim SQL As String
Dim rs As DAO.Recordset
Static i As Byte
If Len(Me.txt_pass.Value & vbNullString) = 0 Then 'Test complétude zone de texte du mot de passe
  MsgBox "Merci de saisir votre mot de passe pour vous connecter.", vbExclamation, "Connexion"
Else
'Crypte le mot de passe
  Cryp = Crypter(Me.txt_pass.Value)
'Création de variables temporaires
  Application.TempVars.Add "Identuser", Me.txt_user.Value
  Application.TempVars.Add "Mdpuser", Crypter(Me.txt_pass.Value)
End If
'Connexion suivant login/mot de passe
  SQL = "SELECT GROUPE FROM T_USERS WHERE TRIGRAMME = """ & Me.txt_user & """ AND PASWD = """ & Cryp & """;"
Set rs = CurrentDb.OpenRecordset(SQL)
If Not rs.EOF Then
  DoCmd.GoToRecord , , acLast  'Aller au dernier enregistrement du formulaire
  Me.Acconnex = "Ok" 'Récupération info de connexion réussie
  Me.[CONNEXION] = Me.Acconnex 'Inscription du statut de connexion dans T_LOG
  DoCmd.OpenForm "F_APPLICATION", acNormal, , , , acWindowNormal
If Me.txt_pass = Mdef Then 'Repérage mot de passe de première connexion
  MsgBox "Première connexion. Vous devez changer de mot de passe.", vbInformation, "Changement mot de passe"
'Ouverture du formulaire de changement de mot de passe selon l'identifiant et le mot de passe de l'utilisateur
  DoCmd.OpenForm "F_CHGTMDP", , , "[TRIGRAMME] = """ & Me.txt_user & """ and [PASWD] = """ & Cryp & """"
End If
  DoCmd.Close acForm, "F_CONNEXION"
Else
'Réponses aux tentatives de connexion erronées
  i = i + 1
Select Case i
Case 1
  MsgBox "Première Tentative - Attention ! Identifiant et/ou Mot de Passe incorrect(s). À la troisième tentative erronée, fermeture de l'application.", vbExclamation, "Connexion"
Case 2
  MsgBox "Deuxième Tentative - Attention ! Identifiant et/ou Mot de Passe incorrect(s). À la troisième tentative erronée, fermeture de l'application.", vbExclamation, "Connexion"
Case 3
  DoCmd.GoToRecord , , acLast 'Aller au dernier enregistrement du formulaire
  Me.Acconnex = "Echec" 'Récupération info d'échec de connexion
  Me.[CONNEXION] = Me.Acconnex 'Inscription du statut de connexion dans T_LOG
  MsgBox "Troisième Tentative - Fermeture de l'application. Vous avez dépassé le nombre de tentatives autorisées.", vbCritical, "Connexion"
  DoCmd.Quit
End Select
End If
'Libération de la variable objet
  rs.Close
Set rs = Nothing
End Sub

Private Sub Connex_Click() 'Appel de la procédure de connexion
  Connect
End Sub

Private Sub Entr() 'Procédure de connexion avec la touche Entrée
  Connex.SetFocus
  Connex_Click
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) 'Connexion avec la touche Entrée
If KeyCode = vbKeyReturn Then
  Entr
End If
End Sub

Private Sub Annulcon_Click() 'Annulation connexion
  Me.Acconnex = "Annulé" 'Récupération de l'info d'annulation
  DoCmd.Quit
End Sub

Public Function getMyIP() 'Fontion récupération de l'adresse IP
Dim myWMI As Object, myObj As Object, Itm
Set myWMI = GetObject("winmgmts:\\.\root\cimv2")
Set myObj = myWMI.ExecQuery("SELECT IPAddress FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
For Each Itm In myObj
  getMyIP = Itm.IPAddress(0)
Exit Function
Next
End Function

Private Sub Form_Load() 'Alimentation table des logs de connexion
'Récupération des éléments et inscription dans T_LOG
  Me.[UTILISATEUR] = Me.txt_user 'Identifiant
  Me.[ORDINATEUR] = Environ$("ComputerName") 'PC
  Me.[DATE_UTILISATION] = Now() 'Date
  Me.[ADRESSE_IP] = getMyIP 'Adresse IP
End Sub

Private Sub Chgtmdp_Click() 'Ouverture du formulaire de changement de mot de passe selon l'identifiant et le mot de passe de l'utilisateur
  DoCmd.OpenForm "F_CHGTMDP", , , "[TRIGRAMME] = """ & Me.Identuser & """ and [PASWD] = """ & Me.Mdpuser & """"
End Sub

Private Sub Charginfo() 'Procédure de chargement conditionnel du formulaire et information
Dim Rep As Integer
  Cryp = Crypter(Mdef) 'Le mot de passe par défaut(azerty123)est crypté
If Mdpchgt = Cryp Then
  Annulchgt.Visible = False 'Le bouton Annuler est invisible
End If
  Rep = MsgBox("Le mot de passe doit être composé d'au moins 9 caractères.", vbInformation, "Changement mot de passe")
If Rep = vbOK Then 'Effacement zone de texte du mot de passe pour une nouvelle saisie
  Me.Mdpchgt = ""
End If
End Sub

Private Sub Form_Load() 'Chargement conditionnel du formulaire et information
  Charginfo
End Sub

Private Sub Valnmdp() 'Procédure changement mot de passe
Dim SQL As String
Dim rs As DAO.Recordset
Select Case True 'Test des conditions de validité du mot de passe
'Test longueur du mot de passe
Case Len(Me.Mdpchgt.Value & vbNullString) = 0 Or Len(Me.Mdpchgt) < 9
  MsgBox "Attention ! Le mot de passe doit être composé d'au moins 9 caractères.", vbExclamation, "Changement mot de passe"
'Test présence de la confirmation
Case Len(Me.Mdpconf.Value & vbNullString) = 0
  MsgBox "Attention ! Merci de confirmer votre mot de passe.", vbExclamation, "Changement mot de passe"
'Test confirmation du mot de passe
Case Me.Mdpconf <> Me.Mdpchgt
  MsgBox "Attention ! Confirmation différente du mot de passe.", vbExclamation, "Changement mot de passe"
'Test non-réutilisation du mot de passe de première connexion
Case Else
'Crypte le mot de passe
  Cryp = Crypter(Me.Mdpchgt.Value)
'Test non-réutilisation du mot de passe par défaut
If Me.Mdpchgt.Value = Mdef Then
  MsgBox "Attention ! Mot de passe non autorisé. Merci de le changer.", vbExclamation, "Changement mot de passe"
Else
'Test non-utilisation du mot de passe de l'utilisateur pour un autre de ses profils
  SQL = "SELECT PASWD FROM T_USERS WHERE TRIGRAMME = """ & Me.Identchgt & """ AND PASWD = """ & Cryp & """;"
Set rs = CurrentDb.OpenRecordset(SQL)
If Not rs.EOF Then
  MsgBox "Attention ! Mot de passe déjà utilisé dans un autre de vos profils. Veuillez en utiliser un autre.", vbExclamation, "Changement mot de passe"
Else
'Validation changement mot de passe
  Me.Chgtident.Value = Me.Identchgt.Value
  Me.Chgtmdp.Value = Cryp
  Form_F_APPLICATION.Mdpuser = Me.Chgtmdp
  MsgBox "Changement de mot de passe réussi.", vbInformation, "Changement mot de passe"
  DoCmd.Close acForm, "F_CHGTMDP"
End If
'Libération de la variable objet
  rs.Close
Set rs = Nothing
End If
End Select
End Sub

Private Sub Validchgt_Click() 'Changement mot de passe
  Valnmdp
End Sub

Private Sub Entr() 'Procédure de validation avec la touche Entrée
  Validchgt.SetFocus
  Validchgt_Click
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) 'Validation du changement avec la touche Entrée
If KeyCode = vbKeyReturn Then
  Entr
End If
End Sub

Private Sub Creat() 'Procédure de création d'un utilisateur
Dim SQL1 As String
Dim SQL2 As String
Dim SQL3 As String
Dim rs As DAO.Recordset
Dim rst As DAO.Recordset
Select Case True
'Test présence de l'identifiant
Case Len(Me.Identnouv.Value & vbNullString) = 0
  MsgBox "Attention ! Identifiant requis.", vbExclamation, "Création utilisateurs"
'Test présence du nom
Case Len(Me.Nomnouv.Value & vbNullString) = 0
  MsgBox "Attention ! Nom requis.", vbExclamation, "Création utilisateurs"
'Test présence du prénom
Case Len(Me.Prenouv.Value & vbNullString) = 0
  MsgBox "Attention ! Prénom requis.", vbExclamation, "Création utilisateurs"
'Test présence et longueur du mot de passe
Case Len(Me.Mdpnouv.Value & vbNullString) = 0 Or Len(Me.Mdpnouv) < 9
  MsgBox "Attention ! Le mot de passe doit être composé d'au moins 9 caractères.", vbExclamation, "Création utilisateurs"
Case Else
'Test non-présence de l'utilisateur dans le groupe sélectionné
  SQL1 = "SELECT GROUPE FROM T_USERS WHERE TRIGRAMME = """ & Me.Identnouv & """ AND GROUPE = '" & Me.Gpenouv & "';"
Set rs = CurrentDb.OpenRecordset(SQL1)
If Not rs.EOF Then
  MsgBox "Attention ! Utilisateur déjà présent dans ce groupe.", vbExclamation, "Création utilisateurs"
Else
'Crypte le mot de passe
  Cryp = Crypter(Mdpnouv.Value)
'Test non-utilisation du mot de passe pour un autre profil de l'utilisateur
  SQL2 = "SELECT PASWD FROM T_USERS WHERE TRIGRAMME = """ & Me.Identnouv & """ AND PASWD = '" & Cryp & "';"
Set rst = CurrentDb.OpenRecordset(SQL2)
If Not rst.EOF Then
  MsgBox "Attention ! Mot de passe déjà utilisé dans un autre profil de cet utilisateur. Veuillez en utiliser un autre.", vbExclamation, "Création utilisateurs"
Else
'Validation création après confirmation du statut et du mot de passe de l'utilisateur
  SQL3 = "INSERT INTO T_USERS (TRIGRAMME,NOM_UTIL,PRENOM,GROUPE,PASWD) VALUES (""" & Me.Identnouv & """,""" & Me.Nomnouv & """,""" & Me.Prenouv & """,""" & Me.Gpenouv & """, '" & Cryp & "');"
  CurrentDb.Execute SQL3, dbFailOnError
  MsgBox "Création utilisateur réussie.", vbInformation, "Création utilisateurs"
  DoCmd.OpenForm "F_GESTUTIL", acNormal, , , , acWindowNormal
  DoCmd.Close acForm, "F_GESTNOUV"
End If
'Libération de la variable objet
  rst.Close
Set rst = Nothing
End If
'Libération de la variable objet
  rs.Close
Set rs = Nothing
End Select
End Sub

Private Sub Creanouv_Click() 'Création de l'utilisateur
  Creat
End Sub

Private Sub Entr() 'Procédure de validation avec la touche Entrée
  Creanouv.SetFocus
  Creanouv_Click
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) 'Validation création de l'utilisateur avec la touche Entrée
If KeyCode = vbKeyReturn Then
  Entr
End If
End Sub

Private Sub Mdpdef_Click() 'Attribution du mot de passe par défaut
  Me.Mdpnouv = Mdef
  MsgBox "Mot de passe par défaut attribué.", vbInformation, "Création utilisateurs"
End Sub

Private Sub Modident() 'Procédure de modification de l'identifiant
Dim SQL2 As String
Dim rst As DAO.Recordset
'Test présence d'un identifiant
If Len(Me.Identmod.Value & vbNullString) = 0 Then
  MsgBox "Attention ! Identifiant requis. Le champ modifié est remis à sa valeur initiale.", vbExclamation, "Modification utilisateurs"
  Me.Identmod = Me.Identcopie
Else
'Test non-présence de l'utilisateur dans le groupe
  SQL2 = "SELECT TRIGRAMME FROM T_USERS WHERE TRIGRAMME = """ & Me.Identmod & """ AND GROUPE = '" & Me.Gpemod & "';"
Set rst = CurrentDb.OpenRecordset(SQL2)
If Not rst.EOF Then
  MsgBox "Attention ! Utilisateur déjà présent dans ce groupe. Le champ modifié est remis à sa valeur initiale.", vbExclamation, "Modification utilisateurs"
  Me.Identmod = Me.Identcopie
End If
'Libération de la variable objet
  rst.Close
Set rst = Nothing
End If
End Sub

Private Sub Identmod_AfterUpdate() 'Modification identifiant
  Modident
End Sub

Private Sub Nommod_AfterUpdate() 'Modification nom
'Test présence du nom
If Len(Me.Nommod.Value & vbNullString) = 0 Then
  MsgBox "Attention ! Nom requis. Le champ modifié est remis à sa valeur initiale.", vbExclamation, "Modification utilisateurs"
  Me.Nommod = Me.Nomcopie
End If
End Sub

Private Sub Premod_AfterUpdate() 'Modification prénom
'Test présence du prénom
If Len(Me.Premod.Value & vbNullString) = 0 Then
  MsgBox "Attention ! Prénom requis. Le champ modifié est remis à sa valeur initiale.", vbExclamation, "Modification utilisateurs"
  Me.Premod = Me.Precopie
End If
End Sub

Private Sub Modstat() 'Procédure de modification du statut utilisateur
Dim SQL1 As String
Dim rs As DAO.Recordset
'Test non-présence de l'utilisateur dans le groupe sélectionné
  SQL1 = "SELECT GROUPE FROM T_USERS WHERE TRIGRAMME = """ & Me.Identmod & """ AND GROUPE = '" & Me.Gpemod & "';"
Set rs = CurrentDb.OpenRecordset(SQL1)
If Not rs.EOF Then
  MsgBox "Attention ! Utilisateur déjà présent dans ce groupe. Le champ modifié est remis à sa valeur initiale.", vbExclamation, "Modification utilisateurs"
  Me.Gpemod = Me.Gpecopie
End If
'Libération de la variable objet
  rs.Close
Set rs = Nothing
End Sub

Private Sub Gpemod_Change() 'Modification statut utilisateur
  Modstat
End Sub

Private Sub Modmdp() 'Procédure de modification du mot de passe
Dim SQL3 As String
Dim rsu As DAO.Recordset
Select Case True
'Test longueur du mot de passe
Case Len(Me.Mdpmod.Value & vbNullString) = 0 Or Len(Me.Mdpmod) < 9
  MsgBox "Attention ! Le mot de passe doit être composé d'au moins 9 caractères. Le champ modifié est remis à sa valeur initiale.", vbExclamation, "Modification utilisateurs"
  Me.Mdpmod = Me.Mdpcopie
Case Len(Me.Mdpmod) >= 9 And Me.Mdpmod <> Me.Mdpcopie
'Crypte le mot de passe
  Cryp = Crypter(Mdpmod.Value)
'Le mot de passe prend sa valeur cryptée
  Me.Mdpmod = Cryp
'Test non-utilisation du mot de passe dans un autre profil
  SQL3 = "SELECT PASWD FROM T_USERS WHERE TRIGRAMME = """ & Me.Identmod & """ AND PASWD = '" & Cryp & "';"
Set rsu = CurrentDb.OpenRecordset(SQL3)
If Not rsu.EOF Then
  MsgBox "Attention ! Mot de passe déjà utilisé dans un autre profil de cet utilisateur. Veuillez en utiliser un autre. Le champ modifié est remis à sa valeur initiale.", vbExclamation, "Modification utilisateurs"
  Me.Mdpmod = Me.Mdpcopie
End If
'Libération de la variable objet
  rsu.Close
Set rsu = Nothing
End Select
End Sub

Private Sub Mdpmod_AfterUpdate() 'Modification mot de passe
  Modmdp
End Sub

Private Sub Initmdp() 'Procédure de réinitialisation du mot de passe
  Me.Mdpmod = Mdef
  MsgBox "Mot de passe par défaut attribué.", vbInformation, "Modification utilisateurs"
  Modmdp
End Sub

Private Sub Mdpinit_Click() 'Attribution mot de passe par défaut
  Initmdp
End Sub

Private Sub Modif() 'Procédure de validation des modifications
Dim SQL4 As String
  SQL4 = "UPDATE T_USERS SET TRIGRAMME = """ & Me.Identmod & """, NOM_UTIL = """ & Me.Nommod & """, PRENOM = """ & Me.Premod & """, GROUPE = '" & Me.Gpemod & "', PASWD = '" & Me.Mdpmod & "' WHERE ID = " & Me.IDmod & ";"
  CurrentDb.Execute SQL4, dbFailOnError
  MsgBox "Modification utilisateur réussie.", vbInformation, "Modification utilisateurs"
  Forms!F_GESTUTIL.Refresh 'Rafraîchissement formulaire de gestion des utilisateurs
  DoCmd.Close acForm, "F_GESTMOD"
End Sub

Private Sub Valmod_Click() 'Validation modifications des champs
  Modif
End Sub

Private Sub Entr() 'Procédure de validation avec la touche Entrée
  Valmod.SetFocus
  Valmod_Click
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) 'Validation modifications avec la touche Entrée
If KeyCode = vbKeyReturn Then
  Entr
End If
End Sub

Private Sub Form_Close() 'Remettre en avant le formulaire de gestion des utilisateurs
Forms!F_GESTUTIL.SetFocus
End Sub

Private Sub Suppr() 'Procédure de suppression d'un utilisateur
Dim SQL As String
Dim Rep As Integer
  Rep = MsgBox("Confirmez-vous la suppression de cet utilisateur ?", vbYesNo + vbQuestion, "Suppression utilisateurs")
If Rep = vbYes Then
  SQL = "DELETE FROM T_USERS WHERE TRIGRAMME = """ & Me.Identsup & """ AND GROUPE = '" & Me.Gpesup & "' AND PASWD = '" & Me.Mdpsup & "';"
  CurrentDb.Execute (SQL)
  MsgBox "Suppression utilisateur réussie.", vbInformation, "Suppression utilisateurs"
  Forms!F_GESTUTIL.Refresh 'Rafraîchissement formulaire de gestion des utilisateurs
  DoCmd.Close acForm, "F_GESTSUP"
Else
  DoCmd.Close acForm, "F_GESTSUP"
End If
End Sub

Private Sub Valsup_Click() 'Suppression de l'utilisateur
  Suppr
End Sub

Private Sub Entr() 'Procédure de validation avec la touche Entrée
  Valsup.SetFocus
  Valsup_Click
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) 'Validation suppression de l'utilisateur avec la touche Entrée
If KeyCode = vbKeyReturn Then
  Entr
End If
End Sub

Private Sub Form_Close() 'Remettre en avant le formulaire de gestion des utilisateurs
  Forms!F_GESTUTIL.SetFocus
End Sub

Private Sub Connect() 'Procédure de connexion suivant les critères de validation de la connexion
Dim SQL As String
Dim rs As DAO.Recordset
Static i As Byte
If Len(Me.txt_pass.Value & vbNullString) = 0 Then 'Test complétude de la zone de texte du mot de passe
  MsgBox "Merci de saisir votre mot de passe pour vous connecter.", vbExclamation, "Connexion"
Else
'Crypte le mot de passe
  Cryp = Crypter(Me.txt_pass.Value)
'Création de variables temporaires
  Application.TempVars.Add "Identuser", Me.txt_user.Value
  Application.TempVars.Add "Mdpuser", Crypter(Me.txt_pass.Value)
End If
'Connexion suivant login/mot de passe
  SQL = "SELECT GROUPE FROM T_USERS WHERE TRIGRAMME = """ & Me.txt_user & """ AND PASWD = """ & Cryp & """;"
Set rs = CurrentDb.OpenRecordset(SQL)
If Not rs.EOF Then
  DoCmd.GoToRecord , , acLast  'Aller au dernier enregistrement du formulaire
  Me.Acconnex = "Ok" 'Récupération info de connexion réussie
  Me.[CONNEXION] = Me.Acconnex 'Inscription du statut de connexion dans T_LOG
  DoCmd.OpenForm "F_APPLICATION", acNormal, , , , acWindowNormal
'Autorisation menu contextuel sur F_APPLICATION pour un administrateur
If rs!GROUPE = "Administrateur" Then
  Forms!F_APPLICATION.ShortcutMenu = True
End If
If Me.txt_pass = Mdef Then 'Repérage mot de passe de première connexion
  MsgBox "Première connexion. Vous devez changer de mot de passe.", vbInformation, "Changement mot de passe"
'Ouverture du formulaire de changement de mot de passe selon l'identifiant et le mot de passe de l'utilisateur
  DoCmd.OpenForm "F_CHGTMDP", , , "[TRIGRAMME] = """ & Me.txt_user & """ and [PASWD] = """ & Cryp & """"
End If
  DoCmd.Close acForm, "F_CONNEXION"
Else
'Réponses aux tentatives de connexion erronées
  i = i + 1
Select Case i
Case 1
  MsgBox "Première Tentative - Attention ! Identifiant et/ou Mot de Passe incorrect(s). À la troisième tentative erronée, fermeture de l'application.", vbExclamation, "Connexion"
Case 2
  MsgBox "Deuxième Tentative - Attention ! Identifiant et/ou Mot de Passe incorrect(s). À la troisième tentative erronée, fermeture de l'application.", vbExclamation, "Connexion"
Case 3
  DoCmd.GoToRecord , , acLast 'Aller au dernier enregistrement du formulaire
  Me.Acconnex = "Echec" 'Récupération info d'échec de connexion
  Me.[CONNEXION] = Me.Acconnex 'Inscription du statut de connexion dans T_LOG
  MsgBox "Troisième Tentative - Fermeture de l'application. Vous avez dépassé le nombre de tentatives autorisées.", vbCritical, "Connexion"
  DoCmd.Quit
End Select
End If
'Libération de la variable objet
  rs.Close
Set rs = Nothing
End Sub

Private Sub Changemdp() 'Procédure d'ouverture du formulaire de changement de mot de passe selon identifiant et mot de passe + menu contextuel
  'DoCmd.OpenForm "F_CHGTMDP", , , "[TRIGRAMME] = """ & Me.Identuser & """ and [PASWD] = """ & Me.Mdpuser & """"
'Autorisation menu contextuel sur F_CHGTMDP pour un administrateur
'If Me!Gestutil.Visible = True Then
  'Forms!F_CHGTMDP.ShortcutMenu = True
'End If
End Sub

Private Sub Chgtmdp_Click() 'Ouverture du formulaire de changement de mot de passe selon l'identifiant et le mot de passe de l'utilisateur
  Changemdp
End Sub