VALIDAR EMAILO

 Tópico anterior Próximo tópico Novo tópico

VALIDAR EMAILO

VB.NET

 Compartilhe  Compartilhe  Compartilhe
#474003 - 17/05/2017 12:39:50

AMORIM
PALMAS/TOCANTINS
Cadast. em:Agosto/2015


Ola pessoal estou tentando fazer uma função para validar email, a funçãom esta funcionando so que estou tentando impedir que o email termina com um ponte mais não estou conseguindo

exemplo; igadino@gmail.com - certo
exemplo igadino@gmail.com. - errado

alguém tem uma solução para minha função

    Public Function ValidEMail(Email As String) As Boolean
        Dim Caractere As Integer
        Dim Count As Integer
        Dim Letras As String
        'Verifica se o e-mail tem no MÍNIMO 5 caracteres (a@b.c)
        If Len(Email) < 5 Then
            'O e-mail é inválido, pois tem menos
            'de 5 caracteres
            ValidEMail = False
             MsgBox("O e-mail digitado tem menos de 5 caracteres!!!", vbCritical, "ATENÇÃO")
            Exit Function
        End If
        'Verificar a existencia de arrobas (@) no e-mail
        For Caractere = 1 To Len(Email)
            If Mid(Email, Caractere, 1) = "@" Then
                'OPA!!! Achou uma arroba!!!
                'Soma 1 ao contador
                Count = Count + 1
            End If
        Next
        'Verifica o número de arrobas.
        'TEM que ter """UMA""" arroba
        If Count <> 1 Then
            'O e-mail é inválido, pois tem 0 ou
            'mais de 1 arroba
            ValidEMail = False
             MsgBox("O nº de arrobas (@) do e-mail é inválido!!!", vbCritical, "ATENÇÃO")
            Exit Function
        Else
            'O e-mail tem 1 arroba.
            'Verificar a posição da arroba
            If InStr(Email, "@") = 1 Then
                'O e-mail é inválido, pois começa
                'com uma @
                ValidEMail = False
                 MsgBox("O e-mail foi iniciado com uma arroba (@)!!!", vbCritical, "ATENÇÃO")
                Exit Function
            ElseIf InStr(Email, "@") = Len(Email) Then
                'O e-mail é inválido, pois termina
                'com uma @
                ValidEMail = False
                 MsgBox("O e-mail termina com uma arroba (@)!!!", vbCritical, "ATENÇÃO")
                Exit Function
            End If
        End If
        Caractere = 0
        Count = 0
        'Verificar a existencia de pontos (.) no e-mail
        For Caractere = 1 To Len(Email)
            If Mid(Email, Caractere, 1) = "." Then
                'OPA!!! Achou um ponto!!!
                'Soma 1 ao contador
                Count = Count + 1
            End If
        Next
        'Verifica o número de pontos.
        'TEM que ter PELO MENOS UM ponto.
        If Count < 1 Then
            'O e-mail é inválido, pois não tem pontos.
            ValidEMail = False
             MsgBox("O e-mail é inválido, pois não contém pontos (.)!!!", vbCritical, "ATENÇÃO")
            Exit Function
        Else
            'O e-mail tem pelo menos 1 ponto.
            'Verificar a posição do ponto:
            If InStr(Email, ".") = 1 Then
                'O e-mail é inválido, pois começa
                'com um ponto
                ValidEMail = False
                 MsgBox("O e-mail foi iniciado com um ponto (.)!!!", vbCritical, "ATENÇÃO")
                Exit Function
            ElseIf InStr(Email, ".") = Len(Email) Then
                'O e-mail é inválido, pois termina
                'com um ponto.
                ValidEMail = False
                 MsgBox("O e-mail termina com um ponto (.)!!!", vbCritical, "ATENÇÃO")
                Exit Function
            ElseIf InStr(InStr(Email, "@"), Email, ".") = 0 Then
                'O e-mail é inválido, pois termina
                'com um ponto.
                ValidEMail = False
                 MsgBox("O e-mail não tem nenhum ponto (.) após a arroba (@)!!!", vbCritical, "ATENÇÃO")
                Exit Function
            End If
        End If
        Caractere = 0
        Count = 0
        'Verifica se o e-mail não tem pontos
        'consecutivos (..) após a arroba (@).
        If InStr(Email, "..") > InStr(Email, "@") Then
            'O e-mail é inválido, tem pontos
            'consecutivos após o @.
            ValidEMail = False
             MsgBox("O e-mail contém pontos consecutivos (..) após o arroba (@)!!!", vbCritical, "ATENÇÃO")
            Exit Function
        End If
        'Verifica se o e-mail tem caracteres
        'inválidos
        For Caractere = 1 To Len(Email)
            Letras = Mid$(Email, Caractere, 1)
            If Not (LCase(Letras) Like "[a-z]" Or Letras = "@" Or Letras = "." Or Letras = "-" Or Letras = "_" Or IsNumeric(Letras)) Then
                'O e-mail é inválido, pois tem
                'caracteres inválidos
                ValidEMail = False
                 MsgBox("Foi digitado um caracter inválido no e-mail!!!", vbCritical, "ATENÇÃO")
                Exit Function
            End If
        Next
        Caractere = 0
        'Bem, se a verificação chegou até aqui
        'é porque o e-mail é válido, então...
        ValidEMail = True
    End Function



