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

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;