Tools

32. RPG で行うシンプルな IFS ファイル検査

前述の「31. CLP で行うシンプルな IFS ファイル検査」 では OS V5R3M0 以上の環境が必要であるが
低いOS リリースでも 同じ IFS ファイルの存在検査を行いたいのであればRPG による記述が必要となる。
以下は RPG による CHKIFS であるが、RPG による C 関数の呼び出し方法の学習にもなるのでここに紹介する。

【 RPG : CHKIFS 】
--------------------------------------------------------------------------------------------
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: QMHSNDPMSNDPGMMSG を実行する API であるが、やはり QSYSINC/QRPGLESRC には提供されていない。

補足として API : QMHSNDPM がもしもエラーで終了したときには APIERR 構造体の AVLBYT には
正の数値が戻るので AVLBYT が 0 出なければエラーで終了したものとして判別することができる。
そのときは APIERR 構造体の MSG_ID には QCPFMSG の エラー CPFMSGID が戻り、MSG_DTA
メッセージ・データである。
このときは API: QRTVMSGD を使えばメッセージ・データを組み込んだエラー・メッセージを取得することができる。
今回はそこまでの問題はないはずなので APIERR の検査は行っていない。

■ QSYSINC/QRPGLESRC について

インクルード・ファイル : QSYSINC/QRPGLESRC には多くの API のプロトタイプやユーザーが使用するための
構造体等の定義が提供されているのでここでは利用することはなかったが、API を使用するときには

/COPY QSYSINC/QRPGLESRC.xxxxxxxx

のようにしてインクルードすれば便利である。