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