前述の「31. CLP で行うシンプルな IFS ファイル検査」 では OS V5R3M0 以上の環境が必要であるが
低いOS リリースでも 同じ IFS ファイルの存在検査を行いたいのであればRPG による記述が必要となる。
以下は RPG による CHKIFS であるが、RPG による C 関数の呼び出し方法の学習にもなるのでここに紹介する。
--------------------------------------------------------------------------------------------
0001.00 H DATEDIT(*YMD/) BNDDIR('QC2LE')
0002.00 F********** IFS ストリーム・ファイルの存在検査 ************************
0003.00 F* COMIPLE:
0004.00 F* CRTRPGMOD QTEMP/CHKIFS SRCFILE(MYSRCLIB/QRPGLESRC) AUT*ALL)
0005.00 F* CRTPGM MYLIB/CHKIFS MODULE(QTEMP/CHKIFS) ACTGRP(*NEW) AUT(*ALL)
0006.00 F**********************************************************************
0007.00 D OPEN PR 10I 0 EXTPROC('open')
0008.00 D PATH * VALUE OPTIONS(*STRING)
0009.00 D OPT 10I 0 VALUE
0010.00
0011.00 D CLOSE PR 10I 0 EXTPROC('close')
0012.00 D FILEID 10I 0 VALUE
0013.00
0014.00 D FILDES S 10I 0 INZ(0)
0015.00 D TRUE S 10I 0 INZ(0)
0016.00 D FALSE S 10I 0 INZ(-1)
0017.00 D O_RDONLY S 10I 0 INZ(1)
0018.00 D NULL S 1A INZ(X'00')
0019.00 D MSGFILLIB S 20A INZ('QCPFMSG *LIBL ')
0020.00 D MSGDTA S 100A
0021.00 D MSGDTALEN S 10I 0 INZ(100)
0022.00 D PGMSTKCNT S 10I 0 INZ(1) 小数
0023.00
0024.00 D APIERR DS
0025.00 D GETBYT 1 4B 0 INZ(160)
0026.00 D AVLBYT 5 8B 0 INZ(0)
0027.00 D MSG_ID 9 15
0028.00 D MSG_DTA 17 160
0029.00 C*----------------------------------------------------+
0030.00 C *ENTRY PLIST |
0031.00 C PARM DIR 256 |
0032.00 C*----------------------------------------------------+
0033.00 C CAT NULL:0 DIR
0034.00 C EVAL FILDES = OPEN(DIR: O_RDONLY)
0035.00 C* ( オープン失敗 )
0036.00 C FILDES IFEQ FALSE
0037.00 C EVAL MSGDTA = %TRIM(DIR) +
0038.00 C ' が見つかりません。 '
0039.00 C*----------------------------------------------------+
0040.00 C CALL 'QMHSNDPM' 99
0041.00 C PARM 'CPF9897' MSGID 7 |
0042.00 C PARM MSGFILLIB |
0043.00 C PARM MSGDTA |
0044.00 C PARM MSGDTALEN |
0045.00 C PARM '*ESCAPE ' MSGTYPE 10 |
0046.00 C PARM '*PGMBDY ' PGMQUE 10 |
0047.00 C PARM PGMSTKCNT |
0048.00 C PARM MSGKEY 4 |
0049.00 C PARM APIERR
0050.00 C*----------------------------------------------------+
0051.00 C ELSE
0052.00 C CALLP CLOSE(FILDES)
0053.00 C END
0054.00 C SETON LR
0055.00 C RETURN
--------------------------------------------------------------------------------------------
まず H-仕様書 の BNDDIR('QC2LE') は、C 関数が定義されているバインド・ディレクトリーをコンパイル時に
バインドすることを RPGコンパイラーに指示している。
これによって CLP のときのような明示的にサービス・プログラムをバインドする必要はない。
ただし H-仕様書 にバインド・ディレクトリーを指定した場合は CRTBNDRPG コマンドは利用できないので
CRTRPGMOD + CRTPGM によるコンパイルが必要である。
次に open 関数や close 関数は QSYSINC/QRPGLESRC には提供されていないので自分で
0007.00 D OPEN PR 10I 0 EXTPROC('open')
0008.00 D PATH * VALUE OPTIONS(*STRING)
0009.00 D OPT 10I 0 VALUE
0010.00
0011.00 D CLOSE PR 10I 0 EXTPROC('close')
0012.00 D FILEID 10I 0 VALUE
とプロトタイプを明示的に宣言する。 後は簡単であり、
033.00 C CAT NULL:0 DIR 034.00 C EVAL FILDES = OPEN(DIR: O_RDONLY)
のようにして NULL-STOP を付加してから open 関数を呼び出して実行するだけである。
気づかれたかも知れないが int 型のパラメータは 4B 0 ではなく、すべて 10I 0 として定義しないと
API には認識されないので注意して欲しい。
ファイルが見つからない場合は
0037.00 C EVAL MSGDTA = %TRIM(DIR) + 0038.00 C ' が見つかりません。 ' 0039.00 C*----------------------------------------------------+ 0040.00 C CALL 'QMHSNDPM' 99 0041.00 C PARM 'CPF9897' MSGID 7 | 0042.00 C PARM MSGFILLIB | 0043.00 C PARM MSGDTA | 0044.00 C PARM MSGDTALEN | 0045.00 C PARM '*ESCAPE ' MSGTYPE 10 | 0046.00 C PARM '*PGMBDY ' PGMQUE 10 | 0047.00 C PARM PGMSTKCNT | 0048.00 C PARM MSGKEY 4 | 0049.00 C PARM APIERR 0050.00 C*----------------------------------------------------+
のようにして *ESCAPE メッセージを戻しているのは、この CHKIFS コマンドを呼び出すCLP で
MONMSG CPF9800 が使えるようにするためである。
API: QMHSNDPM も SNDPGMMSG を実行する API であるが、やはり
QSYSINC/QRPGLESRC には提供されていない。
補足として API : QMHSNDPM がもしもエラーで終了したときには APIERR 構造体の AVLBYT には
正の数値が戻るので AVLBYT が 0 出なければエラーで終了したものとして判別することができる。
そのときは APIERR 構造体の MSG_ID には QCPFMSG の エラー CPFMSGID が戻り、MSG_DTA が
メッセージ・データである。
このときは API: QRTVMSGD を使えばメッセージ・データを組み込んだエラー・メッセージを取得することができる。
今回はそこまでの問題はないはずなので APIERR の検査は行っていない。
インクルード・ファイル : QSYSINC/QRPGLESRC には多くの API のプロトタイプやユーザーが使用するための
構造体等の定義が提供されているのでここでは利用することはなかったが、API を使用するときには
/COPY QSYSINC/QRPGLESRC.xxxxxxxx
のようにしてインクルードすれば便利である。