Validar dirección email de remitente. AspMail

El siguiente código para AspMail es excelente. Mi único
problema es que no está validando la dirección email del
remitente que llena el blanco en el formulario. El
código completo se obtiene en:http://www.brainjar.com.
Los comentarios del problema están incluidos en la
parte correspondiente del script que sigue:
...
Encabezado:
referers = Array()
mailComp = "ASPMail"
smtpServer = "mail.tu dominio.com."
fromAddr = "contactar@tu dominio.com"
............................................
formulario:
<form action="FormMail.asp" method="post">
<p align="center">
<input name="_recipients" type="hidden"
value="[email protected],[email protected],xxx@otro mas.net"
/><br>
<input name="_subject" type="hidden" value= "Contacto"
/>
<input name="_requiredFields" type="hidden"
value="Name,Lugar,ReplyTo,Subject,Comments" />
<b><br>
Tu Nombre: </b>
<input name="Nombre" type="text" />
<br />
<b> Lugar: </b>
<input name="Lugar" type="text" />
<br />
<b>Tu E-Mail: </b>
<input name="ReplyTo" type="text" />
<br />
<b>Asunto: </b><input name="Subject" type="text"
/</br /> </p>
<div align="center">
<table border="0" cellpadding="0" cellspacing="0"
width="24%">
<tr>
<td width="100%">
<p align="left"> <b>Mensaje:</b></td>
</tr>
</table>
</div>
<p align="center">
<textarea name="Comments" rows=10 cols=50
wrap=hard></textarea>
<input type="submit" value="Enviar" />
<input type="reset" value="Reset" />
</p>
</form>
....................................................
Validar Replyto (email del remitente;Tu Email)
Esta parte solo me está validando si el usuario llenó o
nó el campo corespondiente, que no esté en blanco. Pero
no valida si está correcto. Por ejemplo: [email protected].
if replyTo <> "" then
if not IsValidEmailAddress(ReplyTo)
then
call AddErrorMsg("Dirección de email no es válida:
" & replyTo & ".")
end if
end if
Sin embargo el código sí valida el campo escondido
(hidden) en el formulario:
<input name="_recipients" type="hidden"
value="[email protected],[email protected],xxx@otro mas.net"
/>
a través de:
if Request.Form("_recipients") = "" then
call AddErrorMsg("Missing email recipient.")
end if
'Check all recipient email addresses.
recipients = Split(Request.Form("_recipients"), ",")
for each name in recipients
name = Trim(name)
if not IsValidEmailAddress(name) then
call AddErrorMsg("Invalid email address in
recipient list: " & name & ".")
end if
next
recipients = Join(recipients, ",")
Y utilizando las siguientes funciones y subrutinas:
<% '---------------------------------------------------
------------------------
' Subroutines and functions.
'---------------------------------------------------
------------------------
sub AddErrorMsg(msg)
dim n
'Add an error message to the list.
n = UBound(errorMsgs)
Redim Preserve errorMsgs(n + 1)
errorMsgs(n + 1) = msg
end sub
function GetHost(url)
dim i, s
GetHost = ""
'Strip down to host or IP address and port number,
if any.
if Left(url, 7) = "http://" then
s = Mid(url, 8)
elseif Left(url, 8) = "https://" then
s = Mid(url, 9)
end if
i = InStr(s, "/")
if i > 1 then
s = Mid(s, 1, i - 1)
end if
getHost = s
end function
'Define the global list of valid TLDs.
dim validTlds
function IsValidEmailAddress(emailAddr)
dim i, localPart, domain, charCode, subdomain,
subdomains, tld
'Check for valid syntax in an email address.
IsValidEmailAddress = true
'Parse out the local part and the domain.
i = InStrRev(emailAddr, "@")
if i <= 1 then
IsValidEmailAddress = false
exit function
end if
localPart = Left(emailAddr, i - 1)
domain = Mid(emailAddr, i + 1)
if Len(localPart) < 1 or Len(domain) < 3 then
IsValidEmailAddress = false
exit function
end if
'Check for invalid characters in the local part.
for i = 1 to Len(localPart)
charCode = Asc(Mid(localPart, i, 1))
if charCode < 32 or charCode >= 127 then
IsValidEmailAddress = false
exit function
end if
next
'Check for invalid characters in the domain.
domain = LCase(domain)
for i = 1 to Len(domain)
charCode = Asc(Mid(domain, i, 1))
if not ((charCode >= 97 and charCode <= 122) or
(charCode >= 48 and charCode <= 57) or charCode = 45 or
charCode = 46) then
IsValidEmailAddress = false
exit function
end if
next
'Check each subdomain.
subdomains = Split(domain, ".")
for each subdomain in subdomains
if Len(subdomain) < 1 then
IsValidEmailAddress = false
exit function
end if
next
'Last subdomain should be a TDL.
tld = subdomains(UBound(subdomains))
if not IsArray(validTlds) then
call SetValidTlds()
end if
for i = LBound(validTlds) to UBound(validTlds)
if tld = validTlds(i) then
exit function
end if
next
IsValidEmailAddress = false
end function
sub setValidTlds()
'Load the global list of valid TLDs.
validTlds = Array("aero", "biz", "com", "coop",
"edu", "gov", "info", "int", "mil", "museum", "name",
"net", "org", "pro", _
"ac", "ad", "ae", "af", "ag", "ai", "al", "am",
"an", "ao", "aq", "ar", "as", "at", "au", "aw", "az", _
"ba", "bb", "bd",...