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

Soyez le premier à donner votre avis sur cette source.

Vue 13 015 fois - Téléchargée 433 fois

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

Ajouter un commentaire

Commentaires

Signaler
ShadowMaster
Messages postés
184
Date d'inscription
mercredi 27 novembre 2002
Statut
Membre
Dernière intervention
18 août 2005
pour l'instant juste quelque petit truc: si tu n'attend rien à la sorti de ta fonction utilise Sub au lieu de function:
Private Sub ValidMail()

(exmple avec function: private function ValidMail() as boolean
...(si c bon la la fin: ValidMail=true)
et dans un bouton ou autre: if ValidMail=true then ...)

certain vont te dire qu'il n'aime pas utilisé goto :) mais bon ici ce n'est en rien genant.
A la rigeur tu peu declarer I en tant que Byte il n'ira pas au dela de 255
Personnelement je l'utilise pas Dim juste quand j'ai besoin dans l'immediat d'une variable mais je remet tout en private ou public.

voila c'est tout sinon pour se qui est de: right, left, mid, len etc... tu maitrise la chose bravo :)
Signaler
Renfield
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
 60
Tu te compliques quelques peu, je trouve !

une simple expression régulière,ou un test en utilisant Like suffirait...
Signaler
Renfield
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
 60
Pour ce qui est des expressions régulières....

http://www.vbfrance.com/code.aspx?ID=17331

avec l'expression suivante, pour avoir les mêmes règles que celles que tu énonces plus haut.

([A-Z][^@]*)@([^.@]+)\.(\w{2,})


le code donnerait a peu pret ça :
(n'oublies pas d'ajouter la reference 'Microsoft VbScript Regular Expressions')

Public function ValidMail ( Mail as string ) as boolean
Dim REG as New RegExp
With REG
REG.Pattern = "([A-Z][^@]*)@([^.@]+)\.(\w{2,})"
REG.IgnoreCase = True
ValidMail = REG.Test ( Mail )
End With
End Function
Signaler
Jiggy35
Messages postés
18
Date d'inscription
jeudi 25 décembre 2003
Statut
Membre
Dernière intervention
12 août 2004
ShadowMaster>
Merci de ton commentaire. j'ai utilisé une fonction car j'utilise tout au long du code des msgbox, mais il est vrai qu'un sub en booléen ferait très bien l'affaire.
Pour ce qui est des commandes Instr, Len, etc... ça a été le plus gros du boulot mais avec des tests et des msbox on y arrive :-)

Renfield>
Tu as tout à fait raison en ce qui concerne la commande Like. Je ne la connaissait pas et effectivement, elle me ferait gagner environ 3 lignes.
En ce qui concerne ton VbScript, pourquoi pas mais je ne connais pas assez cela. Je suis tout de même encore néophite en VB.

Merci aux deux pour vos commentaires constructifs et qui m'ont appris qqch.

Je suis tout de même content que vous n'ayez pas trouvé d'erreurs.
Signaler
Jiggy35
Messages postés
18
Date d'inscription
jeudi 25 décembre 2003
Statut
Membre
Dernière intervention
12 août 2004
Voilà j'ai modifié le code de telle manière qu'il fonctionne en booléen. Le bouton Command1 test à présent si la fonction retourne true.
Afficher les 10 commentaires
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)