詳細は、製品より提供されている RPG ソース・ファイル QRPGLRSRC、および QCLSRC ソース・ファイルの CRTDEMO プログラムのソースを参照してください。
この例では、コードを調整する必要があり、サーバー、メール アドレスの値の提供も必要です。
H OPTION(*SRCSTMT : *NODEBUGIO) DFTACTGRP(*NO) ACTGRP(*CALLER) H BNDDIR('JSMBNDDIR') * * V6R1 - Limits * Maximum data structure size is 16,773,104 bytes * Data structure size = element size * occurrence * D ListDef1 S 60A DIM(2) CTDATA D ListDefSize S 10I 0 INZ(0) D ListEntSize S 10I 0 INZ(0) D ListCount S 10I 0 INZ(0) D ListMaxCount S 10I 0 INZ(0) * D JSMHDL S 4A INZ(*BLANKS) D JSMSRV S 50A INZ(*BLANKS) D JSMSTS S 20A INZ(*BLANKS) D JSMMSG S 512A INZ(*BLANKS) D JSMCMD S 512A INZ(*BLANKS) D ZEROLENGTH S 10I 0 INZ(0) * D TO S 80A D FROM S 80A D SUBJECT S 80A * D LST1 DS OCCURS(10) D TEXT 80A D CNTRL 1A * * JSMX_BEGIN * C CALLB(D) 'JSMX_BEGIN' C PARM *OMIT C PARM ZEROLENGTH * * JSMX_OPEN - USE JSMCLTDTA FOR SERVER * C CLEAR JSMSRV C EVAL JSMSRV = '' C CALLB(D) 'JSMX_OPEN' C PARM JSMHDL C PARM JSMSRV C PARM JSMSTS C PARM JSMMSG C CALLP checkSTS(JSMSTS:JSMMSG) * * SERVICE_LOAD * C CLEAR JSMCMD C EVAL JSMCMD = 'SERVICE_LOAD' + C ' SERVICE(SMTPMailService)' + C ' TRACE(*YES)' C CALLB(D) 'JSMX_COMMAND' C PARM JSMHDL C PARM JSMCMD C PARM JSMSTS C PARM JSMMSG C CALLP checkSTS(JSMSTS:JSMMSG) * * SET SERVER * C CLEAR JSMCMD C EVAL JSMCMD = 'SET' + C ' SERVER(10.2.0.200)' + C ' USER(testuser)' + C ' PASSWORD(testuser)' C CALLB(D) 'JSMX_COMMAND' C PARM JSMHDL C PARM JSMCMD C PARM JSMSTS C PARM JSMMSG C CALLP checkSTS(JSMSTS:JSMMSG) * * SET ADDRESS * C EVAL TO = 'user.name@lansa.com.au' C EVAL FROM = 'user.name@lansa.com.au' C EVAL SUBJECT = 'Test subject' * C CLEAR JSMCMD C EVAL JSMCMD = 'SET' + C ' TO(' + TO + ')' + C ' FROM(' + FROM + ')' + C ' SUBJECT(' + SUBJECT + ')' C CALLB(D) 'JSMX_COMMAND' C PARM JSMHDL C PARM JSMCMD C PARM JSMSTS C PARM JSMMSG C CALLP checkSTS(JSMSTS:JSMMSG) * * SEND - BIND LIST * C 1 OCCUR LST1 C EVAL TEXT = 'Line 1' C EVAL CNTRL = ' ' C 2 OCCUR LST1 C EVAL TEXT = 'Line 2' C EVAL CNTRL = ' ' * * Reset list to beginning C 1 OCCUR LST1 C EVAL ListDefSize = %SIZE(ListDef1:*ALL) C EVAL ListEntSize = %SIZE(LST1) C EVAL ListCount = 2 C EVAL ListMaxCount = %ELEM(LST1) C CALLB(D) 'JSMX_BINDLST' C PARM JSMHDL C PARM ListDef1 C PARM ListDefSize C PARM LST1 C PARM ListEntSize C PARM ListCount C PARM ListMaxCount C PARM JSMSTS C PARM JSMMSG C CALLP checkSTS(JSMSTS:JSMMSG) * * SEND * C CLEAR JSMCMD C EVAL JSMCMD = 'SEND' C CALLB(D) 'JSMX_COMMAND' C PARM JSMHDL C PARM JSMCMD C PARM JSMSTS C PARM JSMMSG C CALLP checkSTS(JSMSTS:JSMMSG) * * SERVICE_UNLOAD * C CLEAR JSMCMD C EVAL JSMCMD = 'SERVICE_UNLOAD' C CALLB(D) 'JSMX_COMMAND' C PARM JSMHDL C PARM JSMCMD C PARM JSMSTS C PARM JSMMSG C CALLP checkSTS(JSMSTS:JSMMSG) * * JSMX_CLOSE * C CALLB(D) 'JSMX_CLOSE' C PARM JSMHDL C PARM JSMSTS C PARM JSMMSG C CALLP checkSTS(JSMSTS:JSMMSG) * * JSMX_END * C CALLB(D) 'JSMX_END' * C SETON LR ******************************** * Procedure to check JSM status ******************************** P checkSTS B D checkSTS PI N D csJSMSTS CONST LIKE(JSMSTS) D csJSMMSG CONST LIKE(JSMMSG) D csMSGTXT S 512A C IF csJSMSTS <> 'OK' C EVAL csMSGTXT = %TRIM(csJSMSTS) + ' ' + C %TRIM(csJSMMSG) C CALLP sendMSG(csMSGTXT) C RETURN *OFF C ENDIF C RETURN *ON P E ************************************** * Procedure to send a program message ************************************** P sendMSG B D sendMSG PI D smMSGTXT 512A VALUE D smMSGT S 10A INZ('*DIAG') D smMSGI S 7A INZ('CPF9897') D smMSGF S 20A INZ('QCPFMSG *LIBL ') D smMSGL S 10I 0 INZ(%SIZE(smMSGTXT)) D smSTKE S 10A INZ('*') D smSTKC S 10I 0 INZ(1) D smMSGK S 4A INZ(*BLANK) D smERRC S 10I 0 INZ(0) C CALL 'QMHSNDPM' C PARM smMSGI C PARM smMSGF C PARM smMSGTXT C PARM smMSGL C PARM smMSGT C PARM smSTKE C PARM smSTKC C PARM smMSGK C PARM smERRC P E **CTDATA ListDef1TEXT A000008000CNTRL A000000100