以前に「170.QUSLRCDを使わないレコード名検索」というテクニックを
紹介してCLPで API: QDBRTVFD を利用すれば簡単にレコード名を検索することができることを紹介した。
API: QDBRTVFD は莫大な構造を持つAPIであり
APIのマニュアルを参照しただけでは容易に利用することはできない。
さてここでは API : QDBRTVFD によるレコード名の検索を
ILE-RPGによって行う方法を紹介する。
_
[ TESTDBF ] データ・ベースのレコード名検索
ソースはこちらから
0001.00 H DFTNAME(TESTDBF) DATEDIT(*YMD/) BNDDIR('QC2LE') DFTACTGRP(*NO)
0002.00 F********** D/B レコード名の検索 ********************************
0003.00 F*
0004.00 F*****************************************************************
0005.00
0006.00 D APIERR DS QUALIFIED
0007.00 D GETBYT 1 4B 0 INZ(160)
0008.00 D AVLBYT 5 8B 0 INZ(0)
0009.00 D MSGID 9 15
0010.00 D MSGDTA 17 160
0011.00
0012.00 D*( QDBRTVFD のプロトタイプ宣言 )
0013.00 D QDBRTVFD PR EXTPGM('QSYS/QDBRTVFD')
0014.00 D FMTBUF 32727A CONST
0015.00 D FMTLEN 10I 0 CONST
0016.00 D RTNFILLIB 20A CONST
0017.00 D FOTMAT 8A CONST
0018.00 D FILFILLIB 20A CONST
0019.00 D MBR 10A CONST
0020.00 D OPT 1A CONST
0021.00 D FILETYPE 10A CONST
0022.00 D EXT 10A CONST
0023.00 D APIERR LIKEDS(APIERR)
0024.00 D OPTIONS(*VARSIZE)
0025.00
0026.00 *( 作業変数 )
0027.00 D FILSCOPE S 160A
0028.00 D RECORD S 10A
0029.00 D POS S 10I 0 INZ(513)
0030.00 D SIZE S 10I 0 INZ(160)
0031.00 D N S 4S 0
0032.00 D ANS S 1A
0033.00 D FMTBUF DS 32767 QUALIFIED
0034.00 D RECNUM 15 16B 0
0035.00 D FMTLEN S 10I 0 INZ(32767)
0036.00 D RTNFILLIB DS QUALIFIED
0037.00 D FILE 1 10
0038.00 D FILLIB 11 20
0039.00
0040.00 D FILEDS DS QUALIFIED
0041.00 D FILE 1 10
0042.00 D FILLIB 11 20
0043.00
0044.00 C*-------------------------------------------------------------------------+
0045.00 C *ENTRY PLIST |
0046.00 C PARM FILE_ 10 | ファイル名
0047.00 C PARM FILLIB_ 10 | ライブラリー名
0048.00 C*-------------------------------------------------------------------------+
0049.00 /FREE
0050.00 QDBRTVFD(FMTBUF:FMTLEN:RTNFILLIB:'FILD0100':FILEDS:'*FIRST':'0':
0051.00 '*FILETYPE ': '*EXT': APIERR);
0052.00 IF APIERR.AVLBYT > 0;
0053.00 DSPLY (%TRIMR(FILEDS) + ' の誤りです。 ' ) '' ANS;
0054.00 ELSE;
0055.00 FOR N = 1 TO FMTBUF.RECNUM;
0056.00 FILSCOPE = %SUBST(FMTBUF:POS:160);
0057.00 RECORD = %SUBST(FILSCOPE:69:10); // 取得したレコード名
0058.00 POS = POS + SIZE;
0059.00 ENDFOR;
0060.00 ENDIF;
0061.00 *INLR = *ON;
0062.00 RETURN;
0063.00 /END-FREE
0064.00 ***********************************************************
0065.00 C *INZSR BEGSR * 初期値セット
0066.00 ***********************************************************
0067.00 /FREE
0068.00 FILEDS.FILE = FILE_;
0069.00 FILEDS.FILLIB = FILLIB_;
0070.00 /END-FREE
0071.00 C ENDSR
[コンパイル]
CRTBNDRPG PGM(OBJLIB/TESTDBF) SRCFILE(SRCLIB/QRPGLESRC) DFTACTGRP(*NO)
ACTGRP(*NEW) DBGVIEW(*SOURCE) AUT(*ALL)
[解説]
この簡単なRPGソースの処理の中心となるのは
0055.00 FOR N = 1 TO FMTBUF.RECNUM; 0056.00 FILSCOPE = %SUBST(FMTBUF:POS:160); 0057.00 RECORD = %SUBST(FILSCOPE:69:10); // 取得したレコード名 0058.00 POS = POS + SIZE; 0059.00 ENDFOR;
というたった5行の処理である。
0050.00 QDBRTVFD(FMTBUF:FMTLEN:RTNFILLIB:'FILD0100':FILEDS:'*FIRST':'0': 0051.00 '*FILETYPE ': '*EXT': APIERR);
によって取得した FMTBUFのどの位置から読み取ればよいかというのが
課題であるがC言語によるAPIの実行によって位置を調べてILE-RPGでも
結果的に同じ処理ができるように解析したものである。
API : QUSLRCD を使ってレコード名を調べるにはユーザー・スペースを
作成してそこに出力したレコード一覧のデータを再び解析するという
途方もない手間が必要になる。
昭和の時代ではそれでもよかったのかも知れないが平成を経て
令和の現代では無駄なくスマートに解決したいものである。
_