Hello Dutch,
this is how I test to validate the entry of emails.
Best regards,
Otto
******************************************************************************
** FUNCTION Validate_Email_Address(cE_Mail) to Validate the entry of e.mail **
** address - By RAMESH BABU P (<!-- e --><a href="mailto:aksharasoft@hotmail.com">aksharasoft@hotmail.com</a><!-- e -->) **
******************************************************************************
* and some changes I made
FUNCTION Validate_Email_Address(cE_Mail)
LOCAL lOk := .T., cValid_Letters := "abcdefghijklmnopqrstuvwxyz0123456789._-@"
LOCAL n
local cToken := ""
local cDomainPart := ""
local cLocalPart := ""
local nLocalPart := 0
local nAnzPunkte := 0
local I := 0
cE_Mail := ALLTRIM(cE_Mail)
IF EMPTY(cE_Mail)
RETURN .T.
ENDIF
DO CASE
* Check for existance of '@' and '.' the basic characters of an email
CASE (.NOT. "@" $ cE_Mail) .OR. (.NOT. "." $ cE_Mail)
lOk := .F.
* Check '@' is typed more than the required 1 time
CASE NumAt( "@",cE_Mail ) > 1
// FT_NOOCCUR("@",cE_Mail,.F.) >1
lOk := .F.
* Check wether any characters are between '@' and '.' or type continuous
CASE ( RAT(".", cE_Mail) - AT("@", cE_Mail) <= 2 )
lOk := .F.
OTHERWISE
//local-part - there must be a local part
cToken := StrToken( cE_Mail,1,'@' )
nLocalPart := len( ALLTRIM(cToken) )
if nLocalPart = 0 .or. nLocalPart > 64
lOk := .F.
endif
//domain-part
cDomainpart := StrToken( cE_Mail,2,'@' )
* Check domain-part if '.' is typed more than the required 1 time
nAnzPunkte := NumAt( ".",cDomainpart )
FOR I := 1 to nAnzPunkte + 1
cToken := StrToken( cDomainpart,I,'.' )
if I = nAnzPunkte
if len(ALLTRIM(cToken)) < 2
lOk := .F.
endif
else
if len(ALLTRIM(cToken)) < 1
lOk := .F.
endif
endif
next
FOR n = 1 TO LEN(cE_Mail)
IF .NOT. LOWER( SUBSTR(cE_Mail,n,1) ) $ cValid_Letters
lOk := .F.
EXIT
ENDIF
NEXT
ENDCASE
IF .NOT. lOk
if MsgYesNo("Keine gültige Emailadresse - "+ CRLF + ;
"Email trotzdem speichern?")=.t.
lOk:=.t.
endif
ENDIF
RETURN lOk
//----------------------------------------------------------------------------//
