emal valid

[Silvio.Falconi]

exist a function to check an email ?

[karinha]

Code: Select all  Expand view  RUN

   REDEFINE GET aGet[3] VAR XEMAILNOCONTA PICTURE "@K" ID 22 OF oDlgServ     ;
      FONT oFnt UPDATE COLOR CLR_BLACK, CLR_WHITE                            ;
      VALID( VALIDA_GET_EMAIL( XEMAILNOCONTA, aGet ) ) WHEN( lConsulta )

FUNCTION VALIDA_GET_EMAIL( cEMAILNOCONTA, aGet )

   LOCAL cContaUsuario, cNomeUsuario
   LOCAL cRegEx := "^[_a-z0-9-]+(\.[_a-z0-9-]+)*@[a-z0-9-]+(\.[a-z0-9-]+)*(\.[a-z]{2,4})$"
   LOCAL lIsValid := .F.

   PUBLIC cNomeUsuFinal

   IF GETASYNCKEY( VK_UP )
      RETURN( .T. )
   ENDIF

   IF EMPTY( cEMAILNOCONTA )  // = a XEMAILNOCONTA

      MsgInfo( OemToAnsi( "ATEN€ÇO USUµRIO:                    " )+CRLF+ ;
               OemToAnsi( "DIGITE O NOME DA CONTA DE EMAIL.    " )+CRLF+ ;
               OemToAnsi( "Exemplo: .......@pleno.com.br       " ),      ;
               OemToAnsi( "EMAIL(Conta) NÇO INFORMADO. CUIDADO!" ) )

      RETURN( .F. )

   ENDIF

   IF ( ALLTRIM(LOWER( cEMAILNOCONTA ) ) LIKE cRegEx )
      lIsValid := .T.
   ELSE
      MsgInfo( OemToAnsi( "ATEN€ÇO USUµRIO:                    " )+CRLF+ ;
               OemToAnsi( "DIGITE UM EMAIL VÇLIDO..            " )+CRLF+ ;
               OemToAnsi( "ESTA CONTA DE EMAIL ESTµ ERRADA..   " )+CRLF+ ;
               OemToAnsi( "Exemplo: .......@pleno.com.br       " )+CRLF+ ;
               OemToAnsi( "VOCÒ DIGITOU: " + ALLTRIM( cEMAILNOCONTA ) ), ;
               OemToAnsi( "EMAIL(Conta) CONTENDO ERROS... VEJA!" ) )
   ENDIF

   cContaUsuario := LOWER( cEMAILNOCONTA )
 
   cNomeUsuario := Substr( cContaUsuario, 1, ( AT( "@", cContaUsuario ) -1 ) ) ;
                   +SPACE(30)

   cNomeUsuFinal := cNomeUsuario

   aGet[7]:VARPUT( cNomeUsuario )
   aGet[7]:Refresh()

   aGet[7]:Disable()
   aGet[7]:Refresh()

RETURN( lIsValid )
 

[karinha]

Se usas HARBOUR:

http://forums.fivetechsupport.com/viewtopic.php?f=6&t=40988&sid=03ad6d6cd77d38af03cf3b732e60d480

[Silvio.Falconi]

allready seen this function but here not run ok

[karinha]

allready seen this function but here not run ok

Harbour or xHarbour?

[Otto]

Hello Silvio,
I use the function from Mr. Ramesh Babu.
Best regards,
Otto

Code: Select all  Expand view  RUN

  ******************************************************************************
   ** FUNCTION Validate_Email_Address(cE_Mail) to Validate the entry of e.mail **
   **          address - By RAMESH BABU P (aksharasoft@hotmail.com)            **
   ******************************************************************************
   
   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( "Infobox","Keine gültige Emailadresse - "+ CRLF +   ;
                    "Email trotzdem speichern?")=.t.
                    lOk:=.t.
                endif
            ENDIF
           
        RETURN lOk
        //----------------------------------------------------------------------------//

[karinha]

Compilado con HARBOUR.

Intenta ahora:

Code: Select all  Expand view  RUN

// C:\SILVIO2\SILVSSAY.PRG - 20/11/2021 - kapiabafwh@gmail.com

#Include "FiveWin.ch"
#Include "hbcompat.ch"  // Harbour and xHarbour
#Include "SSay.ch"

#Define CLR_LGREEN     nRGB( 190, 215, 190 )
#Define CLR_SOFTYELLOW nRGB( 255, 251, 225 )
#Define CLR_PINK       nRGB( 255, 128, 128 )
#Define CLR_NBLUE      nRGB( 128, 128, 192 )
#Define CLR_MSPURPLE   nRGB( 0,   120, 215 )
#Define CLR_MSRED      nRGB( 232,  17,  35 )
#Define CLR_MSGRAY     nRGB( 229, 229, 229 )

