Problème d'authentification avec vb6

Version imprimable

Bonjour,
J'ai un petit problème au niveau de l'interface de l'authentification des utilisateurs dans mon application vb6
J'ai une table MFT_AR_ROLE qui contient les rôles des utilisateurs et sa structure comme suit
Pour chaque utilisateur ajouter il aura dans la table MFT_AR_ROLE les privilèges d'accès à l'application (par défaut quelque privilèges actifs et les autres sont inactifs)
RO_ID (identifiant unique)
RO_FRMLABEL (le nom de la form ou le menu)
RO_US_ID (l'identifiant de l'utilisateur)
RO_ETAT (l'état du privilège actif ou non: 0 ou 1)
J'ai une interface d'authentification, dans cette interface lorsque l'utilisateur saisie son login et mot de passe et après la vérification de leurs validité j'ai ajouté un Recordset qui lit de la table MFT_AR_ROLE le privilèges de l'utilisateur en question et selon l'état de chaque privilège il l'active ou non
Par exemple si j'ai un menu mnuclient son etat est 0 donc l'Enabled de ce menu sera False
voila le code mais j'ai un message d'erreur "Utilisation incorrecte de la propriété" au niveau de cette ligne
"frmprincipal "." & txt & "." & Enabled = False"
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 40 41 42 Private Sub cmdok_Click() Dim txt Dim txt1 Call ConnectDB Set rs = New Recordset Set rs1 = New Recordset Dim AES As New CRijndael 'txtCrypté = AES.JustCrypter(txtmotdepasse.Text, txtmotdepasse) 'MsgBox txtCrypté rs.Open "select * from MFT_AR_USERS where US_LOGIN='" & txtlogin.Text & "' and US_PWD= '" & AES.JustCrypter(txtmotdepasse.Text) & "'", db, adOpenDynamic, adLockOptimistic 'txtDécrypté = AES.JustDécrypter(rs!US_PWD) 'MsgBox txtDécrypté 'If txtmotdepasse.Text = txtDécrypté Then If rs.RecordCount = 1 Then txtid.Text = rs!US_ID frmprincipal.stbprincipal.Panels.Item(3).Text = rs!US_NAME frmprincipal.stbprincipal.Panels.Item(4).Text = rs!US_ID frmprincipal.Show frmprincipal.Enabled = True rs1.Open "select * from mft_ar_role where ro_us_id='" & rs!US_ID & "' and ro_etat=0", db, adOpenDynamic, adLockOptimistic rs1.MoveFirst Do While Not rs1.EOF txt = rs1!RO_FRMLABEL 'MsgBox txt frmprincipal "." & txt & "." & Enabled = False 'MsgBox txt1 'txt1 = False 'MsgBox txt1 'frmprincipal.mnuclient.Enabled = False rs1.MoveNext Loop Unload Me Else If MsgBox("Login ou mot de passe incorrêcte ", vbCritical + vbYesNo, "Erreur:") = vbNo Then End End If txtlogin.Text = "" txtmotdepasse.Text = "" txtlogin.SetFocus End If End Sub
Merci d'avance

27/07/2010, 12h37
ProgElecT
Citation:

frmprincipal "." & txt & "." & Enabled = False

txt dans ton cas est une variable String, pas le composant, pour y parvenir tout de même il faut parcourir tout les TextBoxs de ton frmprincipal en y recherchant le composant qui a pour Name = Txt
Code:

1 2 3 4 5 6 7 Dim ObjTxt As TextBox Dim Txt As String 'Txt = rs1!RO_FRMLABEL Txt = "Text1" For Each ObjTxt In frmprincipal If ObjTxt.Name = Txt Then ObjTxt.Enabled = False: Exit For Next
27/07/2010, 12h44
bargougui86
Citation:
Envoyé par ProgElecT

txt dans ton cas est une variable String, pas le composant, pour y parvenir tout de même il faut parcourir tout les TextBoxs de ton frmprincipal en y recherchant le composant qui a pour Name = Txt

Code:

1 2 3 4 5 6 7 Dim ObjTxt As TextBox Dim Txt As String 'Txt = rs1!RO_FRMLABEL Txt = "Text1" For Each ObjTxt In frmprincipal If ObjTxt.Name = Txt Then ObjTxt.Enabled = False: Exit For Next
txt c'est une simple variable et n'a aucun rapport avec les composant, en outre frmprincipal contient que le menu principal et cette variable txt contient le nom du composant qui est sauvegarder dans la table MFT_AR_ROLE c'est à dire qu'elle peut contenir le nom d'un menu ou sous menu ou un bouton tous dépend du privilège et la form qui contient ce privilège
27/07/2010, 12h54
ProgElecT

Code:

Dim ObjTxt As Object

;)
27/07/2010, 12h58
bargougui86

