Biblioteca de Clases,Funciones y Sub-rutinas.

[TonyChile]

validacion de email

Este codigo es el mejor que e visto para poder validar un correo (email) no me acuerdo donde lo vi pero el que lo hizo se merece

Código:

<%

' EMailOK.inc
' --------- 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

%>