*==================================================================== * ILE-RPG module EMLDSTA * E-mail a message to a distribution list- DSTTYPE(A) * This module belongs to pgm EMLDST. * * After compiling this module, * create the programn as follow: * CRTPGM PGM(MMAIL/EMLDST) MODULE(MMAIL/EMLDST MMAIL/EMLDSTA * MMAIL/EMLDSTB) ACTGRP(*CALLER) AUT(*USE) * *==================================================================== /copy *LIBL/qrpglesrc,hspecs * File SENDERIDS- Used to identify the sender of the message FSENDERIDS if e k disk usropn * File DSTRLISTS- Used to define the recipients for a given distribution list FDSTRLISTS if e k disk usropn /copy *LIBL/qrpglesrc,prototypeb /copy *LIBL/qrpglesrc,mailproto /copy *LIBL/qrpglesrc,usec /copy *LIBL/qrpglesrc,variables3 * Main procedure Prototype and Interface D EMLDSTA PR D SenderID 20 D Subject 70 D TextStmf 256 D DataLib 10 D DstL 4 D AttachStmf 256 D myAttachType 50 D NbrReceivers 10i 0 D EMLDSTA PI D SenderID 20 D Subject 70 D TextStmf 256 D DataLib 10 D DstL 4 D AttachStmf 256 D myAttachType 50 D NbrReceivers 10i 0 * D DstLAll s like(DstL) inz('*ALL') D exeEnv s 1 D cmd s 500 D email s 256 D TempStmf s 512 D ReturnPth s 256 D MimeSName s 50 D MimeSEmail s 50 D ToNameArr s 50 dim(1000) D ToAddrArr s 256 dim(1000) D ToDistArr s 10i 0 dim(1000) D MimeFSubj s 70 D TextFile s 512 D Charset s 50 inz('iso-8859-1') D AtchFName s 512 D ContType s 21 D BinFlag s 1 D r s 10i 0 D ImbAtt s 10i 0 D FromAddr s 255 D CpfID s 7 D module s 10 D topgmq s 5 inz('*PRV') D msgtype s 7 inz('*INFO') D msg s 512 *===================================================================== * * Open files C exsr OpnF * Check the sender's ID C SenderID chain sidrcd C if not %found C eval msg='Sender ID "' + %trim(SenderID) + C '" not found in file ' + C %trim(DataLib) + '/SENDERIDS.' C exsr SndErrMsg C endif * Scan file DSTRLISTS, send an e-mail to each valid addressee *================== C eval nbrReceivers=0 * C if DstL<>DstlAll C DstL setll dstrcd C DstL reade dstrcd C else C read dstrcd C endif * C DOW not %eof C IF dststatus='1' and C dstemail<>' ' C eval email=dstemail C eval rc=VldEmail(email) C if rc=0 C exsr SndEmail C else C eval msg='E-mail address "' + %trim(email) + C '" not valid.' C exsr SndWrnMsg C endif C ENDIF C if DstL<>DstlAll C DstL reade dstrcd C else C read dstrcd C endif C ENDDO *================== * Back to caller C exsr Exit *===================================================================== * Send the E-mail to one addressee *===================================================================== C SndEmail begsr C eval nbrReceivers=nbrReceivers+1 * Create MIME temporary stream file C eval TempStmf=TempCrtF * Add the return path header C eval ReturnPth=sidrpth C callp MimeRtnPth(TempStmf:ReturnPth) * Add the Sender header C eval MimeSName =sidname C eval MimeSEmail=sidemail C callp MimeSender(TempStmf: C MimeSName:MimeSEmail) * Add the To header C eval ToNameArr(1)=%trim(dstfname) + ' ' + C %trim(dstlname) C eval ToAddrArr(1)=%trim(dstemail) C eval ToDistArr(1)=0 C eval ToNameArr(2)=' ' C eval ToAddrArr(2)=' ' C callp MimeDistr(TempStmf:ToNameArr: C ToAddrArr:ToDistArr) * Add the Subject header C eval MimeFSubj=Subject C callp MimeSubj(TempStmf:MimeFSubj) * Add the "Content-Type: MULTIPART/MIXED; ..." header C callp MimeMultiP(TempStmf) * Include the external message text as multipart/alternative C eval TextFile=TextStmf C eval rc=MimeImbTxtF(TempStmF:TextFile: C charset) * Add the attachment, if requested so C if AttachStmf<>'/NIL' C eval AtchFName=AttachStmf C eval ContType=myAttachType C eval BinFlag='Y' C eval r=%scan('text/':ContType) C if r=1 C eval BinFlag='N' C endif C eval ImbAtt=2 C callp MimeImbAtt(TempStmf:AtchFName: C ContType:BinFlag:ImbAtt) C endif * Close the MIME file by the part delimiter followed by "--" C callp MimeClose(TempStmf ) * Send the MIME message C eval FromAddr=MimeSEmail C eval CpfID=SendMail(TempStmf:FromAddr: C ToAddrArr:ToDistArr) * C endsr *===================================================================== * Open files *===================================================================== C OpnF begsr * C if not %open(SENDERIDS) C eval rc=docmd('ovrdbf SENDERIDS '+ C %trim(datalib) + '/SENDERIDS + C secure(*yes) ovrscope(*job)') C open SENDERIDS C endif * C if not %open(DSTRLISTS) C eval rc=docmd('ovrdbf DSTRLISTS '+ C %trim(datalib) + '/DSTRLISTS + C secure(*yes) ovrscope(*job)') C open DSTRLISTS C endif * C endsr *===================================================================== * Close files *===================================================================== C CloF begsr * C if %open(SENDERIDS) C close SENDERIDS C eval rc=docmd('dltovr SENDERIDS lvl(*job)') C endif * * C if %open(DSTRLISTS) C close DSTRLISTS C eval rc=docmd('dltovr DSTRLISTS lvl(*job)') C endif * C endsr *===================================================================== * Send warning message *===================================================================== C SndWrnMsg begsr C eval module=psdsPgmnam C callp SndPgmMsg(module:topgmq:msgtype:msg) * C endsr *===================================================================== * Send error message *===================================================================== C SndErrMsg begsr C eval module=psdsPgmnam C callp SndPgmMsg(module:topgmq:msgtype:msg) C exsr Exit * C endsr *===================================================================== * Back to caller *===================================================================== C Exit begsr C exsr CloF C eval *inlr=*on C return * C endsr