Citation:

Envoyé par ProgElecT

Code:

Dim ObjTxt As Object

;)

Grand merciiiiiiiiiiiiiiiiiiiiiiiiiiii :)

Si besoin, Il te reste à prévoir les objets indexés

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Dim Obj As Object
Dim Idx As Integer
Dim Txt As String
'Txt = rs1!RO_FRMLABEL
'ObjIdx = rs1!RO_FRMLABEL_Idx '-1 = pas d'index
Txt = "Text1"
Idx = 3
For Each Obj In frmprincipal
 If Obj.Name = Txt Then
    If Idx <> -1 Then
        If Obj.Index = Idx Then
            Obj.Enabled = False: Exit For
        End If
    End If
 End If
Next

27/07/2010, 13h15
bargougui86

Citation:

Envoyé par bargougui86

Grand merciiiiiiiiiiiiiiiiiiiiiiiiiiii :)

J'ai trouvé un autre problème j'ai des boutons dans d'autre form et non pas dans le frmprincipal, par exemple j'ai le bouton cmdfacturer dans la form frmfacturetemp j'ai désactiver le privilège de ce bouton (son état = 0) mais son Enabled n'a pas changer dans l'interface il est toujours actif

La derniere, je suis en retard sur le travail

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
Dim ObjFrm As Form
Dim Obj As Object
 
Dim NameFrm As String
Dim Idx As Integer
Dim NameObj As String
 
Dim OkExitFor As Boolean
 
' NameFrm = rs1!RO_FRM
' NameObj = rs1!RO_FRMLABEL
' Idx = rs1!RO_FRMLABEL_Idx ' -1 = pas d'index
 
NameFrm = "frmprincipal"
NameObj = "Text1"
Idx = -1
OkExitFor = False
 
For Each ObjFrm In Forms
    If ObjFrm.Name = NameFrm Then
        For Each Obj In ObjFrm
            If Obj.Name = NameObj Then
                If Idx <> -1 Then
                    If Obj.Index = Idx Then Obj.Enabled = False: OkExitFor = True: Exit For
                    Else
                    Obj.Enabled = False: OkExitFor = True: Exit For
                End If
            End If
        Next
        If OkExitFor = True Then Exit For
    End If
Next

Salut

Citation:

Envoyé par ProgElecT

La derniere, je suis en retard sur le travail

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
Dim ObjFrm As Form
Dim Obj As Object
 
Dim NameFrm As String
Dim Idx As Integer
Dim NameObj As String
 
Dim OkExitFor As Boolean
 
' NameFrm = rs1!RO_FRM
' NameObj = rs1!RO_FRMLABEL
' Idx = rs1!RO_FRMLABEL_Idx ' -1 = pas d'index
 
NameFrm = "frmprincipal"
NameObj = "Text1"
Idx = -1
OkExitFor = False
 
For Each ObjFrm In Forms
    If ObjFrm.Name = NameFrm Then
        For Each Obj In ObjFrm
            If Obj.Name = NameObj Then
                If Idx <> -1 Then
                    If Obj.Index = Idx Then Obj.Enabled = False: OkExitFor = True: Exit For
                    Else
                    Obj.Enabled = False: OkExitFor = True: Exit For
                End If
            End If
        Next
        If OkExitFor = True Then Exit For
    End If
Next

Salut

j'ai modifié votre code car je ne travaille pas avec les indexe

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
NameFrm = rs1!RO_FRMNAME
NameObj = rs1!RO_FRMLABEL
'Idx = -1
OkExitFor = False
 
For Each ObjFrm In Forms
    If ObjFrm.Name = NameFrm Then
        For Each Obj In ObjFrm
            If Obj.Name = NameObj Then
                'If Idx <> -1 Then
                    'If Obj.Index = Idx Then
                    Obj.Enabled = False: OkExitFor = True: Exit For
                    Else
                    Obj.Enabled = False: Exit For
                'End If
            End If
        Next
        If OkExitFor = True Then Exit For
    End If
Next

mais elle ne fonctionne pas car frmprincipal est un MDIForm et les autres sont des forms

des petites corrections et amélioration, les composants peuvent être indexé ou non, le code gére ces différents cas de figure.

4 Forms, la première MDIForm1, les 2 suivant Form1 et Form2 => MDIChild = true (Feuille fille) et un Form3 normal