#474004 - 17/05/2017 12:55:44

LEANDROBTOS
VIRADOURO
Cadast. em:Agosto/2009


Já viu algo sobre Regex?

Dá uma lida neste artigo do Macoratti
Tem alguns exemplos, inclusive um para validar E-mail.

[]´s

_______________________________________________________
Estamos aqui para fazer alguma diferença no universo, se não, porque estar aqui?
Steve Jobs


#474005 - 17/05/2017 13:04:56

AMORIM
PALMAS/TOCANTINS
Cadast. em:Agosto/2015


só não estou conseguindo validar o ponto final, pois a função esta funcionando



#474006 - 17/05/2017 13:22:22

LVFIOROT
SERRA
Cadast. em:Março/2012


cara voce consegue fazer isso com 3 linhas de programação regex email

http://emailregex.com/



#474007 - 17/05/2017 14:04:24

NILSONTRES
SAO PAULO
Cadast. em:Março/2012


Imports System.Text.RegularExpressions

Dim strRegex As String = "^([a-zA-Z0-9_\-\.]+)@((\[[0-9]{1,3}" + "\.[0-9]{1,3}\.[0-9]{1,3}\.)|(([a-zA-Z0-9\-]+\" + ".)+))([a-zA-Z]{2,4}|[0-9]{1,3})(\]?)$"
                Dim re As New Regex(strRegex)
                If ('seuemail')) Then ' tudo normal
                  
                Else
                   invalido
                End If



#474054 - 18/05/2017 13:31:07

AMORIM
PALMAS/TOCANTINS
Cadast. em:Agosto/2015


