Salut

La suite de Une boite de dialogue Mot de Passe

Un Form tout simplement, sans aucun composant, mais ne pas oublier de configurer en design,
Form1.ShowInTaskbar = True
Form1.StartUpPosition = 1
Form1.BorderStyle = 0
Puis Copier/Coller ce
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
Option Explicit
'Une boite de dialogue Loging et Mot de Passe
Dim Reponse As String 'variable conteneur du mot entré par l'utilisateur
Dim MemoLoging As String 'variable conteneur du Loging pour pouvoir vérifier la concordance avec le mot de passe
Dim NbrEssais As Integer 'variable conteneur pour limité le nombre de fois que l'utilisateur pourra proposer son mot de passe
Dim EcritQuoi As String 'variable drapeau pour situer la zone d'écriture suivant si Login ou si mot de passe
 
'******************************************** Partie pour permettre la démonstration  **********************************
'Dim DicO as Dictionary  's'il est fait référence à Microsoft Scripting Runtime
Dim DicO As Object 's'il n'est pas fait référence à Microsoft Scripting Runtime
Private Sub InitVariable()
Dim T As Integer
Dim MaChaine As String
Dim TblLigne() As String ' pour récupérer chaque ligne contenu dans MaChaine
Dim TblColon() As String ' pour récupérer chaque colonne contenu dans TblLigne(n)
 
'Identifiant, Password
MaChaine = "Francis Millet,ProgElecT" & vbNewLine _
         & "Alain Dupont,pontdu" & vbNewLine _
         & "Paul Durant,RantDu"
 
TblLigne = Split(MaChaine, vbNewLine) 'rempli le tableau correspondant à chaque ligne contenu dans MaChaine
 
'création d'une variable objet de type Dictionary
Set DicO = CreateObject("Scripting.Dictionary")
 
For T = 0 To UBound(TblLigne)
    TblColon = Split(TblLigne(T), ",") 'rempli le tableau correspondant à chaque colonne contenu dans TblLigne(T)
    'Ajout des clés et des éléments au dictionnaire
    DicO.Add TblColon(0), TblColon(1)
Next T
End Sub
Private Sub Form_Unload(Cancel As Integer)
DicO.RemoveAll 'Purger le dictionnaire
Set DicO = Nothing 'libération de l'espace mémoire
End Sub
'******************************************** Fin partie pour la démonstration  **********************************
 
 
Private Sub Form_Load()
InitVariable
 
'Me.ShowInTaskbar = True '**** étant en lecture seule durant le run, à faire en design ****
'Me.StartUpPosition = 1   **** étant en lecture seule durant le run, à faire en design ****
'Me.BorderStyle = 0 'None **** à faire en design ****
'--------- peut être configuré en desing ---------------
Me.Width = 4425: Me.Height = 645
Me.BorderStyle = 0 'None
Me.BackColor = &HC0FFFF 'jaune clair
Me.AutoRedraw = True
Me.FontName = "Courier New"
Me.FontSize = 10
Me.FontBold = True
Me.ForeColor = &HC00000
Me.Caption = "Entrez votre mot de passe"
'-------- fin de peut être configuré en desing ----------
 
'pseudo cadre 3D du Form, dessine 2 rectangles non remplis
Me.Line (0, 0)-(Me.ScaleWidth - 15, Me.ScaleHeight - 15), &HC00000, B 'bleu soutenu
Me.Line (0, 0)-(Me.ScaleWidth - 30, Me.ScaleHeight - 30), &HC0C0C0, B 'gris moyen
Me.CurrentX = 1560: Me.CurrentY = 60 'coordonnées d'ou va être écrit la phrase suivante
Me.Print "Identifiant" 'dessine sur le Form les caractères de la phrase
Me.CurrentX = 1140: Me.CurrentY = 690 'coordonnées d'ou va être écrit la phrase suivante
Me.Print "Votre mot de passe" 'dessine sur le Form les caractères de la phrase
 
Me.ForeColor = &H0&
EcritQuoi = "Login"
Reponse = "" 'initialisation du conteneur du mot entré par l'utilisateur
End Sub
 
Private Function VerifMot(QuelMot As String, QuelPhase As String) As Boolean
If QuelPhase = "Login" Then
    VerifMot = DicO.Exists(QuelMot)
    Else 'Password
    VerifMot = QuelMot = DicO.Item(MemoLoging)
