Refer to shipped RPG source file QRPGLRSRC and CRTDEMO program source in QCLSRC source file.
This example requires the code to be adjusted and server and email address values to be supplied.
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 ListDef1
TEXT A000008000
CNTRL A000000100
