RTVSMTPADR: PGM PARM(&PUSRID &PUSRADDR &PSMTPADR) /* + &smtpadr */ DCL VAR(&PUSRID) TYPE(*CHAR) LEN(10) DCL VAR(&PUSRADDR) TYPE(*CHAR) LEN(10) DCL VAR(&PSMTPADR) TYPE(*CHAR) LEN(256) DCL VAR(&USRID) TYPE(*CHAR) LEN(10) DCL VAR(&USRADDR) TYPE(*CHAR) LEN(10) DCL VAR(&SMTPADR) TYPE(*CHAR) LEN(256) DCL VAR(&SMTPUSRID) TYPE(*CHAR) LEN(64) DCL VAR(&SMTPDMN) TYPE(*CHAR) LEN(256) DCL VAR(&RCVVAR) TYPE(*CHAR) LEN(1000) DCL VAR(&RCVVARLEN) TYPE(*CHAR) LEN(4) + VALUE(X'000003E8') DCL VAR(&RCVFORMAT) TYPE(*CHAR) LEN(8) + VALUE(SRCV0100) DCL VAR(&FUNCT) TYPE(*CHAR) LEN(10) VALUE(*SEARCH) DCL VAR(&KEEPTEMP) TYPE(*CHAR) LEN(1) VALUE('0') DCL VAR(&REQVAR) TYPE(*CHAR) LEN(1000) DCL VAR(&REQVARLEN) TYPE(*CHAR) LEN(4) + VALUE(X'000003E8') DCL VAR(&REQFORMAT) TYPE(*CHAR) LEN(8) + VALUE(SREQ0100) DCL VAR(&ERRCOD) TYPE(*CHAR) LEN(8) + VALUE(X'0000000000000000') DCL VAR(&SREQ0103) TYPE(*CHAR) LEN(10) DCL VAR(&SREQ0101) TYPE(*CHAR) LEN(76) DCL VAR(&DTAOFFSET) TYPE(*DEC) LEN(5) DCL VAR(&NBRFLDRTN) TYPE(*DEC) LEN(5) DCL VAR(&FLDLEN) TYPE(*DEC) LEN(5) DCL VAR(&X0) TYPE(*CHAR) LEN(4) VALUE(X'00000000') DCL VAR(&X1) TYPE(*CHAR) LEN(4) VALUE(X'00000001') DCL VAR(&X2) TYPE(*CHAR) LEN(4) VALUE(X'00000002') DCL VAR(&X10) TYPE(*CHAR) LEN(4) VALUE(X'0000000A') DCL VAR(&X38) TYPE(*CHAR) LEN(4) VALUE(X'00000026') DCL VAR(&X100) TYPE(*CHAR) LEN(4) + VALUE(X'00000064') DCL VAR(&X110) TYPE(*CHAR) LEN(4) + VALUE(X'0000006E') /* */ /* Grab input parm values... */ /* */ CHGVAR VAR(&USRID) VALUE(&PUSRID) CHGVAR VAR(&USRADDR) VALUE(&PUSRADDR) /* */ /* Set initial request variable... */ /* */ /* CCSID of data input bin(4) 0 */ /* Character set of data input bin(4) 0 */ /* Code page of data input bin(4) 0 */ /* Wildcard character char(4) blank */ /* Convert receiver data indicator char(1) '0' */ /* Data to search char(1) '0' */ /* Run verify indicator char(1) '1' */ /* Continuation handle (input) char(1) '0' */ /* Resource handle char(16) blank */ /* Format name of the search request array char(8) 'SREQ0101' */ /* Offset to the search request array bin(4) 110 dec */ /* Number of elements in the search request bin(4) 2 dec */ /* array */ /* Format name of array of fields to return char(8) 'SREQ0103' */ /* Offset to array of fields to return bin(4) 100 dec */ /* Number of elements in the fields to return bin(4) 1 dec */ /* array */ /* Format name of array of users to return in char(8) 'SRCV0101' */ /* the receiver variable */ /* Number of elements to return in the array of bin(4) 1 dec */ /* users to return */ /* Format name of array of fields for each user char(8) 'SRCV0112' */ /* returned */ /* Format name of the order of field names to char(8) blank */ /* return */ /* Return fields in order specified option char(1) '0' */ /* Reserved char(3) blank */ /* Array of fields to return char(*) */ /* Search request array char(*) */ CHGVAR VAR(&REQVAR) VALUE(&X0 *CAT &X0 *CAT &X0 + *CAT ' ' *CAT '0' *CAT '0' *CAT '1' + *CAT '0' *CAT ' ' *CAT + 'SREQ0101' *CAT &X110 *CAT &X2 *CAT + 'SREQ0103' *CAT &X100 *CAT &X1 *CAT + 'SRCV0101' *CAT &X1 *CAT 'SRCV0112' *CAT + ' ' *CAT '0' *CAT ' ') /* */ /* Set request format values... */ /* */ /* Set search values... */ CHGVAR VAR(&SREQ0101) VALUE(&X38 *CAT '1' *CAT + 'USRID ' *CAT '*IBM ' *CAT '0' *CAT + ' ' *CAT &X10 *CAT &USRID *CAT &X38 *CAT + '1' *CAT 'USRADDR ' *CAT '*IBM ' *CAT + '0' *CAT ' ' *CAT &X10 *CAT &USRADDR) /* Set request fields... */ CHGVAR VAR(&SREQ0103) VALUE('*SMTP') /* Finalize request variable... */ CHGVAR VAR(%SST(&REQVAR 101 86)) VALUE(&SREQ0103 + *CAT &SREQ0101) /* */ /* Call directory search API... */ /* */ CALL PGM(QOKSCHD) PARM(&RCVVAR &RCVVARLEN &RCVFORMAT &FUNCT + &KEEPTEMP &REQVAR &REQVARLEN &REQFORMAT &ERRCOD) /* */ /* Extract retrieved data... */ /* */ /* Extract offset to retrieved data... */ CHGVAR VAR(&DTAOFFSET) VALUE(%BIN(&RCVVAR 9 4) + 1) /* Bump offset past 4-byte binary... */ CHGVAR VAR(&DTAOFFSET) VALUE(&DTAOFFSET + 4) CHGVAR VAR(&NBRFLDRTN) VALUE(%BIN(&RCVVAR + &DTAOFFSET 4)) /* Bump offset past Number of fields returned... */ CHGVAR VAR(&DTAOFFSET) VALUE(&DTAOFFSET + 4) /* */ /* We're now at the beginning of Array of fields for each user... */ /* */ /* Bump offset past first character set and code page... */ CHGVAR VAR(&DTAOFFSET) VALUE(&DTAOFFSET + 8) /* Extract this Length of field value returned... */ CHGVAR VAR(&FLDLEN) VALUE(%BIN(&RCVVAR &DTAOFFSET 4)) /* Bump offset past 4-byte binary... */ CHGVAR VAR(&DTAOFFSET) VALUE(&DTAOFFSET + 4) /* Extract this Field value for SMTPUSRID... */ CHGVAR VAR(&SMTPUSRID) VALUE(%SST(&RCVVAR + &DTAOFFSET &FLDLEN)) /* Bump offset past this Field value... */ CHGVAR VAR(&DTAOFFSET) VALUE(&DTAOFFSET + &FLDLEN) /* Bump offset past second character set and code page... */ CHGVAR VAR(&DTAOFFSET) VALUE(&DTAOFFSET + 8) /* Extract this Length of field value returned... */ CHGVAR VAR(&FLDLEN) VALUE(%BIN(&RCVVAR &DTAOFFSET 4)) /* Bump offset past 4-byte binary... */ CHGVAR VAR(&DTAOFFSET) VALUE(&DTAOFFSET + 4) /* Extract this Field value for SMTPDMN... */ CHGVAR VAR(&SMTPDMN) VALUE(%SST(&RCVVAR &DTAOFFSET + &FLDLEN)) /* Bump offset past this Field value... */ CHGVAR VAR(&DTAOFFSET) VALUE(&DTAOFFSET + &FLDLEN) /* */ /* Construct proper SMTP mailing address from extracted values... */ /* */ CHGVAR VAR(&SMTPADR) VALUE(&SMTPUSRID *TCAT '@' + *CAT &SMTPDMN) /* */ /* Set output parm value... */ /* */ CHGVAR VAR(&PSMTPADR) VALUE(&SMTPADR) RETURN ENDPGM