CLPのDCLF宣言でファイルを読み込んで処理するとき
同じプログラム内でもう一度再読み込みしたいときは
どのようにすれば良いのか?
_
そのままでは一度はすべてのレコードを読み取った後で
もう一度読み込んでもファイルの読み取り終了(EOF)と
なるばかりであるが
ファイルを読み取り終了後に CLOSE で明示的に
クローズしておけばよい。
ただしCLP内でDCLFで定義されたファイルを
明示的にオープンする命令はないので
オープンすることはできないが次のRCVFの実行によって
強制的に再オープンされてレコードが最初から
読み取られることになる。
[例] CLPで2回読み取りするTESTFFD
ソースはこちらから
0001.00 PGM
0002.00 /*-------------------------------------------------------------------*/
0003.00 /* TESTFFD : DSPFFD のテスト */
0004.00 /* */
0005.00 /* 2018/02/01 作成 */
0006.00 /*-------------------------------------------------------------------*/
0007.00 DCLF FILE(QTEMP/DSPFFD) OPNID(DSPFFD)
0008.00 DCL VAR(&MSG) TYPE(*CHAR) LEN(132)
0009.00 DCL VAR(&STMMSG) TYPE(*CHAR) LEN(132)
0010.00 DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
0011.00 DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
0012.00 DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
0013.00 DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4)
0014.00 DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132)
0015.00 DCL VAR(&ERRDTA) TYPE(*CHAR) LEN(132)
0016.00 DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)
0017.00 DCL VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)
0018.00 DCL VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) +
0019.00 VALUE('*ESCAPE ')
0020.00 DCL VAR(&APIERR) TYPE(*CHAR) LEN(116) +
0021.00 VALUE(X'0000007400000000') /* 2 進数 */
0022.00 DCL VAR(&ERR) TYPE(*CHAR) LEN(1)
0023.00 DCL VAR(&NULL4) TYPE(*CHAR) LEN(4) +
0024.00 VALUE(X'00000000')
0025.00 MONMSG MSGID(CPF9999) EXEC(GOTO CMDLBL(ERROR))
0026.00
0027.00 /*( 環境の取得 )*/
0028.00 RTVJOBA TYPE(&TYPE)
0029.00 IF COND(&TYPE *EQ '0') THEN(DO) /* バッチ */
0030.00 CHGVAR VAR(&TOPGMQ) VALUE('*SYSOPR ')
0031.00 ENDDO /* バッチ */
0032.00 ELSE CMD(DO) /* 対話式 */
0033.00 CHGVAR VAR(&TOPGMQ) VALUE('*TOPGMQ ')
0034.00 ENDDO /* 対話式 */
0035.00
0036.00 /*---------------------------*/
0037.00 CALLSUBR SUBR(GETFLDINFO)
0038.00 /*---------------------------*/
0039.00 /*---------------------------*/
0040.00 CALLSUBR SUBR(GETFLDINFO)
0041.00 /*---------------------------*/
0042.00 IF COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO)
0043.00 SNDPGMMSG MSG('API: +
0044.00 QUIDSPH の実行で次のエラーが発生しました。 +
0045.00 ') TOMSGQ(&TOPGMQ) MSGTYPE(*DIAG)
0046.00 GOTO APIERR
0047.00 ENDDO
0048.00 RETURN
0049.00
0050.00 APIERR:
0051.00 CHGVAR VAR(&MSGID) VALUE(%SST(&APIERR 9 7))
0052.00 CHGVAR VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100))
0053.00 CHGVAR VAR(&MSGF) VALUE('Q' *CAT %SST(&MSGID 1 +
0054.00 3) *CAT 'MSG')
0055.00 IF COND(&MSGF *EQ 'QCPEMSG') THEN(CHGVAR +
0056.00 VAR(&MSGF) VALUE('QCPFMSG'))
0057.00 CHGVAR VAR(&MSGFLIB) VALUE('QSYS ')
0058.00 GOTO SNDMSG
0059.00
0060.00 ERROR: RCVMSG MSGTYPE(*FIRST) RMV(*NO) KEYVAR(&MSGKEY) +
0061.00 MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
0062.00 SNDMSGFLIB(&MSGFLIB)
0063.00 IF COND(&MSGID *EQ 'CPF9999') THEN(DO)
0064.00 CHGVAR VAR(&ERRDTA) VALUE(&MSGDTA)
0065.00 RCVMSG MSGTYPE(*PRV) MSGKEY(&MSGKEY) RMV(*NO) +
0066.00 MSG(&MSG) MSGDTA(&MSGDTA) MSGID(&MSGID) +
0067.00 MSGF(&MSGF) MSGFLIB(&MSGFLIB)
0068.00 CHGVAR VAR(&STMMSG) VALUE(' プログラム ' *CAT +
0069.00 %SST(&ERRDTA 8 10) *TCAT +
0070.00 ' のステートメント ' *CAT %SST(&ERRDTA +
0071.00 24 8) *CAT ' で次のエラーが発生しました。 ')
0072.00 SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&STMMSG) +
0073.00 TOMSGQ(&TOPGMQ) MSGTYPE(*DIAG)
0074.00 ENDDO
0075.00 SNDMSG: IF COND(&MSGID *EQ ' ') THEN(DO)
0076.00 SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +
0077.00 TOMSGQ(&TOPGMQ) MSGTYPE(&MSGTYPE)
0078.00 MONMSG MSGID(CPF2400) EXEC(RETURN)
0079.00 ENDDO
0080.00 ELSE CMD(DO)
0081.00 SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
0082.00 MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +
0083.00 MSGTYPE(&MSGTYPE)
0084.00 MONMSG MSGID(CPF2400) EXEC(RETURN)
0085.00 ENDDO
0086.00 /******************************/
0087.00 SUBR SUBR(GETFLDINFO)
0088.00 /******************************/
0089.00 NXTFFD: RCVF OPNID(DSPFFD)
0090.00 MONMSG MSGID(CPF0864) EXEC(DO)
0091.00 RCVMSG PGMQ(*SAME) MSGTYPE(*LAST) RMV(*YES) MSG(&MSG)
0092.00 GOTO ENDFFD
0093.00 ENDDO
0094.00 GOTO NXTFFD
0095.00 ENDFFD: CLOSE OPNID(DSPFFD)
0096.00 ENDSUBR
0097.00 ENDPGM
[解説]
0036.00 /*---------------------------*/ 0037.00 CALLSUBR SUBR(GETFLDINFO) 0038.00 /*---------------------------*/ 0039.00 /*---------------------------*/ 0040.00 CALLSUBR SUBR(GETFLDINFO) 0041.00 /*---------------------------*/
とふたつのサブ・ルーチンを連続して実行しているが
このサブ・ルーチンの中では
0089.00 NXTFFD: RCVF OPNID(DSPFFD) 0090.00 MONMSG MSGID(CPF0864) EXEC(DO) 0091.00 RCVMSG PGMQ(*SAME) MSGTYPE(*LAST) RMV(*YES) MSG(&MSG) 0092.00 GOTO ENDFFD 0093.00 ENDDO 0094.00 GOTO NXTFFD 0095.00 ENDFFD: CLOSE OPNID(DSPFFD) 0096.00 ENDSUBR
と EOFになるまで QTEMP/DSPFFD を連続して読み取っているが
EOFになった後では
0095.00 ENDFFD: CLOSE OPNID(DSPFFD)
としてファイルをクローズしているので二度目の読み取りも可能になっている。
_