<%
Private Function IsEmail(byVal mailaddress)
Dim tmp, x, y, bErr, tmp2, objReg
Dim objMatch, z, i
bErr = False
tmp = Trim( mailaddress )
tmp = CStr( mailaddress )
' minimum 6 characters...
if len(tmp) < 6 then
IsEmail = False
Exit Function
end if
' need an @ but only 1 is allowed
If instr(tmp, "@") then
x = instr(tmp, "@")
y = instr(x + 1, tmp, "@")
On Error Resume Next
y = CLng(y)
If Err Then bErr = True Else bErr = False
On Error GoTo 0
If bErr Then
IsEmail = False
Exit Function
End If
if y <> 0 then
IsEmail = False
Exit Function
end if
Else
IsEmail = False
Exit Function
End If
' the "." must come after the "@"
If InStr( Left( tmp, CLng(x) ), "." ) Then
IsEmail = False
Exit Function
Else
tmp2 = Right( tmp, Len(tmp) - CLng(x) )
If InStr( tmp2, "." ) Then
' must have at least one character between @ and .
Set objReg = New RegExp
With objReg
.Global = True
.IgnoreCase = True
.Pattern = "[A-Z]|[0-9]"
Set objMatch = .Execute(tmp2)
End With
If objMatch.Count = 0 then
IsEmail = False
Exit Function
End If
Set objMatch = Nothing
Set objReg = Nothing
Else
IsEmail = False
Exit Function
End If
End If
' needs to have at least 2 characters (letters) after the .
z = InStr( tmp, "." )
tmp2 = Right( tmp, Len(tmp) - z )
Set objReg = New RegExp
With objReg
.Global = True
.IgnoreCase = True
.Pattern = "[A-Z][A-Z]"
Set objMatch = .Execute(tmp2)
End With
If objMatch.Count = 0 then
IsEmail = False
Exit Function
End If
Set objMatch = Nothing
Set objReg = Nothing
' check for illegal characters
For i = 1 to Len(tmp)
tmp2 = Mid( tmp, i, 1 )
Select Case tmp2
Case "(", ")", ";", ":", ",", "/", "'", chr(34), _
"~", "`", "!", "#", "$", "%", "^", "&", "*", _
"+", "=", "[", "]", "{", "}", "|", "\", "?", _
" ", "<", ">"
IsEmail = False
Exit Function
Case Else
End Select
Next
' if an address makes it through, it's an email address
IsEmail = True
End Function
%>