JSMDIRECT プログラムは、LANSA ファンクションを内部でのみ実行できます。LANSA プログラムの呼び出し時に 3GL プログラムを実行する必要がある、もしくはさらなる柔軟性が必要な場合、JSMLSAEXT プログラムを作成する必要があります。
この終了プログラムのソース・コードは、JSM ライブラリの QCLSRC に保管されます。
/ *JSM LANSA/RPG 終了プログラム */
PGM PARM(&SERVICE &SERVERHOST &HOST &PORT &REMOTEUSER &REMOTEADDR +
&PROCESS &FUNCTION &PARTITION &LANGUAGE &PROGRAM &RDMLX +
&CONTINUE &MESSAGE)
DCL VAR(&SERVICE) TYPE(*CHAR) LEN(30)
DCL VAR(&SERVERHOST) TYPE(*CHAR) LEN(80)
DCL VAR(&HOST) TYPE(*CHAR) LEN(80)
DCL VAR(&PORT) TYPE(*CHAR) LEN(5)
DCL VAR(&REMOTEUSER) TYPE(*CHAR) LEN(30)
DCL VAR(&REMOTEADDR) TYPE(*CHAR) LEN(45)
DCL VAR(&REQUEST) TYPE(*CHAR) LEN(10) VALUE(RUN)
DCL VAR(&PROCESS) TYPE(*CHAR) LEN(10)
DCL VAR(&FUNCTION) TYPE(*CHAR) LEN(10)
DCL VAR(&PARTITION) TYPE(*CHAR) LEN(3)
DCL VAR(&LANGUAGE) TYPE(*CHAR) LEN(4)
DCL VAR(&PROGRAM) TYPE(*CHAR) LEN(32)
DCL VAR(&RDMLX) TYPE(*CHAR) LEN(1)
DCL VAR(&CONTINUE) TYPE(*CHAR) LEN(1)
DCL VAR(&MESSAGE) TYPE(*CHAR) LEN(256)
DCL VAR(&PARM01) TYPE(*CHAR) LEN(256)
DCL VAR(&PARM02) TYPE(*CHAR) LEN(256)
DCL VAR(&PARM03) TYPE(*CHAR) LEN(256)
DCL VAR(&PARM04) TYPE(*CHAR) LEN(256)
DCL VAR(&PARM05) TYPE(*CHAR) LEN(256)
DCL VAR(&PARM06) TYPE(*CHAR) LEN(256)
DCL VAR(&PARM07) TYPE(*CHAR) LEN(256)
DCL VAR(&PARM08) TYPE(*CHAR) LEN(256)
DCL VAR(&PARM09) TYPE(*CHAR) LEN(256)
DCL VAR(&PARM10) TYPE(*CHAR) LEN(256)
DCL VAR(&TASKID) TYPE(*CHAR) LEN(8)
DCL VAR(&PCTYPE) TYPE(*CHAR) LEN(1) VALUE(N)
DCL VAR(&DEVELOPER) TYPE(*CHAR) LEN(1) VALUE(N)
DCL VAR(&ALLOWMSGS) TYPE(*CHAR) LEN(1) VALUE(N)
DCL VAR(&PCNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&DATESRC) TYPE(*CHAR) LEN(1) VALUE(S)
DCL VAR(&BDEBUG) TYPE(*CHAR) LEN(1) VALUE(N)
DCL VAR(&BDEBUGDEV) TYPE(*CHAR) LEN(10)
DCL VAR(&BDEBUGMSG) TYPE(*CHAR) LEN(10)
DCL VAR(&XRUNADPRM) TYPE(*CHAR) LEN(512)
DCL VAR(&CTIME) TYPE(*CHAR) LEN(6)
DCL VAR(&JOBMSG) TYPE(*CHAR) LEN(100)
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4)
MONMSG MSGID(CPF0000)
/* CONTINUE のデフォルト値は 'Y' /
/* CHGVAR VAR(&CONTINUE) VALUE('N') */
/* CHGVAR VAR(&MESSAGE) VALUE('I do not know you') */
/* GOTO END */
/* CALLSUBR SUBR(LOGSTR) */
IF COND(&PROGRAM *NE ' ') THEN(DO)
/* RPG 呼び出し */
CALL &PROGRAM
GOTO END
ENDDO
IF COND(&RDMLX *EQ 'Y') THEN(DO)
/* RDMLX 実行要求を変更 */
CHGVAR VAR(&REQUEST) VALUE(X_RUN)
ENDDO
IF COND(&PROCESS *NE ' ' *AND &FUNCTION *NE ' ') THEN(DO)
IF COND(&REQUEST *EQ 'RUN') THEN(DO)
/* LANSA V10 または V11 の呼び出し */
CALL PGM(LANSA) PARM(&REQUEST &PROCESS &FUNCTION +
&PARM01 &PARM02 &PARM03 &PARM04 &PARM05 +
&PARM06 &PARM07 &PARM08 &PARM09 &PARM10 +
&PARTITION &LANGUAGE &TASKID &PCTYPE +
&DEVELOPER &ALLOWMSGS &PCNAME &DATESRC +
&BDEBUG &BDEBUGDEV &BDEBUGMSG)
MONMSG MSGID(DCM0000) EXEC(DO)
SNDPGMMSG MSG('LANSA RDML has ended abnormally')
ENDDO
GOTO END
ENDDO
IF COND(&REQUEST *EQ 'X_RUN') THEN(DO)
/* LANSA V11 呼び出し - RDMLX */
CALL PGM(LANSA) PARM(&REQUEST &PROCESS &FUNCTION +
&PARM01 &PARM02 &PARM03 &PARM04 &PARM05 +
&PARM06 &PARM07 &PARM08 &PARM09 &PARM10 +
&PARTITION &LANGUAGE &TASKID &PCTYPE +
&DEVELOPER &ALLOWMSGS &PCNAME &DATESRC +
&BDEBUG &BDEBUGDEV &BDEBUGMSG &XRUNADPRM)
MONMSG MSGID(DCM0000) EXEC(DO)
SNDPGMMSG MSG('LANSA RDMLX has ended abnormally')
ENDDO
GOTO END
ENDDO
ENDDO
SNDPGMMSG MSG('No program or function specified for execution')
END:
/* LANSA は終了オプションが有効時、ライブラリ・リストを置換 */
/* CALLSUBR SUBR(RMVMSG) */
/* LANSA は終了オプションが無効時、リソースを再利用 */
RCLRSC
/* CALLSUBR SUBR(LOGEND) */
/* =================================================================== */
/* サブルーチン */
/* =================================================================== */
SUBR SUBR(LOGSTR)
/* 開始時間 */
RTVSYSVAL SYSVAL(QTIME) RTNVAR(&CTIME)
CHGVAR VAR(&JOBMSG) VALUE('JSMLSAEXT START' *BCAT &CTIME)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&JOBMSG)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&FUNCTION)
/* ジョブ情報のリセット */
CALL PGM(LOGJOBINFO) PARM('*YES ')
ENDSUBR
SUBR SUBR(LOGEND)
/* ジョブ情報のログ */
CALL PGM(LOGJOBINFO) PARM('*NO ')
/* 終了時間 */
RTVSYSVAL SYSVAL(QTIME) RTNVAR(&CTIME)
CHGVAR VAR(&JOBMSG) VALUE('JSMLSAEXT END' *BCAT &CTIME)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&JOBMSG)
ENDSUBR
SUBR SUBR(RMVMSG)
/* LANSA は終了オプションが有効時、ライブラリ・リストを置換 */
/* LANSA の CPC2101 ライブラリ・リスト変更メッセージ */
/* http://www-01.ibm.com/support/docview.wss?uid=nas8N1016727 */
/* MSGKEY は 4 バイト符号なしのインクリメント整数 */
/* 各ジョブのプログラム・メッセージ数に制限があり、 */
/* 4,294,967,293 に達すると、OS がジョブを終了 */
CHGVAR VAR(&MSGID) VALUE(' ')
SNDPGMMSG MSG('TEXT') TOPGMQ(*SAME) KEYVAR(&MSGKEY)
RMVMSG MSGKEY(&MSGKEY)
CHGVAR %BIN(&MSGKEY 1 4) (%BIN(&MSGKEY 1 4) - 1)
RCVMSG PGMQ(*SAME (*)) MSGKEY(&MSGKEY) RMV(*NO) MSGID(&MSGID)
IF COND(&MSGID *EQ 'CPC2101') THEN(DO)
/* CPC2101 ライブラリ・リスト変更 */
RCVMSG PGMQ(*SAME (*)) MSGKEY(&MSGKEY) RMV(*YES) MSGID(&MSGID)
ENDDO
ENDSUBR
ENDPGM |