詳細は、製品より提供されている RPG ソース・ファイル QRPGLRSRC、および QCLSRC ソース・ファイルの CRTDEMO プログラムのソースを参照してください。
このサービスでは、JSM インスタンス・フォルダに含まれているファイルを使用します。
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 FieldDef1 S 60A DIM(11) CTDATA D FieldDefSize S 10I 0 INZ(0) D FieldEntSize S 10I 0 INZ(0) D ListDef1 S 60A DIM(1) CTDATA D ListDef2 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 FLD1 DS D PRDID 10A INZ('CORD443') D PRDAVL 200A D PRDDSC 200A D PRDAMTMP 10P 2 INZ(499.99) D PRDAMTYP 10P 2 INZ(499.99) D PRDAMTB10 10P 2 INZ(431.99) D PRDAMTB20 10P 2 INZ(413.99) D PRDAMTB30 10P 2 INZ(359.99) D PRDCOUNT 3S 0 INZ(25) D PRDDATE D DATFMT(*ISO) D PRDDATETIME Z * D LST1 DS OCCURS(10) D TEXT 30A * D LST2 DS OCCURS(10) D COL1 10A D COL2 10A D COL3 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(PDFDocumentService)' + 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 ' DOCUMENT(demo.pdf)' + C ' CONTENT(demo-product.xml)' C CALLB(D) 'JSMX_COMMAND' C PARM JSMHDL C PARM JSMCMD C PARM JSMSTS C PARM JSMMSG C CALLP checkSTS(JSMSTS:JSMMSG) * * ADD PRODUCT - BIND FIELDS * C EVAL PRDAVL = 'Available in 24 hours' C EVAL PRDDSC = '18V Compact Hammer.' + C ' Power output 350W.' C EVAL PRDDATE = %DATE() C EVAL PRDDATETIME = %TIMESTAMP() * C EVAL FieldDefSize = %SIZE(FieldDef1:*ALL) C EVAL FieldEntSize = %SIZE(FLD1) C CALLB(D) 'JSMX_BINDFLD' C PARM JSMHDL C PARM FieldDef1 C PARM FieldDefSize C PARM FLD1 C PARM FieldEntSize C PARM JSMSTS C PARM JSMMSG C CALLP checkSTS(JSMSTS:JSMMSG) * * ADD PRODUCT - BIND LIST * C 1 OCCUR LST1 C EVAL TEXT = '4-piece combo kit' C 2 OCCUR LST1 C EVAL TEXT = '3-speed transmission' * * 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) * * ADD PRODUCT * C CLEAR JSMCMD C EVAL JSMCMD = 'ADD' + C ' CONTENT(product)' C CALLB(D) 'JSMX_COMMAND' C PARM JSMHDL C PARM JSMCMD C PARM JSMSTS C PARM JSMMSG C CALLP checkSTS(JSMSTS:JSMMSG) * * ADD TABLE - BIND LIST * C 1 OCCUR LST2 C EVAL COL1 = 'Text 11' C EVAL COL2 = 'Text 12' C EVAL COL3 = 100.34 C 2 OCCUR LST2 C EVAL COL1 = 'Text 21' C EVAL COL2 = 'Text 22' C EVAL COL3 = 145.67 * * Reset list to beginning C 1 OCCUR LST2 C EVAL ListDefSize = %SIZE(ListDef2:*ALL) C EVAL ListEntSize = %SIZE(LST2) C EVAL ListCount = 2 C EVAL ListMaxCount = %ELEM(LST2) C CALLB(D) 'JSMX_BINDLST' C PARM JSMHDL C PARM ListDef2 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) * * ADD TABLE * C CLEAR JSMCMD C EVAL JSMCMD = 'ADD' + C ' CONTENT(table)' 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 FieldDef1PRDID A000001000PRDAVL A000020000PRDDSC A000020000PRDAMTMP P000001002PRDAMTYP P000001002PRDAMTB10 P000001002PRDAMTB20 P000001002PRDAMTB30 P000001002PRDCOUNT S000000300PRDDATE A000001000PRDDATETIME A000002600**CTDATA ListDef1TEXT A000003000**CTDATA ListDef2COL1 A000001000COL2 A000001000COL3 P000001002