詳細は、製品より提供されている RPG ソース・ファイル QRPGLRSRC、および QCLSRC ソース・ファイルの CRTDEMO プログラムのソースを参照してください。
この例では、コードを調整する必要があり、サーバー、ユーザー、パスワード、フォルダ、ファイルの値の提供も必要です。
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(FTPService)' + 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) * * CONNECT HOST * C CLEAR JSMCMD C EVAL JSMCMD = 'CONNECT' + C ' HOST(LANSA01)' C CALLB(D) 'JSMX_COMMAND' C PARM JSMHDL C PARM JSMCMD C PARM JSMSTS C PARM JSMMSG C CALLP checkSTS(JSMSTS:JSMMSG) * * LOGIN * C CLEAR JSMCMD C EVAL JSMCMD = 'LOGIN' + C ' USER(NAME)' + C ' PASSWORD(XXXX)' C CALLB(D) 'JSMX_COMMAND' C PARM JSMHDL C PARM JSMCMD C PARM JSMSTS C PARM JSMMSG C CALLP checkSTS(JSMSTS:JSMMSG) * * PUT * C CLEAR JSMCMD C EVAL JSMCMD = 'PUT' + C ' FROM(PATH1)' + C ' TO(PATH2)' C CALLB(D) 'JSMX_COMMAND' C PARM JSMHDL C PARM JSMCMD C PARM JSMSTS C PARM JSMMSG C CALLP checkSTS(JSMSTS:JSMMSG) * * QUIT * C CLEAR JSMCMD C EVAL JSMCMD = 'QUIT' 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