Test de validité du format d'une adresse e-mail et smtp

Soyez le premier à donner votre avis sur cette source.

Vue 13 374 fois - Téléchargée 450 fois

Description

Ce code n'a pas la prétention d'éviter d'entrer de fausses adresses mais vous assure une quasi totale fiabilité en ce qui concerne son format. Il est évident que les tests auraient pu être beaucoup poussés au point de vérifier si le nom de domaine de l'adresse est valide, mais pour des raisons de simplicité d'utilisation du code et de transmission de celui-ci, je me suis dis que faire une fonction simple sans appel à quoi que ce soit d'autre ferait très bien l'affaire.
  • NOUVEAU : CODE IDEM POUR ADRESSE SMTP !

Source / Exemple :


'   ***************************************************
'   Test de vérification du format d'une adresse E-Mail
'   ***************************************************
'
'   Type de source : Fonction
'
'
'   Liste des vérifications du code :
'   -------------------------------------------------------------------------------
'   Tests
'   -------------------------------------------------------------------------------
'   1) Enlever les espaces
'   2) Tester si l'E-mail est vide
'   3) Utilisation des chiffres et des lettres + (@, ., -, _,)
'   4) Longueur E-mail minimum 6 caract. (ex: a@a.fr)
'   5) @ doit être présent qu'une fois
'   6) Minimum 1 caract. à gauche de @
'   7) Minimum 4 caract. à droite de @ (ex: a.fr)
'   8) Minimum 1 point à droite de @
'   9) @ et . ne peuvent se suivre
'   10) .. ne peut être valide à droite de @
'   11) A droite de @, le dernier point doit avoir minimum 2 caract. à sa droite
'

Option Explicit
Dim strMsg As String    'Variable contenant le message d'erreur personnalisé

Private Function ValidMail() As Boolean

    'déclaration des variables
    Dim strMail As String   'variable contenant l'adresse E-Mail
    Dim var As String       'variable utilisée en temporaire dans les tests
    Dim z As Integer        'variable utiisée en tant que compteur
    Const strValidChars As String = "1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ-_.@" 'variable utilisée pour stocker les caractères valides d'une adresse E-Mail
    
'***TEST 1***
    'récupération de l'adresse en enlevant les espaces aux extrémités
    strMail = Trim(Text1.Text)
    
    'si l'adresse contenait des espaces involontaires, elle est réaffichée juste
    Text1.Text = strMail
    
'***TEST 2***
    'test si l'E-mail est vide
    If strMail = "" Then
        strMsg = "Aucune adresse E-mail n'est entrée !"
        Exit Function
    End If
    
'***TEST 3***
    'test des caractères invalides
    For z = 1 To Len(strMail)
        If Not InStr(strValidChars, Mid(strMail, z, 1)) > 0 Then
            strMsg = "L'adresse E-Mail contient des caractères invalides !"
            Exit Function
        End If
    Next
    
    z = 0
    
'***TEST 4***
    'test de la longueur de l'E-mail (6 caract. min.)
    If Len(strMail) < 6 Then
        strMsg = "Le nombre de caractères de l'E-mail ne peut être inférieur à 6 !"
        Exit Function
    End If
    
'***TEST 5***
    'test du nombre de fois que @ est présent (doit être 1)
    'test si @ est présent au moins une fois
    If Not InStr(1, strMail, "@") <> 0 Then
        strMsg = "Le caractère @ doit être présent dans l'adresse E-Mail !"
        Exit Function
    Else
        'test si @ est présent encore une fois
        var = Right(strMail, Len(strMail) - InStr(1, strMail, "@"))
        
        If InStr(1, var, "@") <> 0 Then
            var = ""
            strMsg = "Le caractère @ ne peut être présent plus d'une fois dans l'adresse E-Mail !"
            Exit Function
        End If
    End If
    var = ""
    
'***TEST 6***
    'test de placement de @ qui ne peut être le 1er caractère de l'adresse
    If Not Len(Left(strMail, InStr(1, strMail, "@") - 1)) > 0 Then
        strMsg = "Le caractère @ ne peut être le 1er caractère de l'adresse E-Mail !"
        Exit Function
    End If
    