Dans Form1 MDIChild, 2 TextBox "Text1" index 0 et 1
Dans Form2 MDIChild, 1 TextBox "Text1" non indexé
Dans Form3 normal, 1 TextBox "Text1" non indexé
Aucun code dans ces Forms

Dans MDIForm1 créer un menu comme ceci
http://contrib-vb.developpez.com/Pro...utoForEach.jpg

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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
Option Explicit
 
Private Sub MDIForm_Unload(Cancel As Integer)
On Error Resume Next
Unload Form3 'si on a oublier de la fermer
'alors que les Form filles sont dechargé automatiquement
End Sub
 
Private Sub Charger_Click(Index As Integer)
Select Case Index
    Case 0: Form1.Show '
    Case 1: Form2.Show '
    Case 2: Form3.Show '
End Select
End Sub
 
Private Sub Marquer_Click(Index As Integer)
Dim NameFrm As String
Dim NameObj As String
Dim Idx As Integer
 
Select Case Index
    Case 0: NameFrm = "Form1": Idx = 1 '
    Case 1: NameFrm = "Form2": Idx = -1 '
    Case 2: NameFrm = "Form3": Idx = -1 '
End Select
Dim ObjFrm As Form 'pour boucle For Each de la collection Forms
Dim ObjComposant As Object 'pour boucle For Each de la collection des objets sur chaque Form
 
 
Dim OkExitFor As Boolean 'permet de quitter les boucles dés que l'objet à été trouvé et traité
 
'Exemple initialisation depuis une BD ou toute autre mémorisation des paramètres
' NameFrm = rs1!RO_FRM 'literal String
' NameObj = rs1!RO_FRMLABEL 'literal String
' Idx = rs1!RO_FRMLABEL_Idx ' numérique Integer, -1 = pas d'index
 
'Initialisation pour la démo, TextBox non indexé
'NameFrm = "frmprincipal"
NameObj = "Text1"
 
 
For Each ObjFrm In Forms 'boucle sur toutes les Frms
 
    If ObjFrm.Name = NameFrm Then
 
        For Each ObjComposant In ObjFrm 'boucle sur tous les composants
            If ObjComposant.Name = NameObj Then
                'pour exemple on change la couleur de fond d'un TextBox
                If ExisteIndex(ObjComposant) Then
                    'Le composant est indexé
                    If ObjComposant.Index = Idx Then
                        'L'index du composant est bien celui sur lequel on va agir
                        ObjComposant.BackColor = &HC0FFC0: OkExitFor = True: Exit For
                    End If
                    Else
                    ObjComposant.BackColor = &HC0FFC0: OkExitFor = True: Exit For
                End If
            End If
        Next 'boucle composants
        If OkExitFor = True Then Exit For
 
    End If
Next 'boucle Frms
End Sub
Public Function ExisteIndex(Composant As Object) As Boolean
'Fonction permettant de déterminer si le composant est un groupe de composant indexé
On Error Resume Next
ExisteIndex = Composant.Index + 1
End Function

Citation:

Envoyé par bargougui86

mais elle ne fonctionne pas car frmprincipal est un MDIForm et les autres sont des forms

Curieux 8O cela devrait fonctionner ayant fait l'essai je n'ai pas de probléme sur une mise à Enabled d'un sous menu indexé du MDIForm

Citation:

Envoyé par ProgElecT

Curieux 8O cela devrait fonctionner ayant fait l'essai je n'ai pas de probléme sur une mise à Enabled d'un sous menu indexé du MDIForm

Bonjour, vous allez trouver dans la pièce jointe 3 image:
image1: from externe d'authentification et dans le bouton valider j'ai mis ma procédure
image2: frmprincipal (MDIForm) qui contient le menu "Accès Factures" qui doit êtres désactiver mais c'est pas le cas
image3: frmpm (MDIChild) qui contient le bouton "Facturer" qui contient doit êtres désactiver mais c'est pas le cas
Voila la structure de la table MFT_AR_ROLE
RO_ID: 1 || 2
RO_FRMLABEL: cmdfacturer || mnufactures
RO_FRMNAME: frmpm || frmprincipal
RO_ETAT: 0 || 0
Voila ma procédure:

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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
 
Call ConnectDB
Set rs = New Recordset
Set rs1 = New Recordset
Dim AES As New CRijndael
 
Dim ObjFrm As Form
Dim Obj As Object
Dim NameFrm As String
Dim Idx As Integer
Dim NameObj As String
Dim OkExitFor As Boolean
 
