ある適用業務は *DS4 27*132 の環境下で動作するように設計されているとする。
うかつに *DS3 24*80 の環境でこのプログラムをエンド・ユーザーが起動すると
たちまちエラーCPF4169によってアベンドしてしまう。
エンド・ユーザーに不審な思いをさせたくないようにするにはどのようにすればよいだろうか ?
RPG の中で *INZSR サブルーチンの中でプログラムが起動される前にチェックしたいのだが
*INZSR の中では DSPFは既にオープンされているので、
今回の問題は *INZSR が実行される前にエラーとなってしまう。
それならば *PSSR サブルーチンでモニターしようとしても、やはり *PSSR に行く前にエラーとなってしまう。
であればRPGが起動される前に検査する必要がある。
ところが RTVJOBA や DSPJOB を実行してみても現在、起動している5250エミュレータが
どの画面サイズで実行されているかの情報は見つからない。
確かに RPG の INFDS の内部では
D INFDS DS D NUM_ROWS 282 283B 0 D NUM_COLS 284 285B 0
のようにして現在、実行中のDSPFの画面サイズを取得できるはずであるので
どこかで取得できる方法はあるはずである。
RPG では取得しようにも132桁で定義されているDSPFを暗黙的にオープンする前に
エラーとなってしまうのでこの方法は採用できない。
現在、実行中の画面サイズを取得するコマンドは用意されていない。
実はこの機能を提供するAPI は動的画面管理API の中の
QsnRtvScrDim
という名前の関数のみであるが、これはプログラム名ではなくサービス・プログラム
QSNAPI から公開されている関数(プロシージャー)である。
従って CALL 命令では呼び出すことはできない。
そこで C言語でこの関数を呼び出すプログラムを開発することになるのだが
IBM i の開発者では C言語はわからないという人が多いので
今回は CLP (CLLE) によってこの関数を呼びだすようにした。
CMD PROMPT(' 画面寸法の検索 ')
PARM KWD(LINS) TYPE(*DEC) LEN(2 0) RTNVAL(*YES) +
PROMPT(' 行数 ')
PARM KWD(COLS) TYPE(*DEC) LEN(3 0) RTNVAL(*YES) +
PROMPT(' 桁数 ')
CRTCMD CMD(MYLIB/RTVDSPSIZ) PGM(MYLIB/RTVDSPSIZ) SRCFILE(MYSRCLIB/QCMDSRC) ALLOW(*BPGM *IPGM) AUT(*ALL)
コマンド : RTVDSPSIZ は RTNVAL(*YES)で示されているように
画面サイズの行(LINS)と桁(COLS)の値を返すので
実行時の環境はバッチのみであるとして
ALLOW(*BPGM *IPGM)
の指定が必要である。
PGM PARM(&LIND &COLD)
/*-------------------------------------------------------------------*/
/* RTVDSPSIZ : DSPF サイズの検索 */
/* */
/* 2016/03/12 作成 */
/* COMPILE: CRTBNDCL OBJLIB/RTVDSPSIZ */
/* SRCFILE(MYSRCLIB/QCLLESRC) */
/* DFTACTGRP(*NO) ACTGRP(*NEW) AUT(*ALL) */
/* */
/*-------------------------------------------------------------------*/
DCL VAR(&MSG) TYPE(*CHAR) LEN(132)
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132)
DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)
DCL VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)
DCL VAR(&APIERR) TYPE(*CHAR) LEN(116) +
VALUE(X'000074') /* 2 進数 */
DCL VAR(&NULL4) TYPE(*CHAR) LEN(4) +
VALUE(X'00000000')
DCL VAR(&LIN) TYPE(*CHAR) LEN(4)
DCL VAR(&COL) TYPE(*CHAR) LEN(4)
DCL VAR(&DEC08) TYPE(*DEC) LEN(8 0)
DCL VAR(&LIND) TYPE(*DEC) LEN(2 0)
DCL VAR(&COLD) TYPE(*DEC) LEN(3 0)
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
RTVJOBA TYPE(&TYPE)
IF COND(&TYPE *EQ '0') THEN(DO) /* バッチ */
CHGVAR VAR(&TOPGMQ) VALUE('*SYSOPR ')
ENDDO /* バッチ */
ELSE CMD(DO) /* 対話式 */
CHGVAR VAR(&TOPGMQ) VALUE('*TOPGMQ ')
ENDDO /* 対話式 */
CALLPRC PRC('QsnRtvScrDim') PARM((&LIN) (&COL) (0) +
(&APIERR))
IF COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO)
SNDPGMMSG +
MSG('API: QsnRtvScrDim の実行で次のエラーが発生 +
しました。 ') MSGTYPE(*DIAG)
GOTO APIERR
ENDDO
CHGVAR VAR(&DEC08) VALUE(%BIN(&LIN))
CHGVAR VAR(&LIND) VALUE(&DEC08)
CHGVAR VAR(&DEC08) VALUE(%BIN(&COL))
CHGVAR VAR(&COLD) VALUE(&DEC08)
RETURN
APIERR:
CHGVAR VAR(&MSGID) VALUE(%SST(&APIERR 9 7))
CHGVAR VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100))
CHGVAR VAR(&MSGF) VALUE('QCPFMSG ')
CHGVAR VAR(&MSGFLIB) VALUE('QSYS ')
GOTO SNDMSG
ERROR: RCVMSG MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +
MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
MSGFLIB(&MSGFLIB)
SNDMSG: IF COND(&MSGID *EQ ' ') THEN(DO)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +
TOMSGQ(&TOPGMQ) MSGTYPE(*ESCAPE)
ENDDO
ELSE CMD(DO)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +
MSGTYPE(*ESCAPE)
ENDDO
ENDPGM
CRTBNDCL PGM(MYLIB/RTVDSPSIZ) SRCFILE(MYSRCFILE/QCLLESRC) DFTACTGRP(*NO) ACTGRP(*NEW) AUT(*ALL)
参考までに
CRTCLMOD QTEMP/RTVDSPSIZ SRCFILE(MYSRCFILE/QCLLESRC) AUT(*ALL)さらに
CRTPGM MYLIB/RTVDSPSIZ MODULE(QTEMP/RTVDSPSIZ) BNDSRVPGM(QSYS/QSNAPI) AUT(*ALL)でもよい。CRTBNDCL なら一回のコンパイルだけで済む。
実行しているのは
CALLPRC PRC('QsnRtvScrDim') PARM((&LIN) (&COL) (0) +
(&APIERR))
の部分だけであって他は大部分がこのプログラムにエラーが発生したときのモニターである。
この CLP は、対話式、バッチ・ジョブや例外的な多くのエラーをモニターできるように
設計されているので社内で CLP を開発するときの参考にしてほしい。
PGM
/*-------------------------------------------------------------------*/
/* PHOTOCL : SFL 写真画像 */
/* */
/* 2016/03/12 作成 */
/*-------------------------------------------------------------------*/
DCL VAR(&MSG) TYPE(*CHAR) LEN(132)
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132)
DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)
DCL VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)
DCL VAR(&LIN) TYPE(*DEC) LEN(2 0)
DCL VAR(&COL) TYPE(*DEC) LEN(3 0)
MONMSG MSGID(CPF0000 RNX0000) EXEC(GOTO CMDLBL(ERROR))
RTVJOBA TYPE(&TYPE)
IF COND(&TYPE *EQ '0') THEN(DO) /* バッチ */
CHGVAR VAR(&TOPGMQ) VALUE('*SYSOPR ')
ENDDO /* バッチ */
ELSE CMD(DO) /* 対話式 */
CHGVAR VAR(&TOPGMQ) VALUE('*TOPGMQ ')
ENDDO /* 対話式 */
RTVDSPSIZ LINS(&LIN) COLS(&COL)
IF COND(&COL *NE 132) THEN(DO)
CHGVAR VAR(&MSG) +
VALUE(' 実行するには 132 桁の環境が必要で +
す。 ')
GOTO SNDMSG
ENDDO
CALL PGM(QTROBJ/PHOTO)
RETURN
ERROR: RCVMSG MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +
MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
MSGFLIB(&MSGFLIB)
SNDMSG: IF COND(&MSGID *EQ ' ') THEN(DO)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +
TOMSGQ(&TOPGMQ) MSGTYPE(*ESCAPE)
ENDDO
ELSE CMD(DO)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +
MSGTYPE(*ESCAPE)
ENDDO
ENDPGM
このCLPは *DS4 27*132 の環境下での実行を必要としているので
プログラムを呼び出す前に今の環境が *DS4 27*132 であるかどうかを
RTVDSPSIZ を使って調べている。
RTVDSPSIZ を使っているのは
RTVDSPSIZ LINS(&LIN) COLS(&COL)
IF COND(&COL *NE 132) THEN(DO)
CHGVAR VAR(&MSG) +
VALUE(' 実行するには 132 桁の環境が必要で +
す。 ')
GOTO SNDMSG
ENDDO
の部分である。
RTVDSPSIZを使って取得した桁数が 132 でない場合は
エラー・メッセージを出力して終了するようにしている。
API の中で「動的画面管理API」というジャンルがあって
多くの読者はこれが何であるか不明であろうと推測されるので簡単な説明をしておく。
「動的画面管理API」とは5250画面の上に動的にフィールドを配置したり出力する、という意味ではない。
これは 5250ストリームに対する入出力命令を集めたもので
5250ストリームを独自に構成することができる機能である。
仮想端末APIを扱う場合には仮想端末に対して入出力するだけで済むので、
特にこのAPI は必要としない。
それではなぜこのAPI が用意されているのかというと、
恐らくは DDS の USRDFN キーワードをサポートするためのものであろう。
DDS の USRDFN キーワードとは
ユーザーが独自にその表示レコードの5250ストリームを作成するというものである。
つまり USRDFN で示された表示レコードのフィールドはいわゆるフィールドの値ではなく
5250ストリームを記述することになる。
USRDFN を使っている人は少ないだろうと予想したが、
米国サイトでは 2つの記事を見つけることができた。
興味深い利用方法が紹介されていたので、いずれこのサイトでも紹介したい。