End If
End Function
Private Sub Form_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
    Case 8 'touche <---
        'effacement du dernier caractère
        If Len(Reponse) <> 0 Then
            Reponse = Left(Reponse, Len(Reponse) - 1)
            DessineR EcritQuoi, True, False
        End If
    Case 13 'touche Enter
        'phase 1: prépare l'entrée mot de passe, phase 2: analyser le mot de passe
        If EcritQuoi = "Login" Then
            If VerifMot(Reponse, EcritQuoi) = False Then
                MsgBox "Identifiant non connu" & vbNewLine _
                        & "Attention, login et mot de passe sensible à la case" & vbNewLine & vbNewLine & vbNewLine _
                        & "A tous moments, touche Echap. pour quitter", vbCritical, "Votre attention"
                Reponse = "": DessineR Reponse, True, False 'efface le mot proposé
                Exit Sub
            End If
            'efface la partie basse du pseudo cadre 3D
            Me.Line (0, Me.ScaleHeight - 30)-(Me.ScaleWidth, Me.ScaleHeight), Me.BackColor, BF 'jaune clair
            Me.Height = 1275
            'Recréation du pseudo cadre 3D du Form
            Me.Line (0, 0)-(Me.ScaleWidth - 15, Me.ScaleHeight - 15), &HC00000, B 'bleu soutenu
            Me.Line (0, 0)-(Me.ScaleWidth - 30, Me.ScaleHeight - 30), &HC0C0C0, B 'gris moyen
            MemoLoging = Reponse: EcritQuoi = "Password": Reponse = ""
            Exit Sub
        End If
        If VerifMot(Reponse, EcritQuoi) = False Then
            If NbrEssais < 2 Then
                Me.ForeColor = &HFF& 'encre Rouge
                Reponse = "Non conforme, essai n°" & NbrEssais + 1 & "/3"
                DessineR Reponse, True, False
                Attendre 2 ' laisse le temps de lire le message, attendre 2 Sc avant de redonner la possibilité de répondre à nouveau
                Reponse = "": DessineR Reponse, True, False
                NbrEssais = NbrEssais + 1
                Me.ForeColor = &H0& 'encre noir
                Else
                Me.ForeColor = &HFF& 'encre Rouge
                Reponse = "C'était votre dernier essais, salut"
                DessineR Reponse, True, False
                Attendre 3 'attendre 3 Sc avant d'arrêter le programme, laisse le temps de lire le message
                Unload Me
            End If
            Else
            Me.ForeColor = &H4000&
            Reponse = "Correct, suite du programme ..."
            DessineR Reponse, True, False
            'attendre 2 Sc avant de passer à la suite du programme, laisse le temps de lire le message
            Attendre 2
            '-------------------------------------------------------------------------------------
            '--- Ici le nom et le mot de passe sont correcte, lancement du programme principal ---
            'FormSuivante.Show 'passer à la suite du programme
            '-------------------------------------------------------------------------------------
            Unload Me 'décharger ce Form
        End If
    Case 27: Unload Me 'donner la possibilité d'arrêter le programme sans atteindre la fin des essais
    Case 32 To 126, 163, 167, 181, 224, 231, 232, 233, 249
        'limitation à certains caractères (élimination des caractères non "imprimables")
        If Len(Reponse) > 35 Then Exit Sub 'limitation à 35 caractères
        Reponse = Reponse & Chr(KeyAscii) 'ajout du dernier caractère tapé
        If EcritQuoi = "Login" Then DessineR Reponse, True, False Else DessineR Reponse, True, True
End Select
End Sub
Public Sub DessineR(Quoi As String, Effacer As Boolean, MasqueR As Boolean)
If Effacer = True Then
    'dessinne un rectangle plein qui recouvre/efface l'ancien affichage du texte
    If EcritQuoi = "Login" Then
        Me.Line (15, 330)-(Me.ScaleWidth - 45, 570), Me.BackColor, BF
        Else
        Me.Line (15, 960)-(Me.ScaleWidth - 45, 1200), Me.BackColor, BF
    End If
End If
If EcritQuoi = "Login" Then
    Me.CurrentY = 330 ' équivalent au .Top d'un TextBox
    Else
    Me.CurrentY = 960
End If
'calcul pour centrer le mot, 120 = nombre de Twips pour un caractère en Courier New taille 10
Me.CurrentX = (Me.ScaleWidth - (Len(Reponse) * 120)) / 2 'équivalent au .Left d'un TextBox
If MasqueR = True Then
    Me.Print String$(Len(Reponse), "*") 'effet équivalent .PasswordChar d'un TextBox
    Else
    Me.Print Reponse 'affichage normal
End If
End Sub
Private Sub Attendre(Tempo As Single)
Dim Hfin As Single
Hfin = Timer + Tempo 'ajout de x secondes au nombre de secondes écoulées depuis minuit
Do While Timer < Hfin: DoEvents: Loop 'boucle d'attente x secondes
End Sub
Voulu:
pas de possibilité de copier/coller
entré du mot de passe possible avec une "douchette" code barre

Après la ligne 126, l'utilisateur a bien répondu, vous pouvez continuer votre programme FormSuivante.Show et/ou lancer un programme externe (vous pouvez d’ailleurs passer l'UTILISATEUR et son MOT DE PASSE en arguments, si besoin)