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

Télécharger le projet
Commenter

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.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (Jiggy35)