'***TEST 7***
    'test de la partie à droite de @ qui doit avoir minimum 4 caractères
    If Len(Right(strMail, Len(strMail) - InStr(1, strMail, "@"))) < 4 Then
        strMsg = "La partie à droite du caractère @ ne peut contenir moins de 4 caractères dans l'adresse E-Mail !"
        Exit Function
    End If
    
'***TEST 8***
    'test du nombre de fois qu'un point est présent dans la partie à droite de @ (min. 1x)
    var = Right(strMail, Len(strMail) - InStr(1, strMail, "@"))
        
    If InStr(1, var, ".") < 1 Then
        var = ""
        strMsg = "La partie à droite du caractère @ doit contenir minimum un point dans l'adresse E-Mail !"
        Exit Function
    End If
    var = ""
    
'***TEST 9***
    'test que @ et . ne se suivent pas
    If InStr(1, strMail, "@.") > 0 Then
        strMsg = "@ et . ne peuvent être l'un derrière l'autre dans l'adresse E-Mail !"
        Exit Function
    End If
    
'***TEST 10***
    'test que .. n'existe pas dans la partie à droite de @
    var = Right(strMail, Len(strMail) - InStr(1, strMail, "@"))
    
    If InStr(1, var, "..") > 0 Then
        var = ""
        strMsg = "2 point ne peuvent être l'un derrière l'autre dans la partie à droite du caractère @ de l'adresse E-Mail !"
        Exit Function
    End If
    var = ""
    
'***TEST 11***
    'test que 2 caractères minimum soient présents à droite du dernier point dans la partie à droite de @
    If Right(strMail, 1) = "." Or InStr(Right(strMail, 2), ".") = 1 Then
        strMsg = "Il doit y avoir minimum 2 caractères après le dernier point dans la partie à droite du caractère @ de l'adresse E-Mail !"
        Exit Function
    End If

'*** E-MAIL VALIDE ***
    'on donne la valeur vraie au résultat
    ValidMail = True
    Exit Function

End Function

Private Sub Command1_Click()

    'vérification de la validité du format de l'adresse E-Mail
    If ValidMail = True Then
        'on affiche le message de succès
        MsgBox "Le format de votre adresse E-Mail est valide !"
    Else
        'affichage du message d'erreur combiné
        MsgBox "Le format de votre adresse E-Mail n'est pas valide !" & vbCrLf & strMsg, vbExclamation
        'on met le curseur sur Text1
        Text1.SetFocus
    End If

End Sub

                                        • SOURCE SUIVANTE ********************