Conseguir olha agora sim esta funcionando segue para quem estiver precisando

   Public Function ValidEMail(sEMail As String) As Boolean
        Dim nCharacter As Integer
        Dim Count As Integer
        Dim sLetra As String
        'Verifica se o e-mail tem no MÍNIMO 5 caracteres (a@b.c)
        If Len(sEMail) < 5 Then
            'O e-mail é inválido, pois tem menos
            'de 5 caracteres
            ValidEMail = False
            'Call MsgBox("O e-mail digitado tem menos de 5 caracteres!!!", vbCritical, "ATENÇÃO")
            MsgBox("Atenção:" + vbCrLf + "O e-mail digitado tem menos de 5 caracteres!!!", MsgBoxStyle.Question, "Contas a Pagar")
            Exit Function
        End If
        'Verificar a existencia de arrobas (@) no e-mail
        For nCharacter = 1 To Len(sEMail)
            If Mid(sEMail, nCharacter, 1) = "@" Then
                'OPA!!! Achou uma arroba!!!
                'Soma 1 ao contador
                Count = Count + 1
            End If
        Next
        'Verifica o número de arrobas.
        'TEM que ter """UMA""" arroba
        If Count <> 1 Then
            'O e-mail é inválido, pois tem 0 ou
            'mais de 1 arroba
            ValidEMail = False
            'Call MsgBox("O nº de arrobas (@) do e-mail é inválido!!!", vbCritical, "ATENÇÃO")
            MsgBox("Atenção:" + vbCrLf + "O nº de arrobas (@) do e-mail é inválido!!!", MsgBoxStyle.Question, "Contas a Pagar")
            Exit Function
        Else
            'O e-mail tem 1 arroba.
            'Verificar a posição da arroba
            If InStr(sEMail, "@") = 1 Then
                'O e-mail é inválido, pois começa
                'com uma @
                ValidEMail = False
                'Call MsgBox("O e-mail foi iniciado com uma arroba (@)!!!", vbCritical, "ATENÇÃO")
                MsgBox("Atenção:" + vbCrLf + "O e-mail foi iniciado com uma arroba (@)!!!", MsgBoxStyle.Question, "Contas a Pagar")
                Exit Function
            ElseIf InStr(sEMail, "@") = Len(sEMail) Then
                'O e-mail é inválido, pois termina
                'com uma @
                ValidEMail = False
                'Call MsgBox("O e-mail termina com uma arroba (@)!!!", vbCritical, "ATENÇÃO")
                MsgBox("Atenção:" + vbCrLf + "O e-mail termina com uma arroba (@)!!!", MsgBoxStyle.Question, "Contas a Pagar")
                Exit Function
            End If
        End If
        nCharacter = 0
        Count = 0
        'Verificar a existencia de pontos (.) no e-mail
        For nCharacter = 1 To Len(sEMail)
            If Mid(sEMail, nCharacter, 1) = "." Then
                'OPA!!! Achou um ponto!!!
                'Soma 1 ao contador
                Count = Count + 1
            End If
        Next
        'Verifica o número de pontos.
        'TEM que ter PELO MENOS UM ponto.
        If Count < 1 Then
            'O e-mail é inválido, pois não tem pontos.
            ValidEMail = False
            'Call MsgBox("O e-mail é inválido, pois não contém pontos (.)!!!", vbCritical, "ATENÇÃO")
            MsgBox("Atenção:" + vbCrLf + "O e-mail é inválido, pois não contém pontos (.)!!!", MsgBoxStyle.Question, "Contas a Pagar")
            Exit Function
        Else
            'O e-mail tem pelo menos 1 ponto.
            'Verificar a posição do ponto:
            If InStr(sEMail, ".") = 1 Then
                'O e-mail é inválido, pois começa
                'com um ponto
                ValidEMail = False
                'Call MsgBox("O e-mail foi iniciado com um ponto (.)!!!", vbCritical, "ATENÇÃO")
                MsgBox("Atenção:" + vbCrLf + "O e-mail foi iniciado com um ponto (.)!!!", MsgBoxStyle.Question, "Contas a Pagar")
                Exit Function
                'O e-mail é inválido, pois termina
                'com um ponto.
            ElseIf Right$(sEMail, 1) = "." Then
                ValidEMail = False
                MsgBox("Atenção:" + vbCrLf + "E-Mail não Pode Terminar Com Ponto (.) ..!!!", MsgBoxStyle.Question, "Contas a Pagar")
                Exit Function
            ElseIf InStr(InStr(sEMail, "@"), sEMail, ".") = 0 Then
                'O e-mail é inválido, pois termina
                'com um ponto.
                ValidEMail = False
                MsgBox("Atenção:" + vbCrLf + "O e-mail não tem nenhum ponto (.) após a arroba (@)!!!", MsgBoxStyle.Question, "Contas a Pagar")
                Exit Function
        End If
        End If
        nCharacter = 0
        Count = 0
        'Verifica se o e-mail não tem pontos
        'consecutivos (..) após a arroba (@).
        If InStr(sEMail, "..") > InStr(sEMail, "@") Then
            'O e-mail é inválido, tem pontos
            'consecutivos após o @.
            ValidEMail = False
            'Call MsgBox("O e-mail contém pontos consecutivos (..) após o arroba (@)!!!", vbCritical, "ATENÇÃO")
            MsgBox("Atenção:" + vbCrLf + "O e-mail contém pontos consecutivos (..) após o arroba (@)!!!", MsgBoxStyle.Question, "Contas a Pagar")
            Exit Function
        End If
        'Verifica se o e-mail tem caracteres
        'inválidos
        For nCharacter = 1 To Len(sEMail)
            sLetra = Mid$(sEMail, nCharacter, 1)
            If Not (LCase(sLetra) Like "[a-z]" Or sLetra = "@" Or sLetra = "." Or sLetra = "-" Or sLetra = "_" Or IsNumeric(sLetra)) Then
                'O e-mail é inválido, pois tem
                'caracteres inválidos
                ValidEMail = False
                'Call MsgBox("Foi digitado um caracter inválido no e-mail!!!", vbCritical, "ATENÇÃO")
                MsgBox("Atenção:" + vbCrLf + "Foi digitado um caracter inválido no e-mail!!!", MsgBoxStyle.Question, "Contas a Pagar")
                Exit Function
            End If
        Next
        nCharacter = 0
        ValidEMail = True
    End Function





 Tópico anterior Próximo tópico Novo tópico


Tópico encerrado, respostas não sao permitidas
Encerrado por AMORIM em 18/05/2017 13:32:05