Re: Does anyone know of a good URL to validate an email address entered?

[Steve Richter <stephenrichter@xxxxxxxxx>]

sql has excellent regexp functions.  regexp_instr returns the location in
the string of the searched for pattern.

d text            s            256a   varying
d fx              s             10i 0
d email_pattern   s            256a   varying
d i5              s              5i 0
 /free
      email_pattern = '[a-z0-9\._%+!$&*=^|~#%''`?{}/\-]+' +
                      '@([a-z0-9\-]+\.){1,}([a-z]{2,16})' ;
      text        = 'How jack1345@xxxxxxxxx' ;
      exec sql
      set         :fx :i5 = regexp_instr( :text, :email_pattern ) ;
      if          fx > 0 ;
      endif ;


On Wed, Jan 13, 2021 at 1:22 PM Javier Sanchez <
javiersanchezbarquero@xxxxxxxxx> wrote:

> Use this copybook and program that I wrote listed below and you'll have
> fun.
>
>
> *This is REGEX_H*
>
>       /IF NOT DEFINED(REGEX_H)
>       /DEFINE REGEX_H
>        //** regcomp() cflags
>        DCL-C REG_BASIC CONST(0);
>        DCL-C REG_EXTENDED CONST(1);
>        DCL-C REG_ICASE CONST(2);
>        DCL-C REG_NEWLINE CONST(4);
>        DCL-C REG_NOSUB CONST(8);
>        DCL-C REG_ALT_NL CONST(16);
>
>        //* regexec() eflags */
>        DCL-C REG_NOT_BOL CONST(256);
>        DCL-C REG_NOT_EOL CONST(512);
>
>        //** error codes **//
>        DCL-C REG_NOMATCH CONST(1);
>        DCL-C REG_BADPAT CONST(2);
>        DCL-C REG_ECOLLATE CONST(3);
>        DCL-C REG_ECTYPE   CONST(4);
>        DCL-C REG_EESCAPE CONST( 5);
>        DCL-C REG_ESUBREG CONST( 6);
>        DCL-C REG_EBRACK  CONST( 7);
>        DCL-C REG_EPAREN  CONST( 8);
>        DCL-C REG_EBRACE  CONST( 9);
>        DCL-C REG_BADBR   CONST(10);
>        DCL-C REG_ERANGE  CONST(11);
>        DCL-C REG_ESPACE  CONST(12);
>        DCL-C REG_BADRPT  CONST(13);
>        DCL-C REG_ECHAR   CONST(14);
>        DCL-C REG_EBOL    CONST(15);
>        DCL-C REG_EEOL    CONST(16);
>        DCL-C REG_ECOMP   CONST(17);
>        DCL-C REG_EEXEC   CONST(18);
>        DCL-C REG_LAST    CONST(18);
>
>        DCL-DS REGEX_T QUALIFIED TEMPLATE;
>          re_nsub UNS(10);
>          re_reserved1 CHAR(12);
>          re_comp POINTER;
>          re_cflags INT(10);
>          re_erroff UNS(10);
>          re_len UNS(10);
>          re_ucoll UNS(10) DIM(2);
>          re_reserved2 CHAR(12);
>          re_lsub POINTER;
>          lsub_ar UNS(10) DIM(16);
>          esub_ar UNS(10) DIM(16);
>          dummyptr1 POINTER;
>          re_esub POINTER;
>          re_specchar POINTER;
>          re_phdl POINTER;
>          comp_spc CHAR(112);
>          re_map CHAR(256);
>          re_shift INT(5);
>          re_dbcs INT(5);
>          re_reserved3 CHAR(12);
>        END-DS;
>
>        DCL-DS REGMATCH_T QUALIFIED TEMPLATE ALIGN;
>          rm_so INT(10);
>          rm_ss INT(5);
>          rm_eo INT(10);
>          rm_es INT(5);
>        END-DS;
>
>        //** regcomp()
>        DCL-PR regcomp INT(10) EXTPROC('regcomp');
>          preg LIKEDS(REGEX_T);
>          pattern POINTER VALUE OPTIONS(*STRING:*TRIM);
>          cflags INT(10) VALUE;
>        END-PR;
>
>        //** regexec()
>        DCL-PR regexec INT(10) EXTPROC('regexec');
>          preg LIKEDS(REGEX_T) CONST;
>          string POINTER VALUE OPTIONS(*STRING:*TRIM);
>          nmatch UNS(10) VALUE;
>          pmatch POINTER VALUE;
>          //pmatch LIKEDS(REGMATCH_T) DIM(100) OPTIONS(*VARSIZE);
>          eflags INT(10) VALUE;
>        END-PR;
>
>        //** regerror **//
>        DCL-PR regerror UNS(10) EXTPROC('regerror');
>          errcode INT(10) VALUE;
>          preg LIKEDS(REGEX_T) CONST;
>          errbuf CHAR(65535) OPTIONS(*VARSIZE);
>          errbuf_size INT(10) VALUE;
>        END-PR;
>
>        //** regfree() **//
>        DCL-PR regfree EXTPROC('regfree');
>          preg LIKEDS(REGEX_T);
>        END-PR;
>       /ENDIF
>
> *And this is CHKEMAIL, THE PROGRAM*
>
>        CTL-OPT DFTACTGRP(*NO) ACTGRP(*CALLER);
>        CTL-OPT OPTION(*SRCSTMT: *NODEBUGIO);
>
>       /COPY *LIBL/QCPYSRC,REGEX_H
>
>        DCL-PR MAINPROC EXTPROC('CHKEMAIL');
>         parm_email CHAR(512);
>         parm_returnCode INT(10);
>        END-PR;
>
>        DCL-PI MAINPROC;
>         parm_email CHAR(512);
>         parm_returnCode INT(10);
>        END-PI;
>
>        DCL-DS preg LIKEDS(REGEX_T) INZ;
>        DCL-S regex CHAR(512) INZ;
>        DCL-S email CHAR(512) INZ;
>        DCL-S cflags INT(10) INZ;
>        DCL-S pos INT(10) INZ;
>        DCL-S regexLength UNS(10) INZ;
>        DCL-S stringLength UNS(10) INZ;
>        DCL-S arrRegMatch LIKE(REGMATCH_T) DIM(5) INZ;
>
>        DCL-DS chrInt QUALIFIED INZ;
>          charVal CHAR(1);
>          intVal UNS(3) POS(1);
>        END-DS;
>
>        cflags = REG_EXTENDED + REG_ICASE;
>        regex = '^([a-zA-Z0-9äöüÄÖÜß_\-\.]+)' +
>                '@([a-zA-Z0-9äöüÄÖÜß_\-\.]+)\.([a-zA-Z.])+' + X'00';
>        //%STR(%ADDR(email):512) = parm_email;
>        email = parm_email;
>        parm_returnCode = regcomp(preg:
>                                  regex:
>                                  cflags);
>        IF parm_returnCode = 0;
>          pos = %SCAN(X'00':email);
>          IF pos = 0;
>            pos = %SIZE(email);
>            DOW pos > 0;
>              chrInt.charVal = %SUBST(email:pos:1);
>              IF chrInt.intVal = 0 or
>                 chrInt.charVal = ' ';
>                 pos -= 1;
>              ELSE;
>                %SUBST(email:pos+1:1) = X'00';
>                LEAVE;
>              ENDIF;
>            ENDDO;
>          ENDIF;
>          parm_returnCode = regexec(preg:
>                                    email:
>                                    1:
>                                    arrRegMatch:
>                                    0);
>          regfree(preg);
>        ENDIF;
>        *INLR = *ON;
> --
> This is the RPG programming on IBM i (RPG400-L) mailing list
> To post a message email: RPG400-L@xxxxxxxxxxxxxxxxxx
> To subscribe, unsubscribe, or change list options,
> visit: https://lists.midrange.com/mailman/listinfo/rpg400-l
> or email: RPG400-L-request@xxxxxxxxxxxxxxxxxx
> Before posting, please take a moment to review the archives
> at https://archive.midrange.com/rpg400-l.
>
> Please contact support@xxxxxxxxxxxxxxxxxxxx for any subscription related
> questions.
>
> Help support midrange.com by shopping at amazon.com with our affiliate
> link: https://amazon.midrange.com