271. RPG の中でオブジェクトの存在をチェックするには ?
RPG プログラム内で CHKOBJ などでオブジェクトの存在をチェックすることが
できるのだろうか ?
これに関しては意外と難しいのか海外の記事でも決め手のテクニックはない。
CLP の中では
CHKOBJ OBJ(QTRFIL/SHTEST) OBJTYPE(*FILE) MONMSG CPF9800
または
MONMSG MSGID(CPF0000) EXEC(GOTO ERROR) : CHKOBJ OBJ(QTRFIL/SHTEST) OBJTYPE(*FILE)
のように使用する。
この CLP の MONMSG に相当する RPG の命令が MONITOR であり
MONITOR : ( CHKOBJ ... ) : ON-ERROR : ENDMON
のように使用する。
従って MONITOR を使えばエラーがあれば検知して ON-ERROR が
実行されるはずなので上記の ( CHKOBJ ... )の部分に
QCMDXC や system 関数を使って実行すればエラー・モニターされるはずだと
いうことになるのだが、そうは行かない。
このことについても IBM 解説書には記述がないので実行してみるしかない。
MONITOR
SYSTEM('CHKOBJ OBJ(QTRFIL/SHTEST) OBJTYPE(*FILE)')
'FOUND' DSPLY
LEAVESR
ON-ERROR
'NOT FOUND' DSPLY
ENDMON
と記述しても MONITOR がエラーを検知することはない。
これは QCMDEXC で実行しても同じであり検出はできない。
なぜかというと SNDPGMMSG で送信されるスタックは *PRV であり
ひとつ上の上位のスタックである。
つまりエラー・メッセージは system 関数や QCMDEXC に送られるので
もうひとつ上の RPGプログラムまでは伝わらないのである。
( SNDPGMMSG ではなく QMHSNDPM によってスタックを指定すれば可能だが )
そこで MONITOR 〜 ON-ERROR のあいだに直接プログラムを CALL して
その呼ばれたプログラムから *ESCAPE メッセージを SNDPGMMSG で
戻せば RPG はそのプログラムのひとつ上のスタックになるので
MONITOR はエラーを検知する。
なれば QSYS の CHKOBJ を処理している QSYS のプログラム: QLICKOBJ を
直接、実行すればよいのだが QSYS のプログラムを
コマンドを経由せずに直接、呼び出すと
「ドメイン・エラーが検出された」とのエラーとなって実行は許されない。
QLICKOBJ をユーザー・ライブラリーにコピーしてもよいのだが
(【注】 使用者がコピーして自分自身で使う場合は著作権法では許されている)
これくらいは自前で作った。
「CHKOBJを処理するCHKOBJCL」を参照して欲しい。
CHKOBJCL を使えば次のような RPG によって
オブジェクトの存在を検査することができる。
【 TESTCHK: CHKOBJ を行うサンプル・ソース】
0001.00 H DATEDIT(*YMD/) COPYRIGHT('(C) OfficeQuattrb Co,.Ltd Japan 2017-')
0002.00 F********** RPG によるオブジェクト存在検査 ****************************
0003.00 F*
0004.00 F**********************************************************************
0005.00 D OBJOBJLIB DS
0006.00 D OBJ 1 10A
0007.00 D OBJLIB 11 20A
0008.00
0009.00 D AUT DS
0010.00 D KOSU 1 2B 0 INZ(1)
0011.00 D AUTR 3 102 DIM(10)
0012.00
0013.00 D CHKOBJ C CONST('QUATTRO/CHKOBJCL')
0014.00 C EXSR CHECK
0015.00 C SETON LR
0016.00 C******************************************************
0017.00 C CHECK BEGSR
0018.00 C******************************************************
0019.00 C MONITOR
0020.00 C MOVEL 'SHOHINZ ' OBJ
0021.00 C MOVEL 'QTRFIL ' OBJLIB
0022.00 C MOVEL '*NONE ' AUTR(1)
0023.00 C*----------------------------------------------------+
0024.00 C CALL CHKOBJ
0025.00 C PARM OBJOBJLIB
0026.00 C PARM '*FILE ' OBJTYPE 10
0027.00 C PARM '*NONE ' MBR 10
0028.00 C PARM AUT
0029.00 C*----------------------------------------------------+
0030.00 C 'FOUND ' DSPLY ANS 1
0031.00 C ON-ERROR *ALL
0032.00 C 'NOT FOUND' DSPLY ANS 1
0033.00 C ENDMON
0034.00 C ENDSR
【 CHKOBJCL: オブジェクトの存在を検査するCLP 】
0001.00 PGM PARM(&OBJOBJLIB &OBJTYPE &MBR &AUT)
0002.00 /*---------------------------------------------------------*/
0003.00 /* CHKOBJCL : オブジェクトの存在チエック */
0004.00 /*---------------------------------------------------------*/
0005.00 DCL VAR(&OBJOBJLIB) TYPE(*CHAR) LEN(20)
0006.00 DCL VAR(&OBJ) TYPE(*CHAR) LEN(10)
0007.00 DCL VAR(&OBJLIB) TYPE(*CHAR) LEN(10)
0008.00 DCL VAR(&OBJTYPE) TYPE(*CHAR) LEN(7)
0009.00 DCL VAR(&OBJTYPEC) TYPE(*CHAR) LEN(8)
0010.00 DCL VAR(&MBR) TYPE(*CHAR) LEN(10)
0011.00 DCL VAR(&AUT) TYPE(*CHAR) LEN(102)
0012.00 DCL VAR(&AUTS) TYPE(*CHAR) LEN(2)
0013.00 DCL VAR(&AUTC) TYPE(*CHAR) LEN(100)
0014.00 DCL VAR(&AUT10) TYPE(*CHAR) LEN(10)
0015.00 DCL VAR(&AUT100) TYPE(*CHAR) LEN(100)
0016.00 DCL VAR(&MSG) TYPE(*CHAR) LEN(132)
0017.00 DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
0018.00 DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
0019.00 DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
0020.00 DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132)
0021.00 DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)
0022.00 DCL VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)
0023.00 DCL VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) +
0024.00 VALUE('*ESCAPE ')
0025.00 DCL VAR(&APIERR) TYPE(*CHAR) LEN(116) +
0026.00 VALUE(X'000074') /* 2 進数 */
0027.00 DCL VAR(&NULL4) TYPE(*CHAR) LEN(4) +
0028.00 VALUE(X'00000000')
0029.00 DCL VAR(&N) TYPE(*DEC) LEN(4 0)
0030.00 DCL VAR(&POS) TYPE(*DEC) LEN(4 0) VALUE(3)
0031.00 DCL VAR(&POT) TYPE(*DEC) LEN(4 0) VALUE(1)
0032.00 MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
0033.00
0034.00 /*( 環境の取得 )*/
0035.00 RTVJOBA TYPE(&TYPE)
0036.00 IF COND(&TYPE *EQ '0') THEN(DO) /* バッチ */
0037.00 CHGVAR VAR(&TOPGMQ) VALUE('*SYSOPR ')
0038.00 ENDDO /* バッチ */
0039.00 ELSE CMD(DO) /* 対話式 */
0040.00 CHGVAR VAR(&TOPGMQ) VALUE('*TOPGMQ ')
0041.00 ENDDO /* 対話式 */
0042.00
0043.00 /*( パラメータの取得 )*/
0044.00 CHGVAR VAR(&OBJ) VALUE(%SST(&OBJOBJLIB 01 10))
0045.00 CHGVAR VAR(&OBJLIB) VALUE(%SST(&OBJOBJLIB 11 10))
0046.00 IF COND(%SST(&OBJTYPE 1 1) *EQ '*') THEN(DO)
0047.00 CHGVAR VAR(&OBJTYPEC) VALUE(&OBJTYPE)
0048.00 ENDDO
0049.00 ELSE CMD(DO)
0050.00 CHGVAR VAR(&OBJTYPEC) VALUE('*' *TCAT &OBJTYPE)
0051.00 ENDDO
0052.00 CHGVAR VAR(&AUTS) VALUE(%SST(&AUT 1 2))
0053.00 IF COND(%BIN(&AUTS) *GT 0) THEN(DO)
0054.00 CHGVAR VAR(&N) VALUE(1)
0055.00 LOOP: CHGVAR VAR(&AUT10) VALUE(%SST(&AUT &POS 10))
0056.00 CHGVAR VAR(%SST(&AUT100 &POT 10)) VALUE(&AUT10)
0057.00 IF COND(&N < %BIN(&AUTS)) THEN(DO)
0058.00 CHGVAR VAR(&N) VALUE(&N + 1)
0059.00 CHGVAR VAR(&POS) VALUE(&POS + 10)
0060.00 CHGVAR VAR(&POT) VALUE(&POT + 10)
0061.00 GOTO LOOP
0062.00 ENDDO
0063.00 ENDDO
0064.00
0065.00 /*( CHKOBJ の検査 )*/
0066.00 CHKOBJ OBJ(&OBJLIB/&OBJ) OBJTYPE(&OBJTYPEC) +
0067.00 MBR(&MBR) AUT(&AUT100)
0068.00 RETURN
0069.00
0070.00 APIERR:
0071.00 CHGVAR VAR(&MSGID) VALUE(%SST(&APIERR 9 7))
0072.00 CHGVAR VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100))
0073.00 CHGVAR VAR(&MSGF) VALUE('QCPFMSG ')
0074.00 CHGVAR VAR(&MSGFLIB) VALUE('QSYS ')
0075.00 GOTO SNDMSG
0076.00
0077.00 ERROR: RCVMSG MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +
0078.00 MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
0079.00 MSGFLIB(&MSGFLIB)
0080.00 SNDMSG: IF COND(&MSGID *EQ ' ') THEN(DO)
0081.00 SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +
0082.00 TOMSGQ(&TOPGMQ) MSGTYPE(&MSGTYPE)
0083.00 ENDDO
0084.00 ELSE CMD(DO)
0085.00 SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
0086.00 MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +
0087.00 MSGTYPE(&MSGTYPE)
0088.00 ENDDO
0089.00 ENDPGM
