*===================================================================== * Example of customized mail * * create the program as follow: * * CRTPGM MMAIL/CUSTEMAIL MODULE(MMAIL/CUSTEMAIL MMAIL/RTVCUSTEM) ACTGRP(*CALLER) * *===================================================================== /copy MMAIL/qrpglesrc,hspecs /copy MMAIL/qrpglesrc,hspecsbnd * Customer file Fcontacts if a e k disk usropn F extfile('MMAILDATA/CONTACTS') * Display file Fcustemail cf e workstn usropn F sfile(sfl:line) F extfile('MMAIL/CUSTEMAIL') /copy MMAIL/qrpglesrc,mailproto /copy MMAIL/qrpglesrc,prototypeb /copy MMAIL/qrpglesrc,variables3 /copy MMAIL/qrpglesrc,usec * procedure to retrieve/update the name of the stream file input to this program D rtvcustem pr EXTPROC('RTVCUSTEM') D action 3 D stmfname 50 * D sndremail256 s 256 D action s 3 D stmfname s 50 D mmaildata s 10 inz('MMAILDATA') D addedInd s n D Howmany s 10i 0 * The following is the "mother letter" to be customized D inpStmf s 1024 varying * The following is the customized letter D outStmf s 1024 varying * D IfsFileNam s 1024 D IfsFileSiz s 20u 0 D IfsCrtStamp s z D JobCCSIDs s 10 D extension s 5 D htmlInd s n D myCharset s 50 varying D MimeFName s 512 D MimeSName s 50 D MimeSEmail s 50 D MimeFSubj s 70 D FromFName s 512 * Arrays used by subprocedure MimeDistr D ToNameArr s 50 dim(1000) D ToAddrArr s 256 dim(1000) D ToDistArr s 10i 0 dim(1000) * D TxtVarArr s 10 dim(500) D TxtValArr s 500 dim(500) * Variables used by subprocedure SendMail D CpfID s 7 D FromAddr s 255 D ValidEmail s 10i 0 inz(1) No e-mail check D l s 10i 0 D r s 10i 0 /free //===================================================================== // Main line //===================================================================== // If needed, set the CCSID of the current job and // of the QMSF jobs to the job default CCSID setDftCCSID(); // Let the user enter data exsr DoOpen; dow *in03=*off and *in12=*off; exsr loadSfl; write foot; *in90=*off; *in70=*on; exfmt ctl; if *in03 or *in12; exsr Exit; endif; exsr DoAdd; if addedInd=*on; iter; endif; if *in23; exsr ClrConta; iter; endif; if *in10; exsr SendNow; endif; enddo; //===================================================================== // Load contacts subfile //===================================================================== Begsr Loadsfl; line=0; *in70=*off; *in71=*off; write ctl; contaemail=*loval; setll contaemail contarcd; read contarcd; dow not %eof; *in71=*on; line+=1; fullname=%trim(contafname)+' '+%trim(contalname); write sfl; if contaemail=contaemain; linepos=line; endif; read contarcd; enddo; linelst=line; if linepos<1 or linepos>linelst; linepos=1; endif; contaemain=' '; contafnamn=' '; contalnamn=' '; Endsr; //===================================================================== //* Add customer contact record //===================================================================== Begsr DoAdd; addedInd=*off; if contaemaiN<>' ' and contafnamN<>' ' and contalnamN<>' '; contaemail=contaemaiN; contafname=contafnamN; contalname=contalnamN; addedInd=*on; monitor; write contarcd; on-error; addedInd=*off; endmon; endif; Endsr; //================================================================== // Close database file CONTACTS //================================================================== Begsr ClrConta; // Close database file CONTACTS if %open(CONTACTS); close contacts; endif; // Clear database file CONTACTS rc = doCmd('clrpfm mmaildata/contacts'); // Open database file CONTACTS if not %open(CONTACTS); open CONTACTS; endif; Endsr; //================================================================== // Send customized letters, one to each customer //================================================================== Begsr SendNow; // 1- Retrieve the name of the stream file input to this program action='RTV'; rtvcustem(action:stmfname); msgstmf=stmfname; // 2- Ask sender's data and subject dow *in03=*off and *in12=*off; exfmt sndrfmt; *in72=*off; //reset error message *in81=*off; //reset error message *in82=*off; //reset error message *in83=*off; //reset error message *in83=*off; //reset error message if *in03; exsr Exit; endif; if *in12; leave; endif; if sndremail<>' '; sndremail256=sndremail; rc=vldEmail(sndremail256); if rc<>0; *in72=*on; //error message iter; endif; endif; if sndrname=' ' or sndremail=' ' or msgsubj=' ' or msgstmf=' '; select; when sndrname=' '; *in81=*on; //error message when sndremail=' '; *in82=*on; //error message when msgsubj=' '; *in83=*on; //error message when msgstmf=' '; *in84=*on; //error message endsl; iter; else; IfsFileNam=msgstmf; rc=chkIfs4(IfsFileNam:IfsFileSiz:IfsCrtStamp); if rc<>0; *in84=*on; //error message iter; else; leave; endif; endif; enddo; // 3- Update the data area containing the name of the stream file input to this program stmfname=msgstmf; action='UPD'; rtvcustem(action:stmfname); // 4- Check the extension on the input stream file htmlInd=*off; l=%len(%trimr(stmfname)); r=l-%size(extension)+1; if r>0; extension=%subst(stmfname:r); extension=uppify(extension); r=%scan('.HTM':extension); if r>0; htmlInd=*on; //the input stream file contains HTML text endif; endif; // 5- Send the customized letters howmany=0; contaemail=*loval; setll contaemail contarcd; read contarcd; dow not %eof; howmany+=1; exsr SendOne; //send a customized letter read contarcd; enddo; // 6- Provide the feedback message fdbmessage='* '+%trim(%editc(howmany:'Z')) + ' customized letters have been sent.'; *in90=*on; Endsr; //================================================================== // Send a customized letter //================================================================== Begsr SendOne; // Fill in the variable names and the corresponding values TxtVarArr(1)='&1'; TxtValArr(1) = %trim(contafname) + ' ' + %trim(contalname); // Define the html stream file where the variables are to be substituted inpStmf=%trimr(stmfname); // Create the temporary html stream file where the variables are substituted outStmf=MimeVarTxt(inpStmf:TxtVarArr:TxtValArr); // Get the default character set myCharset=getDftCharset(); // Create the temporary MIME file to be sent MimeFName=TempCrtF(); // Add the Sender header MimeSName=sndrname; MimeSEMail=sndremail; FromAddr=sndremail; MimeSender(MimeFName:MimeSName:MimeSEmail); // Add the destination header toNameArr(1)=%trim(contafname)+' '+%trim(contalname); toAddrArr(1)=%trim(contaemail); toDistArr(1)=0; // to ... MimeDistr(MimeFName:ToNameArr:ToAddrArr:ToDistArr); // Add the subject header MimeFSubj=msgsubj; MimeSubj(MimeFName:MimeFSubj:myCharset); // Add the header // "Content-Type: MULTIPART/MIXED;" // followed by the "BOUNDARY" parameter MimeMultiP(MimeFName); // Embed the temporary html file with the resolved variables // as two multipart/alternatives, // one for text/plain, the other for text/html FromFName=outStmf; if htmlInd=*on; rc=MimeImbHtml(MIMEFName:FromFName:myCharSet); else; rc=MimeImbTxtF(MIMEFName:FromFName:myCharSet:'Y'); endif; // Close the MIME file (add the ending boundary) MimeClose(MimeFName); // Delete the temporary html stream file rc=docmd('del '''+outStmf+''''); // Send the temporary MIME file CpfID=SendMail(MimeFName:FromAddr: ToAddrArr:ToDistArr:ValidEmail); Endsr; //================================================================== // Open files //================================================================== Begsr DoOpen; // Open display file CUSTEMAIL if not %open(CUSTEMAIL); open CUSTEMAIL; endif; // Open database file CONTACTS if not %open(CONTACTS); open CONTACTS; endif; Endsr; //================================================================== // Close files //================================================================== Begsr DoClose; // Close display file CUSTEMAIL if %open(CUSTEMAIL); close CUSTEMAIL; endif; // Close database file CONTACTS if %open(CONTACTS); close contacts; endif; Endsr; //================================================================== // Back to caller //================================================================== Begsr Exit; exsr DoClose; *inlr=*on; return; Endsr;