Función para validar un Email


http://www.asptutor.com

Función para validar direcciones de correo 

 


Notas del webmaster: 
Nuestro amigo Ignacio nos envía una buena script de comprobación de emails, bastante bien estructurada y COMENTADA. Esta preparada para ser insertada como un include en cualquier página en que necesitemos validar una dirección de email.
La insertaremos en nuestra página con una sentencia de include como

               <!-- #include file="EMAILOK.INC" -->  
y la invocaremos como a cualquier función:
                    XX=Validaremail(request.form("email"))
Luego solo tendremos que comprobar el valor de XX para saber si el email es o no valido.

 

Articulo elaborado por Ignacio Reverte

Te adjunto una función de validación de e-mail mediante un autómata finito que (con cierto orgullo de padre) creo que mejora cualquiera de las que he visto hasta ahora tanto en eficiencia (sólo hace una pasada por el texto del email) como en chequeo real del email (la mayoría se limitan a comprobar si hay arrobas y puntos y en qué orden). A pesar de lo largo del código, en realidad sólo exige n*2 comprobaciones (donde n es la longitud del email) frente a otras validaciones que requieren n*3, n*4 e incluso n*n comprobaciones.
 
Esta validación admite cualquier caso de email valido (incluidos subdominios) y rechaza la mayoría de emails no validos que otras validaciones dan como buenos.
 

Emailok.inc

<%

' EMailOK.inc

' Ignacio Reverte - irevertem@hotmail.com - 2002

' V 2.0 - Gracias a vuestras colaboraciones

' --------- Funcion que comprueba si un e-mail es valido. Autómata finito de 8 estados (inic:0 - finales: 6, 7 y 8)

' La función devolverá:

' vbEMailNulo = 0 - si es nulo o esta vacio

' vbEMailNoOK = 1 - Si el e-mail es incorrecto

' vbEMailOK = 2 - Si el e-mail es valido

Const vbEMailNulo = 0

Const vbEMailNoOK = 1

Const vbEMailOK = 2

Function ValidarEMAIL(EMAIL)

Dim Indice

Dim Caracter

Dim Largo

Dim Estado


ValidarEMAIL = vbEMailNulo ' Inicialmente lo suponemos vacío


If EMAIL <> "" Then

Largo = Len(EMAIL)

Estado = 0 ' Estado inicial del autómata


For Indice = 1 To Largo ' Comenzamos a recorrer la cadena

Caracter = Mid(EMAIL, Indice, 1) ' Vamos tomando carácter a carácter


' Con lo que sigue comprobamos si el caracter está

' en el rango A-Z , a-z , 0-9 (caracter aceptable tipo A - Alfanumerico)


If (Caracter>="a" AND Caracter<="z") OR _ 

(Caracter>="A" AND Caracter<="Z") OR _

(Caracter>="0" AND Caracter<="9") Then

Caracter = "A"

End If


' Con lo que sigue comprobamos si el caracter es

' _ ó - (caracter aceptable tipo - : Guion alto o bajo)


If Caracter = "-" Or Caracter = "_" Then 

Caracter = "-"

End If


Select Case Caracter

Case "A": ' Es un caracter aceptable tipo A

Select Case Estado 

Case 0:

Estado = 1 ' Era el primer caracter del EMAIL: pasamos a estado 1

Case 1:

Estado = 1 ' Caracter intermedio ..x.. antes de arroba. Seguimos en 1

Case 2:

Estado = 3 ' Caracter después de arroba. Pasamos a estado 3

Case 3:

Estado = 3 ' Caracter en dominio. Seguimos en estado 3

Case 4:

Estado = 5 ' 1er caracter en extension de dominio/subdominio. Pasamos a estado 5

Case 5:

Estado = 6 ' 2º caracter en extension de dominio/subdominio. Pasamos a estado 6 

Case 6:

Estado = 7 ' 3er caracter en extension de dominio/sudominio. Pasamos a estado 7

Case 7:

Estado = 8 ' 4º caracter en extension de dominio/subdominio. Pasamos a estado 8

Case 8:

ValidarEMAIL = vbEMailNoOK ' La longitud de la extensión .XXXX mayor que 4 caracteres

Exit Function ' Estado de error

End Select

Case "-": ' Es un caracter aceptable tipo "-" 

Select Case Estado 

Case 1:

Estado = 1 ' Caracter intermedio ..-.. antes de arroba. Seguimos en 1

Case 3:

Estado = 3 ' Caracter en dominio. Seguimos en estado 3

Case Else:

ValidarEMAIL = vbEMailNoOK ' 

Exit Function ' Estado de error

End Select 


Case "." : '-----> Encuentra un punto

Select Case Estado

Case 1: ' Como lo anterior eran caracteres y puntos

Estado = 0 ' pasamos a estado inicial (espera un caracter)

Case 3: ' Lo anterior era una arroba y texto

Estado = 4 ' Pasamos a estado 4 (extension .com, .net, .shop, .info ...)

Case Else: ' Encontró un punto después de la arroba o al comienzo de la cadena

ValidarEMAIL = vbEMailNoOK ' o antes de la arroba

Exit Function ' Estado de error

End Select


Case "@": '-----> Encuentra una arroba

Select Case Estado

Case 1: ' Si lo anterior eran caracteres y puntos,

Estado = 2 ' pasamos a estado 2

Case Else: ' Si lo anterior era algo distinto

ValidarEMAIL = vbEMailNoOK ' Estado de error

Exit Function

End Select


' -----> Encuentra un caracter "raro"

Case Else: ' Caracter inaceptable para email. Ej: * : !

ValidarEMAIL = vbEMailNoOK ' Estado de error

Exit Function

End Select


Next ' -----> Fin de comprobación de cadena


If (Estado = 6) or (Estado = 7) or (Estado = 8) Then ' El autómata terminó en un estado final

ValidarEMAIL = vbEMailOK ' Estado final: email correcto

Else

ValidarEMail = vbEMailNoOK ' No era un estado final: email incorrecto

End If

End If 

End Function

%>