*====================================================================
* 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