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 |
Partager