Try This class:

Local oReg as CAbstractRegularExpression

oReg=CreateObject("CEmailRegularExpression")

Clear

? oReg.Test("[email protected]")
? oReg.Test("DaveC@replacement software.co.uk")


Define Class clsAbstractRegularExpression As Relation
        sName        = "clsAbstractRegularExpression"
        sPattern     = ""
        
        bIgnoreCase  = .T.
        bGlobal      = .T.
        sRegExpClass = "VBScript.RegExp"
        oRegExp      = Null

        Protected sName, sPattern, bIgnoreCase, bGlobal, ;
                sRegExpClass, oRegExp

        
        Protected Procedure Init()
                LOCAL llRetVal
                
                llRetVal = DODEFAULT()
                If llRetVal
                        This.oRegExp = CreateObject(This.sRegExpClass)
                        This.oRegExp.Pattern = This.sPattern
                        This.oRegExp.IgnoreCase = This.bIgnoreCase
                        This.oRegExp.Global = This.bGlobal
                EndIf
        EndProc
        
        Protected Procedure GarbageCollect
                This.bGarbageCollected = .T.
                This.oRegExp = Null
        EndProc
        
        Procedure Test(tsSearchString) 
                LOCAL lbRetVal
                
                lbRetVal = This.oRegExp.Test(tsSearchString)
                
                Return lbRetVal
        EndProc

        Procedure Replace(tsSearchString, tsReplaceString) 
                LOCAL lbRetVal
                
                lbRetVal = This.oRegExp.Replace(tsSearchString, tsReplaceString)

                Return lbRetVal
        EndProc

        Procedure Execute(tsSearchString) 
                LOCAL loMatches
                
                lomatches = This.oRegExp.Test(tsSearchString)
                
                Return loMatches
        EndProc
EndDefine


*-- Matches URLs in the form of http://URL or https://URL
Define Class CHTTPRegularExpression As clsAbstractRegularExpression 
        sName        = "CHTTPRegularExpression"
        sPattern     = "((http(s?)\://){1}\S+)"
        bIgnoreCase  = .T.
        bGlobal      = .T.

        Protected sName, sPattern, bIgnoreCase, bGlobal, ;
                sRegExpClass, oRegExp
EndDefine

*-- Matches Emails the form of [email protected]
Define Class CEmailRegularExpression As clsAbstractRegularExpression 
        sName        = "CHTTPRegularExpression"
        sPattern     = 
"^[a-zA-Z][\w\.-]*[a-zA-Z0-9]@[a-zA-Z0-9][\w\.-]*[a-zA-Z0-9]\.[a-zA-Z][a-zA-Z\.]*[a-zA-Z]$"
        bIgnoreCase  = .T.
        bGlobal      = .T.

        Protected sName, sPattern, bIgnoreCase, bGlobal, ;
                sRegExpClass, oRegExp
        *       
EndDefine

-----Original Message-----
From: ProFox [mailto:[email protected]] On Behalf Of Peter Cushing
Sent: 07 January 2014 16:01
To: [email protected]
Subject: Re: Regular Expression Search

Laurie Alvey wrote:
> I am trying to do some basic format validation on a string which purports to 
> be an email address. I want test that "@" occurs once and once only and "." 
> (period) occurs at least once. This is what I have tried:
>
> o = NEWOBJECT("VBScript.RegExp")
> o.Pattern = "[@{1} [.]{1,}]"
> ctest = "[email protected]"
> ? oTest(ctest)&& Prints .T.
> ctest = "someaddress@[email protected]"
>
> ? oTest(ctest)&& Prints .T. (which is not what I want)
>
>   
If you are using VFP you could do some checking yourself.  I have a function 
that does some basic checking:

HTH

Peter

FUNCTION isemail
PARAMETERS cEmail
LOCAL lValid,i,cChar,nAsc,li
cEmail = RTRIM(LOWER(cEmail))
* check valid e-mail address
lValid=.t.
IF OCCURS('@',cEmail) > 1
   nAtpos = 0
ELSE
   nAtpos=AT('@',cEmail)
ENDIF

IF OCCURS('.',cEmail)>0
   nDotpos=AT('.',cEmail,OCCURS('.',cEmail))
ELSE
   nDotpos=0
ENDIF
* also check for bad chars.  Only allow a-z 0-9 @ _ - + # FOR li = 1 TO 
LEN(cEmail)
   cChar = SUBSTR(cEmail,li,1)
   nAsc = ASC(cChar)
   IF !(BETWEEN(cChar,'a','z') OR BETWEEN(cChar,'0','9') OR
INLIST(cChar,'.','@','_','-','+','#'))
      lValid=.f.
   ENDIF
NEXT
IF nAtpos<=1 OR nDotpos=0 OR nDotpos<nAtpos OR nDotpos=LEN(ALLTRIM(cEmail))
   lValid=.f.
ENDIF
RETURN lValid


----------------------------------------------------------------



Rajan Imports has changed - we are now Whispering Smith Ltd.  For more 
information see our website at www.whisperingsmith.com


Please update your address book with my new email address: 
[email protected]

.

This communication is intended for the person or organisation to whom it is 
addressed.  The contents are confidential and may be protected in law.  
Unauthorised use, copying or 
disclosure of any of it may be unlawful.  If you have received this message in 
error, please notify us immediately by telephone or email.

www.whisperingsmith.com

Whispering Smith Ltd
Head Office:61 Great Ducie Street, Manchester M3 1RR. Tel:0161 831 3700 
Fax:0161 831 3715
London Office:17-19 Foley Street, London  W1W 6DW Tel:0207 299 7960


[excessive quoting removed by server]

_______________________________________________
Post Messages to: [email protected]
Subscription Maintenance: http://mail.leafe.com/mailman/listinfo/profox
OT-free version of this list: http://mail.leafe.com/mailman/listinfo/profoxtech
Searchable Archive: http://leafe.com/archives/search/profox
This message: 
http://leafe.com/archives/byMID/profox/[email protected]
** All postings, unless explicitly stated otherwise, are the opinions of the 
author, and do not constitute legal or medical advice. This statement is added 
to the messages for those lawyers who are too stupid to see the obvious.

Reply via email to