FUNCTION Configura()

   LOCAL oDlg, oFld, oBarDialog, oFont, cTitle, aGrad, oOk, oExit
   LOCAL cDenominazione := "I LOVE FIVEWIN THE BEST OF THE WORLD!            "
   LOCAL cIndirizzo     := "AVENUE ATLANTICA, 1200 - LEBLON - RIO DE JANEIRO."
   LOCAL oSay      := ARRAY(4)
   LOCAL aGet      := ARRAY(4)
   LOCA  cCompl    := REPLICATE( ".",  9 )
   LOCAL SilDrawLi := REPLICATE( "_", 13 )
   LOCAL EmailSilv := SPACE(50)

   cTitle := "Italia Informatica Corporation: Configurazione di Sistema"

   SET _3DLOOK ON

   SetGetColorFocus( CLR_LGREEN ) // COR EM TODOS OS GETS DOS DIALOGOS.

   tGet():lDisColors  := .F.   // WHEN( .F. ) COR.
   tGet():nClrTextDis := CLR_HBLUE
   tGet():nClrPaneDis := CLR_SOFTYELLOW

   SetBalloon( .T. ) // Balloon shape required for tooltips

   SkinButtons()

   aGrad := { { 1, CLR_WHITE, CLR_HCYAN  } }

   DEFINE FONT oFont NAME 'Tahoma' SIZE 0, - 16

   DEFINE DIALOG oDlg TITLE cTitle SIZE 900, 400 PIXEL TRUEPIXEL            ;
      GRADIENT aGrad

   oDlg:lHelpIcon := .F.

   DEFINE BUTTONBAR oBarDialog OF oDlg SIZE 80, 80 2007 BOTTOM NOBORDER

   @3, 0 FOLDEREX oFld SIZE oDlg:nWidth, oDlg:nHeight - oBarDialog:nheight ;
      PROMPTS "&Azienda", "&Setup"                                         ;
      BITMAPS "C:\FWH1905\bitmaps\16x16\floppy.bmp",                       ;
              "C:\FWH1905\bitmaps\16x16\HelpInd.bmp"                       ;
      FONT oFont PIXEL COLOR CLR_MSGRAY TAB HEIGHT 25 ROUND 5

   oFld:SetOption( 1 )
   oFld:aEnable = { .T., .T., .F., .F. }
   oFld:Show()

   IF Set( _SET_INSERT, ! Set( _SET_INSERT ) )
      Set( _SET_INSERT, ! Set( _SET_INSERT ) )
   ENDIF

   @ 22, 10 SENSITIVE SAY oSay[1] PROMPT "Denominazione:" SIZE 60, 20        ;
      UPDATE PIXEL OF oFld:aDialogs[1] FONT oFont COLORS CLR_PINK, CLR_WHITE ;
      TRANSPARENT

   @ 24.00, 10 SAY oSilDrawLi VAR SilDrawLi SIZE 150, 15 OF oFld:aDialogs[1] ;
      UPDATE PIXEL FONT oFont COLORS CLR_PINK, CLR_WHITE TRANSPARENT

   @ 22, 70 GET aGet[ 1 ] VAR cDenominazione SIZE 363, 12 UPDATE PIXEL       ;
      OF oFld:aDialogs[1]                                                    ;
      FONT oFont COLORS CLR_MSPURPLE, CLR_WHITE

   @ 36.50, 10 SENSITIVE SAY oSay[2] PROMPT "Indirizzo"+cCompl+".:"          ;
       SIZE 60, 20 PIXEL OF oFld:aDialogs[1] FONT oFont                      ;
       COLORS CLR_MSPURPLE, CLR_WHITE UPDATE TRANSPARENT

   @ 39.50, 10 SAY oSilDrawLi VAR SilDrawLi SIZE 150, 15 OF oFld:aDialogs[1] ;
      UPDATE PIXEL FONT oFont COLORS CLR_MSPURPLE, CLR_WHITE TRANSPARENT

   @ 36.50, 70 GET aGet[2] VAR cIndirizzo SIZE 363, 12 PIXEL OF oFld:aDialogs[1] ;
      UPDATE FONT oFont COLORS CLR_MSPURPLE, CLR_WHITE

   // Email Silvio
   @ 54.50, 10 SENSITIVE SAY oSay[3] PROMPT "Email Silvio......:"            ;
       SIZE 60, 20 PIXEL OF oFld:aDialogs[1] FONT oFont                      ;
       COLORS CLR_MSRED , CLR_WHITE UPDATE TRANSPARENT

   @ 51.50, 70 GET aGet[3] VAR EmailSilv SIZE 363, 12 PIXEL OF oFld:aDialogs[1] ;
      UPDATE FONT oFont COLORS CLR_MSRED , CLR_WHITE                         ;
      VALID( VALIDA_GET_CONTA( EmailSilv, aGet ) )

   @ 370, 350 BUTTON oOk   PROMPT "Send &Mail" SIZE 100, 22 OF oDlg PIXEL    ;
      ACTION( oDlg:End() )

   @ 370, 500 BUTTON oExit PROMPT "&Salida"    SIZE 80, 20 OF oDlg PIXEL     ;
      ACTION( oDlg:End() ) DEFAULT CANCEL

   SET FONT OF oOk   TO oFont
   SET FONT OF oExit TO oFont

   ACTIVATE DIALOG oDlg CENTERED

   IF Set( _SET_INSERT, ! Set( _SET_INSERT ) )
      Set( _SET_INSERT, ! Set( _SET_INSERT ) )
   ENDIF

   oFont:End()