'txtCrypté = AES.JustCrypter(txtmotdepasse.Text, txtmotdepasse)
'MsgBox txtCrypté
rs.Open "select * from MFT_AR_USERS where US_LOGIN='" & txtlogin.Text & "' and US_PWD= '" & AES.JustCrypter(txtmotdepasse.Text) & "'", db, adOpenDynamic, adLockOptimistic
'txtDécrypté = AES.JustDécrypter(rs!US_PWD)
'MsgBox txtDécrypté
'If txtmotdepasse.Text = txtDécrypté Then
If rs.RecordCount = 1 Then
txtid.Text = rs!US_ID
frmprincipal.stbprincipal.Panels.Item(3).Text = rs!US_NAME
frmprincipal.stbprincipal.Panels.Item(4).Text = rs!US_ID
frmprincipal.Show
frmprincipal.Enabled = True
rs1.Open "select * from mft_ar_role where ro_us_id='" & rs!US_ID & "' and ro_etat=0", db, adOpenDynamic, adLockOptimistic
rs1.MoveFirst
Do While Not rs1.EOF
NameFrm = rs1!RO_FRMNAME
NameObj = rs1!RO_FRMLABEL
OkExitFor = False
 
For Each ObjFrm In Forms
    If ObjFrm.Name = NameFrm Then
        For Each Obj In ObjFrm
            If Obj.Name = NameObj Then
                'If Idx <> -1 Then
                    'If Obj.Index = Idx Then
                    Obj.Enabled = False: OkExitFor = True: Exit For
                    Else
                    Obj.Enabled = False: Exit For
                'End If
            End If
        Next
        If OkExitFor = True Then Exit For
    End If
Next
'MsgBox txt
'frmprincipal "." & txt & "." & Enabled = False
'MsgBox txt1
'txt1 = False
'MsgBox txt1
'frmprincipal.mnuclient.Enabled = False
rs1.MoveNext
Loop
Unload Me
Else
If MsgBox("Login ou mot de passe incorrêcte ", vbCritical + vbYesNo, "Erreur:") = vbNo Then
End
End If
txtlogin.Text = ""
txtmotdepasse.Text = ""
txtlogin.SetFocus
End If

Mais la procédure ne fonctionne pas c'est a dire que l'Enabled de cmdfacturer et mnufactures est toujours à True et non pas False

29/07/2010, 15h43
ProgElecT

Moi je n'ai pas ce qu’il faut pour ouvrir du .rar, mes un. ZIP

Salut

En regardant de plus près ton dernier

Code:

1
2
3
4
5
6
7
                For Each Obj In ObjFrm
                    If Obj.Name = NameObj Then
                        Obj.Enabled = False: OkExitFor = True: Exit For
                        Else
                        Obj.Enabled = False: Exit For
                    End If
                Next

Que la condition soit vraie ou fausse, tu mes Obj.Enabled = False? , il faut enlever le Else et la ligne qui suit.

Citation:

Mais la procédure ne fonctionne pas c'est a dire que l'Enabled de cmdfacturer et mnufactures est toujours à True et non pas False

Ce qui me laisse donc penser que tu ne rentres jamais dans la 1° condition : If rs.RecordCount = 1 Then
Pourquoi la propriété RecordCount me renvoie toujours -1 ?
Perso je préfère cette condition: If Not rs.EOF Then....
Regardes aussi du coté du curseur de ton rs1 et rs, adOpenDynamic que je verai mieux en adOpenStatic, étant donné que dans cette procedure tu ne modifies pas les enregistrements de la BD.

Cela pourrait donner un code de ce genre

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
rs.Open "select * from MFT_AR_USERS where US_LOGIN='" & txtlogin.Text & "' and US_PWD= '" & AES.JustCrypter(txtmotdepasse.Text) & "'", db, adOpenStatic, adLockOptimistic
 
If Not rs.EOF Then '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    txtid.Text = rs!US_ID
    frmprincipal.stbprincipal.Panels.Item(3).Text = rs!US_NAME
    frmprincipal.stbprincipal.Panels.Item(4).Text = rs!US_ID
    frmprincipal.Show
    frmprincipal.Enabled = True
    rs1.Open "select * from mft_ar_role where ro_us_id='" & rs!US_ID & "' and ro_etat=0", db, adOpenStatic, adLockOptimistic
    rs.Close
    rs1.MoveFirst
    Do While Not rs1.EOF '----------------------------------------------------------------------
 
        NameFrm = rs1!RO_FRMNAME
        NameObj = rs1!RO_FRMLABEL
        OkExitFor = False
 
        For Each ObjFrm In Forms
            If ObjFrm.Name = NameFrm Then
                For Each Obj In ObjFrm
                    If Obj.Name = NameObj Then Obj.Enabled = False: OkExitFor = True: Exit For
                Next
            End If
        Next
 
        rs1.MoveNext
 
    Loop '---------------------------------------------------------------------------------------
    rs1.Close
    Unload Me
    Else
    If MsgBox("Login ou mot de passe incorrecte" & vbCrLf & "voulez-vous réessayer ?", vbCritical + vbYesNo, "Erreur:") = vbNo Then
        End
    End If
    txtlogin.Text = ""
    txtmotdepasse.Text = ""
    txtlogin.SetFocus
