コマンドの活用方法のひとつで値を戻すコマンドは非常に効果的である。
CALLでプログラムを呼び出してパラメータで値を受取るよりは
コマンドであれば F4キーでプロンプト表示させることができるので
開発も簡単になる。
このように値を戻すようにコマンドを作っておくと多くの業務で
再利用することができる。
ここでは値を戻すコマンドの作成方法を紹介しよう。
[ サンプル・コマンド: RTVCCSID ] ファイルのCCSIDを取得する RTVCCSID
ソースはこちらから
0001.00 CMD PROMPT(' ファィルの CCSID の検索 ')
0002.00 PARM KWD(FILE) TYPE(FILE) +
0003.00 PROMPT(' ファイル ')
0004.00 FILE: QUAL TYPE(*NAME) LEN(10)
0005.00 QUAL TYPE(*CHAR) LEN(10) DFT(*LIBL) +
0006.00 PROMPT(' ライブラリー ')
0007.00 PARM KWD(CCSID) TYPE(*DEC) LEN(5 0) RTNVAL(*YES) +
0008.00 PROMPT(' ＣＣＳＩＤ ')
[解説]
0007.00 PARM KWD(CCSID) TYPE(*DEC) LEN(5 0) RTNVAL(*YES) +
0008.00 PROMPT(‘ ＣＣＳＩＤ ‘)
の RTNVAL(*YES) の部分がこのキー・ワード CCSIDが値を戻すことを示している。
さらにコンパイルには少し工夫が要る。
[コンパイル]
CRTCMD CMD(OBJLIB/RTVCCSID) PGM(OBJLIB/QCMDSRC) SRCFILE(MYSRCLIB/QCMDSRC)
ALLOW(*BPGM *IPGM) AUT(*ALL)
[解説]
ALLOW(*BPGM *IPGM) はこのコマンドがバッチ環境のみで動作することを示している。
つまり対話式環境で直接、エンド・ユーザーが RTVCCSIDと打鍵すると
CPD0031: この設定値にコマンド RTVCCSID を使用することはできない
とのエラーが発生して対話式環境では利用することはできないのである。
ところでこのコマンド RTVCCSIDはコンパイルの都度に ALLOW(*BPGM *IPGM) を
指示してコンパイルすることを覚えておかねばならないのだろうか?
そこでもうひとつのテクニックを紹介する。
それは CMDパラメータにコンパイルの方法を仕組んでおくことである。
0001.00 CMD PROMPT(' ファィルの CCSID の検索 ') +
0002.00 ALLOW(*BPGM *IPGM)
のようにして CMDパラメータに ALLOW(*PGM *IPGM) を埋めておくと通常のコンパイル
でも ALLOW(*BPGM *IPGM) が生かされることになる。
参考までにこのコマンドを処理するCLPも紹介しておこう。
[ サンプルCLP: RTVCCSIDCL ]
ファイルのCCSIDを取得する RTVCCSIDCL
ソースはこちらから
0001.00 PGM PARM(&FILFILLIB &CCSID)
0002.00 /*---------------------------------------------------------*/
0003.00 /* RTVCCSID : ファィルの CCSID の検索 */
0004.00 /*---------------------------------------------------------*/
0005.00 DCL VAR(&MSG) TYPE(*CHAR) LEN(132)
0006.00 DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
0007.00 DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132)
0008.00 DCL VAR(&MSGF) TYPE(*CHAR) LEN(10) +
0009.00 VALUE('QCPFMSG ')
0010.00 DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10) +
0011.00 VALUE('*LIBL ')
0012.00 DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)
0013.00 DCL VAR(&FILFILLIB) TYPE(*CHAR) LEN(20)
0014.00 DCL VAR(&FILE) TYPE(*CHAR) LEN(10)
0015.00 DCL VAR(&FILLIB) TYPE(*CHAR) LEN(10)
0016.00 DCL VAR(&CCSID) TYPE(*DEC) LEN(5 0)
0017.00 DCL VAR(&RCVVAR) TYPE(*CHAR) LEN(512)
0018.00 DCL VAR(&RCVLEN) TYPE(*CHAR) LEN(4)
0019.00 DCL VAR(&CCSID1) TYPE(*DEC) LEN(7 0) /* FILE +
0020.00 CCSID */
0021.00 DCL VAR(&RTNNAM) TYPE(*CHAR) LEN(20) /* RETURNED +
0022.00 FILE NAME */
0023.00 DCL VAR(&APIERR) TYPE(*CHAR) LEN(116) +
0024.00 VALUE(X'000074') /* 2 進数 */
0025.00 DCL VAR(&NULL4) TYPE(*CHAR) LEN(4) +
0026.00 VALUE(X'00000000')
0027.00 MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
0028.00
0029.00 RTVJOBA TYPE(&TYPE)
0030.00 CHGVAR VAR(&FILE) VALUE(%SST(&FILFILLIB 01 10))
0031.00 CHGVAR VAR(&FILLIB) VALUE(%SST(&FILFILLIB 11 10))
0032.00 CHGVAR VAR(%BIN(&RCVLEN)) VALUE(512)
0033.00 CALL PGM(QDBRTVFD) PARM(&RCVVAR &RCVLEN &RTNNAM +
0034.00 'FILD0200' &FILFILLIB '*FIRST ' '0' +
0035.00 '*FILETYPE' '*INT' &APIERR)
0036.00 /*( API エラー )*/
0037.00 IF COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO)
0038.00 CHGVAR VAR(&MSGID) VALUE(%SST(&APIERR 9 7))
0039.00 CHGVAR VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100))
0040.00 GOTO SNDMSG
0041.00 ENDDO
0042.00 /*( 正常に取得成功 )*/
0043.00 CHGVAR VAR(&CCSID1) VALUE(%BIN(&RCVVAR 46 2))
0044.00 CHGVAR VAR(&CCSID) VALUE(&CCSID1)
0045.00 IF COND(&CCSID *EQ -1) THEN(CHGVAR VAR(&CCSID) +
0046.00 VALUE(65535))
0047.00 RETURN
0048.00
0049.00 ERROR: RCVMSG MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +
0050.00 MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
0051.00 MSGFLIB(&MSGFLIB)
0052.00 SNDMSG:
0053.00 IF COND(&TYPE *EQ '0') THEN(DO)
0054.00 SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
0055.00 MSGDTA(&MSGDTA) TOMSGQ(*SYSOPR) +
0056.00 MSGTYPE(*COMP)
0057.00 ENDDO
0058.00 ELSE CMD(DO)
0059.00 SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
0060.00 MSGDTA(&MSGDTA) TOMSGQ(*TOPGMQ) +
0061.00 MSGTYPE(*ESCAPE)
0062.00 ENDDO
0063.00 ENDPGM
[解説]
API : QDBRTVFD を呼び出してファイル属性を調べて戻している。