RETURN NIL

FUNCTION VALIDA_GET_CONTA( cEmailSilvio, aGet )

   LOCAL cContaUsuario, cNomeUsuario
// LOCAL cRegEx := "^[a-zA-Z0-9._%-]+@[a-zA-Z0-9.-]+\.[a-zA-Z]{2,4}$"  // ou:
   LOCAL cRegEx := "^[_a-z0-9-]+(\.[_a-z0-9-]+)*@[a-z0-9-]+(\.[a-z0-9-]+)*(\.[a-z]{2,4})$"
   LOCAL lIsValid := .F.

   PUBLIC cNomeUsuFinal

   IF GETASYNCKEY( VK_UP )
      RETURN( .T. )
   ENDIF

   IF EMPTY( cEmailSilvio )

      MsgInfo( OemToAnsi( "ATEN€ÇO USUµRIO:                    " )+CRLF+ ;
               OemToAnsi( "DIGITE O NOME DA CONTA DE EMAIL.    " )+CRLF+ ;
               OemToAnsi( "Exemplo: .......@pleno.com.br       " ),      ;
               OemToAnsi( "EMAIL(Conta) NÇO INFORMADO. CUIDADO!" ) )

      RETURN( .F. )

   ENDIF

   // #Include "hbcompat.ch"  // Harbour and xHarbour
   IF ( ALLTRIM(LOWER( cEmailSilvio ) ) LIKE cRegEx )

      lIsValid := .T.

   ELSE

      MsgInfo( OemToAnsi( "ATEN€ÇO USUµRIO:          Harbour..." )+CRLF+ ;
               OemToAnsi( "DIGITE UM EMAIL VÇLIDO..            " )+CRLF+ ;
               OemToAnsi( "ESTA CONTA DE EMAIL ESTµ ERRADA..   " )+CRLF+ ;
               OemToAnsi( "Exemplo: .......@pleno.com.br       " )+CRLF+ ;
               OemToAnsi( "VOCÒ DIGITOU: " + ALLTRIM( cEmailSilvio ) ), ;
               OemToAnsi( "EMAIL(Conta) CONTENDO ERROS... VEJA!" ) )

   ENDIF

RETURN( lIsValid )

// FIN / END
 

[leandro]

Code: Select all  Expand view  RUN

//Si no estoy mal, este código es aporte de Daniel García
function validaEmail(cEmail)
    LOCAL pCompiled := hb_regexComp("^[_a-z0-9-]+(\.[_a-z0-9-]+)*@[a-z0-9-]+(\.[a-z0-9-]+)*(\.[a-z]{2,4})$")
    LOCAL aMatch
    LOCAL cRet := .t.
    aMatch = hb_regex( pCompiled, alltrim(cEmail) )
    if Empty( aMatch )
        cRet := .f.
    end
return cRet
 

[karinha]

Code: Select all  Expand view  RUN

//Si no estoy mal, este código es aporte de Daniel García
function validaEmail(cEmail)
    LOCAL pCompiled := hb_regexComp("^[_a-z0-9-]+(\.[_a-z0-9-]+)*@[a-z0-9-]+(\.[a-z0-9-]+)*(\.[a-z]{2,4})$")
    LOCAL aMatch
    LOCAL cRet := .t.
    aMatch = hb_regex( pCompiled, alltrim(cEmail) )
    if Empty( aMatch )
        cRet := .f.
    end
return cRet
 

Gracias Leandro. Ahora compilando con HBMK2.exe.

https://mega.nz/file/BVs21BhB#Ex8y-KM3oZB6bkqcMO6D9W9vB78xXg6BcfIUBFVGwMU

Regards, saludos.