Page History
...
この終了プログラムのソース・コードは、JSM ライブラリの QCLSRC に保管されます。
| Code Block |
|---|
/ * |
...
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 |
...