詳細は、製品より提供されている RPG ソース・ファイル QRPGLRSRC、および QCLSRC ソース・ファイルの CRTDEMO プログラムのソースを参照してください。
この例では、事前にフォルダを 1 つ作成する必要があり、アーカイブ用のサンプル・ファイルも準備しておかなければいけません。
H OPTION(*SRCSTMT : *NODEBUGIO) DFTACTGRP(*NO) ACTGRP(*CALLER) H BNDDIR('JSMBNDDIR') * 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) * * 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(ZIPService)' + 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 FILE * C CLEAR JSMCMD C EVAL JSMCMD = 'CREATE FILE(MyZip.zip)' C CALLB(D) 'JSMX_COMMAND' C PARM JSMHDL C PARM JSMCMD C PARM JSMSTS C PARM JSMMSG C CALLP checkSTS(JSMSTS:JSMMSG) * * ADD PATH * C CLEAR JSMCMD C EVAL JSMCMD = 'ADD' + C ' PATH(/archive)' 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