End If '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Citation:

Envoyé par ProgElecT

Cela pourrait donner un code de ce genre

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
rs.Open "select * from MFT_AR_USERS where US_LOGIN='" & txtlogin.Text & "' and US_PWD= '" & AES.JustCrypter(txtmotdepasse.Text) & "'", db, adOpenStatic, adLockOptimistic
 
If Not rs.EOF Then '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    txtid.Text = rs!US_ID
    frmprincipal.stbprincipal.Panels.Item(3).Text = rs!US_NAME
    frmprincipal.stbprincipal.Panels.Item(4).Text = rs!US_ID
    frmprincipal.Show
    frmprincipal.Enabled = True
    rs1.Open "select * from mft_ar_role where ro_us_id='" & rs!US_ID & "' and ro_etat=0", db, adOpenStatic, adLockOptimistic
    rs.Close
    rs1.MoveFirst
    Do While Not rs1.EOF '----------------------------------------------------------------------
 
        NameFrm = rs1!RO_FRMNAME
        NameObj = rs1!RO_FRMLABEL
        OkExitFor = False
 
        For Each ObjFrm In Forms
            If ObjFrm.Name = NameFrm Then
                For Each Obj In ObjFrm
                    If Obj.Name = NameObj Then Obj.Enabled = False: OkExitFor = True: Exit For
                Next
            End If
        Next
 
        rs1.MoveNext
 
    Loop '---------------------------------------------------------------------------------------
    rs1.Close
    Unload Me
    Else
    If MsgBox("Login ou mot de passe incorrecte" & vbCrLf & "voulez-vous réessayer ?", vbCritical + vbYesNo, "Erreur:") = vbNo Then
        End
    End If
    txtlogin.Text = ""
    txtmotdepasse.Text = ""
    txtlogin.SetFocus
End If '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

J'ai testé en mode débogage le code et toute la procédure et j'ai remarqué que le code est fonctionnel qu'avec frmprincipal c'est à dire la forme active mais les autres formes c'est à dire qui ne sont pas actives (sont fermés) la fonction n'est pas valable et j'ai eu le message suivant
"ObjFrm.name=<Variable objet ou variable bloc With non définie>"

30/07/2010, 12h25
bargougui86

1 pièce(s) jointe(s)

Citation:

Envoyé par ProgElecT

Moi je n'ai pas ce qu’il faut pour ouvrir du .rar, mes un. ZIP

Voila les image et comme je vous ai dit concernant le message d'erreur en mode débogage, lors du chargement du programme et aprés l'interface l'authentification à travers l'interface frmidentification j'ai seulement frmprincipal ouvert et les autres forms sont fermées telque frmpm
Image1: frmidentification
Image2: frmprincipal
Image3: frmpm

Essais cette nouvelle boucle, pas suffisamment de temps pour faire l'essai, je retourne au travail extérieur.

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
    Do While Not rs1.EOF '----------------------------------------------------------------------
 
        NameFrm = rs1!RO_FRMNAME
        NameObj = rs1!RO_FRMLABEL
        OkExitFor = False
        'Charger le Form pour avoir la collection controls
        Select Case NameFrm
            Case "FormA": FormA.Show: FormA.Visible = False
            Case "FormB": FormB.Show: FormB.Visible = False
            Case "FormC": FormC.Show: FormC.Visible = False
            'case ..........
        End Select
 
        For Each ObjFrm In Forms
            If ObjFrm.Name = NameFrm Then
                For Each Obj In ObjFrm
                    If Obj.Name = NameObj Then Obj.Enabled = False: OkExitFor = True: Exit For
                Next
            End If
            'decharger eventuellement le Form
            If OkExitFor = False Then
                Unload ObjFrm
                Else
                ObjFrm.Show
            End If
        Next
        rs1.MoveNext
    Loop '---------------------------------------------------------------------------------------

05/08/2010, 13h31
bargougui86

Citation:

Envoyé par ProgElecT

Essais cette nouvelle boucle, pas suffisamment de temps pour faire l'essai, je retourne au travail extérieur.

Merci beaucoup :) :) :) :)