Biblioteca de Clases,Funciones y Sub-rutinas.

[Adler]

Es una adaptación de un código PHP que podeis encontrar aquí

Este mismo código en javascript

Código:

Function vMail(correo)
Dim email_array, local_array, dominio_array, i
Dim esOK
Dim localOK, ipOK, dominoOK

set localOK = new RegExp
set ipOK = new RegExp
set dominoOK = new RegExp

localOK.pattern = ("^(([A-Za-z0-9!#$%&'*+/=?^_`{|}~-][A-Za-z0-9!#$%&'*+/=?^_`{|}~\.-]{0,63})|(\'[^(\\|\')]{0,62}\'))$")
ipOK.pattern = ("^\[?[0-9\.]+\]?$")
dominoOK.pattern = ("^(([A-Za-z0-9][A-Za-z0-9-]{0,61}[A-Za-z0-9])|([A-Za-z0-9]+))$")

'Por defecto el email es valido
esOK = True

' Ninguna cuenta de email puede tener menos de 5 caracteres "[email protected]"
If Len(correo) < 5 Then
esOK = False
Else

' El email consta de dos partes dividas por @
email_array = split(correo, "@")
If (ubound(email_array)+1) < 2 or (ubound(email_array)+1) > 2 Then
esOK = False
Else

' Incorrecto número de caracteres en alguna de las dos partes
If Len(email_array(0)) < 1 or Len(email_array(1)) < 1 Then
esOK = False
Else

If Instr(1, correo, " ") <> 0 Then 
'Buscamos que el email no tenga espacios en blancos "a @b.c"
esOK = False
Else

local_array = split(email_array(0), ".")
For i = 0 to (ubound(local_array)) 
If (Not localOK.Test(local_array(i))) Then
esOK = False
End If
Next 'i

' Se revisa si el dominio es una IP. Si no, debe ser un nombre de dominio válido
If (Not ipOK.Test(correo)) Then

dominio_array = split(email_array(1), ".")
' Incorrecto número de secciones por exceso o defecto para ser un dominio
If (ubound(dominio_array)+1) < 2 or (ubound(dominio_array)+1) > 3 Then 
esOK = False
End If

For i = 0 to (ubound(dominio_array)) 
If (Not dominoOK.Test(dominio_array(i))) Then
esOK = False
End If
Next 'i
End If
End If
End If
End If
End If
vMail = esOK

End Function

USO

Código:

if Not vMail(Request.Form("email")) then
response.write "email NO válido"
else
response.write "email válido"
end if