****************************************************************** ** ** UserGetSMTP Get User SMTP address ** ****************************************************************** H datedit(*YMD) NOMAIN option(*srcstmt : *nodebugio) H copyright('(C) Figu Data AS 1998') D/copy srv_pr ****************************************************************** ** Get User SMTP address (e-mail address) ****************************************************************** P UserGetSMTP b export D pi 256 D xUser 10 const D spc c const('[@$') D nor c const('ÆØÅ') D QOKSCHD pr extpgm('QOKSCHD') D Rcv like(SRCV0100) D RcvLen 9b 0 const D RcvFmt 8 const D Function 10 const D KeepTemp 1 const D Req const like(SREQ0100) D ReqLen 9b 0 const D ReqFmt 8 const D ErrorCode 8 D ds D wErr 8 D wErr1 9b 0 inz(8) overlay(wErr) D wErr2 9b 0 inz overlay(wErr:5) D SREQ0100 ds d rq0100ccsid 9b 0 inz d rq0100cs 9b 0 inz d rq0100cp 9b 0 inz d rq0100wldc 4 inz d rq0100cvt 1 inz('0') d rq0100schdta 1 inz('0') d rq0100vfy 1 inz('1') d rq0100cont 1 inz('0') d rq0100rsc 16 inz d rq0100srafmt 8 inz('SREQ0101') d rq0100sraoff 9b 0 inz(110) rq0100rq0101 d rq0100srasiz 9b 0 inz(1) d rq0100aoffmt 8 inz('SREQ0103') d rq0100aofoff 9b 0 inz(100) rq0100rq0103 d rq0100aofsiz 9b 0 inz(1) d rq0100aoufmt 8 inz('SRCV0101') d rq0100aousiz 9b 0 inz(1) d rq0100auffmt 8 inz('SRCV0111') d rq0100ooffmt 8 inz d rq0100order 1 inz('0') d rq0100res 3 d rq0100rq0103 like(sreq0103) d rq0100rq0101 like(sreq0101) D SREQ0101 ds d rq0101len 9b 0 inz(%size(sreq0101)) d rq0101cv 1 inz('1') d rq0101field 10 inz('USER') d rq0101prod 7 inz('*IBM') d rq0101case 1 inz d rq0101res 1 inz d rq0101vlen 9b 0 inz(%size(rq0101val)) d rq0101val 10 D SREQ0103 ds d rq0102spc 10 inz('*SMTP') D prcv0100 s * D SRCV0100 ds 32767 based(prcv0100) d rc0100byt 9b 0 d rc0100fldoff 9b 0 d rc0100usroff 9b 0 d rc0100nbrent 9b 0 d rc0100cnt 1 d rc0100rsc 16 d rc0100rc0101 like(srcv0101) D prcv0101 s * D SRCV0101 ds based(prcv0101) d rc0101len 9b 0 d rc0101nbrfld 9b 0 D prcv0111 s * D SRCV0111 ds based(prcv0111) d rc0111fld 10 d rc0111prod 7 d rc0111res 3 d rc0111cs 9b 0 d rc0111cp 9b 0 d rc0111len 9b 0 D prcv0111val s * D SRCV0111val ds based(prcv0111val) d rc0111val 256 d wi s 3 0 d wsmtp s 256 d wsmtpdmn s 256 d wsmtpusrid s 64 C nor:spc xlate xUser rq0101val c eval rq0100rq0103 = sreq0103 c eval rq0100rq0101 = sreq0101 C alloc 32767 prcv0100 C callp QOKSCHD (SRCV0100 : %size(SRCV0100) : C 'SRCV0100' : '*SEARCH' : '0' : SREQ0100 : C %size(SREQ0100) : 'SREQ0100' : wErr) C if wErr2 <> 0 or rc0100nbrent = 0 C eval wsmtp = *blanks C else C eval prcv0101 = prcv0100 + rc0100usroff C eval prcv0111 = prcv0101 + %size(srcv0101) C eval prcv0111val = prcv0111 + %size(srcv0111) C eval wi = 1 C dow wi < rc0101nbrfld C eval wi = wi + 1 C select C when rc0111fld = 'SMTPUSRID' C eval wsmtpusrid = %subst(rc0111val : 1 : C rc0111len) C when rc0111fld = 'SMTPDMN' C eval wsmtpdmn = %subst(rc0111val : 1 : C rc0111len) C endsl C eval prcv0111 = prcv0111 + %size(srcv0111) + c rc0111len C eval prcv0111val = prcv0111 + %size(srcv0111) C enddo C eval wsmtp = %trim(wsmtpusrid) + '@' + wsmtpdmn C endif C dealloc prcv0100 C return wsmtp P UserGetSMTP e