Refer to shipped RPG source file QRPGLRSRC and CRTDEMO program source in QCLSRC source file.
This example is self contained and requires no additional work besides compilation.
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(3) 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 COUNT S 6S 0 INZ(0)
*
D LST1 DS OCCURS(9999)
D PRDID 10A
D PRDNME 20A
D PRDAMT 10P 2
*
D LST2 DS DIM(9999) QUALIFIED
D PRDID 10A
D PRDNME 20A
D PRDAMT 10P 2
*
* 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(ExcelService)' +
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)
*
* CREATE
*
C CLEAR JSMCMD
C EVAL JSMCMD = 'CREATE'
C CALLB(D) 'JSMX_COMMAND'
C PARM JSMHDL
C PARM JSMCMD
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* ADD OBJECT(*SHEET)
*
C CLEAR JSMCMD
C EVAL JSMCMD = 'ADD OBJECT(*SHEET)' +
C ' SHEET(MyTest)'
C CALLB(D) 'JSMX_COMMAND'
C PARM JSMHDL
C PARM JSMCMD
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* ADD OBJECT(*CELLSTYLE)
*
C CLEAR JSMCMD
C EVAL JSMCMD = 'ADD OBJECT(*CELLSTYLE)' +
C ' TYPE(*NUMBER)' +
C ' COLUMN(5) RANGE(10,20)' +
C ' FONT(*TAHOMA)' +
C ' FORMAT(*FORMAT4)' +
C ' HALIGN(*RIGHT)' +
C ' BACKGROUND(*YELLOW)'
C CALLB(D) 'JSMX_COMMAND'
C PARM JSMHDL
C PARM JSMCMD
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* WRITE LIST
*
C EVAL COUNT = 0
C 1 DO 20
C ADD 1 COUNT
C COUNT OCCUR LST1
C EVAL PRDID = 'ID' + %CHAR(COUNT)
C EVAL PRDNME = 'Product ' + %CHAR(COUNT)
C EVAL PRDAMT = 1000.45 + COUNT
C ENDDO
*
* Reset list to beginning
C 1 OCCUR LST1
C EVAL ListDefSize = %SIZE(ListDef1:*ALL)
C EVAL ListEntSize = %SIZE(LST1)
C EVAL ListCount = COUNT
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)
*
* WRITE R1C1
*
C CLEAR JSMCMD
C EVAL JSMCMD = 'WRITE R1C1(10,3)'
C CALLB(D) 'JSMX_COMMAND'
C PARM JSMHDL
C PARM JSMCMD
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* WRITE LIST 2
*
C EVAL COUNT = 0
C 1 DO 20
C ADD 1 COUNT
C EVAL LST2(COUNT).PRDID = 'ID' + %CHAR(COUNT)
C EVAL LST2(COUNT).PRDNME = 'NME' + %CHAR(COUNT)
C EVAL LST2(COUNT).PRDAMT = 2000.47 + COUNT
C ENDDO
*
C EVAL ListDefSize = %SIZE(ListDef1:*ALL)
C EVAL ListEntSize = %SIZE(LST2)
C EVAL ListCount = COUNT
C EVAL ListMaxCount = %ELEM(LST2)
C CALLB(D) 'JSMX_BINDLST'
C PARM JSMHDL
C PARM ListDef1
C PARM ListDefSize
C PARM LST2
C PARM ListEntSize
C PARM ListCount
C PARM ListMaxCount
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* WRITE R1C1
*
C CLEAR JSMCMD
C EVAL JSMCMD = 'WRITE R1C1(10,10)'
C CALLB(D) 'JSMX_COMMAND'
C PARM JSMHDL
C PARM JSMCMD
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* READ LIST 2
*
C CLEAR LST1
C CLEAR LST2
*
C EVAL ListDefSize = %SIZE(ListDef1:*ALL)
C EVAL ListEntSize = %SIZE(LST2)
C EVAL ListCount = 0
C EVAL ListMaxCount = %ELEM(LST2)
C CALLB(D) 'JSMX_BINDLST'
C PARM JSMHDL
C PARM ListDef1
C PARM ListDefSize
C PARM LST2
C PARM ListEntSize
C PARM ListCount
C PARM ListMaxCount
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* READ R1C1
*
C CLEAR JSMCMD
C EVAL JSMCMD = 'READ R1C1(10,15) ROWCOUNT(5)'
C CALLB(D) 'JSMX_COMMAND'
C PARM JSMHDL
C PARM JSMCMD
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* DSPLY ListCount
* DO LISTCOUNT COUNT
* EVAL PRDID = LST2(COUNT).PRDID
* EVAL PRDNME = LST2(COUNT).PRDNME
* EVAL PRDNME = %CHAR(LST2(COUNT).PRDAMT)
* DSPLY LST2(COUNT)
* DSPLY PRDNME
* ENDDO
*
* SAVE FILE
*
C CLEAR JSMCMD
C EVAL JSMCMD = 'SAVE' +
C ' FILE(demo.xlsx)'
C CALLB(D) 'JSMX_COMMAND'
C PARM JSMHDL
C PARM JSMCMD
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* CLOSE
*
C CLEAR JSMCMD
C EVAL JSMCMD = 'CLOSE'
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
PRDID A000001000
PRDNME A000002000
PRDAMT P000001002