' ************************************************************** ' Test de vérification du format d'une adresse d'un serveur SMTP ' ************************************************************** ' ' Type de source : Fonction ' ' ' Liste des vérifications du code : ' ------------------------------------------------------------------------------- ' Tests ' ------------------------------------------------------------------------------- ' 1) Enlever les espaces ' 2) Tester si l'E-mail est vide ' 3) Utilisation des chiffres et des lettres + (., -, _,) ' 4) Longueur du serveur SMTP minimum 6 caract. (ex: a.a.fr) ' 5) Le nombre de . doit être minimum 2 ' 6) . ne peut être le premier caractère ' 7) 2 . ne peuvent se suivre ' 8) 2 caractères minimum doivent être présents après le dernier . ' Option Explicit Dim strSMTPMsg As String 'variable contenant le message d'erreur personnalisé Private Function ValidSMTP() As Boolean 'déclaration des variables Dim strSMTP As String 'variable contenant l'adresse du serveur SMTP Dim y As Integer 'variable utiisée en tant que compteur Const strValidChars As String = "1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ-_." 'variable utilisée pour stocker les caractères valides d'une adresse E-Mail '***TEST 1*** 'récupération de l'adresse en enlevant les espaces aux extrémités strSMTP = Trim(Text1.Text) 'si l'adresse contenait des espaces involontaires, elle est réaffichée juste Text1.Text = strSMTP '***TEST 2*** 'test si l'adresse du serveur SMTP est vide If strSMTP = "" Then strSMTPMsg = "Aucune adresse de serveur SMTP n'est entrée !" Exit Function End If '***TEST 3*** 'test des caractères invalides For y = 1 To Len(strSMTP) If Not InStr(strValidChars, Mid(strSMTP, y, 1)) > 0 Then strSMTPMsg = "L'adresse du serveur SMTP contient des caractères invalides !" Exit Function End If Next y = 0 '***TEST 4*** 'test de la longueur de l'adresse du serveur SMTP (6 caract. min.) If Len(strSMTP) < 6 Then strSMTPMsg = "Le nombre de caractères de l'adresse du serveur SMTP ne peut être inférieur à 6 !" Exit Function End If '***TEST 5*** 'test que le nombre de points soit >= 2 If InStr(1, strSMTP, ".") = 0 Or InStr(1, Right(strSMTP, Len(strSMTP) - InStr(1, strSMTP, ".")), ".") = 0 Then strSMTPMsg = "L'adresse du serveur SMTP doit contenir 2 points !" Exit Function End If '***TEST 6*** 'test que . ne peut être le premier caractère de l'adresse du serveur SMTP If Left(strSMTP, 1) = "." Then strSMTPMsg = "Votre adresse du serveur SMTP ne peut commencer par un point !" Exit Function End If '***TEST 7*** 'test que .. n'existe pas dans l'adresse du serveur SMTP If InStr(1, strSMTP, "..") > 0 Then strSMTPMsg = "2 point ne peuvent être l'un derrière l'autre dans l'adresse du serveur SMTP !" Exit Function End If '***TEST 8*** 'test que 2 caractères minimum soient présents à droite du dernier . If Right(strSMTP, 1) = "." Or InStr(Right(strSMTP, 2), ".") = 1 Then strSMTPMsg = "Il doit y avoir minimum 2 caractères après le dernier point dans l'adresse du serveur SMTP !" Exit Function End If '*** SMTP VALIDE *** 'on donne la valeur vraie au résultat ValidSMTP = True Exit Function End Function Private Sub Command1_Click() 'vérification de la validité du format de l'adresse du serveur SMTP If ValidSMTP = True Then 'on affiche le message de succès MsgBox "Le format de votre adresse SMTP est valide !" Else 'affichage du message d'erreur combiné MsgBox "Le format de votre adresse de serveur SMTP n'est pas valide !" & vbCrLf & strSMTPMsg, vbExclamation 'on met le curseur sur Text1 Text1.SetFocus End If End Sub

Conclusion :


Pour utiliser le code, vous avez besoin de :

- 1 TextBox nommé Text1
- 1 Bouton nommé Command1

/!\ Valable pour les 2 sources.

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
18
Date d'inscription
jeudi 25 décembre 2003
Statut
Membre
Dernière intervention
12 août 2004

Ok

et pour ton souci de message de 2 points il suffit de mettre :
strMsg = "1 point ne peut suivre ou en précéder un autre dans la partie à droite du caractère @ de l'adresse E-Mail !"

au lieu de :
strMsg = "2 point ne peuvent être l'un derrière l'autre dans la partie à droite du caractère @ de l'adresse E-Mail !"

;-)
Messages postés
1115
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
6 mai 2007

En effet, je pensai pas que tu comptais le @ dedans :( cherche pas à comprendre, c'est encore ma façon de penser bizzare qui me joue des tours ;)
Messages postés
18
Date d'inscription
jeudi 25 décembre 2003
Statut
Membre
Dernière intervention
12 août 2004

t'as raison pour les 2 points consécutifs, je vais voir, c'est mon msgbox qui affiche ça, je vais lui dire d'afficher la réponse de mon test à la place.

pour les 6 caractères, essaie de me trouver un e-mail plus court que :

a@a.fr

t'as la réponse ;-)

@+
Messages postés
1115
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
6 mai 2007

Pourquoi une adresse doit pas dépasser 6 caracteres ?! L'histoire des 2 points consécutifs n'es pas tres vraie puisque si l'on en met 3, il dit qu'il y en a que 2. Bon voila, c'est du détail pour la 2eme remarque mes ce sont les détails qui font les codes parfaits ;)
bravo sinon
Messages postés
1115
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
6 mai 2007

Pourquoi une adresse doit pas dépasser 6 caracteres ?! L'histoire des 2 points consécutifs n'es pas tres vraie puisque si l'on en met 3, il dit qu'il y en a que 2. Bon voila, c'est du détail pour la 2eme remarque mes ce sont les détails qui font les codes parfaits ;)
bravo sinon
Afficher les 10 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.