IBM eSever iSeries専用。RPGとCLPから構成。
（２）プログラム名：EXSQ20R タイプ：RPG
H Y/ 1 FQCLSRC IF E DISK F QCLSRC KRENAMEDBREC F KINFDS W#INFO FEXSQDT IF E DISK A UC F EXSQDT KRENAMETXREC ITXREC 99 I SRCDTA A133 I*レコード数 IW#INFO DS I B 156 1590W#RCD I*先頭５２文字＝ＤＳＰＬＹ命令の表示制限 I DS I 1 80 DW080 I 1 52 DW052 C *ENTRY PLIST C PARM P\CTL 2 情報表示 C* C P#SQ30 PLIST C PARM P\OUT 1 C* C EXSR @INIT C EXSR @MAIN C EXSR @END C* C READ TXREC 91ダミー命令 C* C***************************************************** C* C @INIT BEGSR C* C P\CTL IFEQ 'OK' C SETON 69 表示する C ELSE C SETOF 69 表示しない C ENDIF C* C SETOF 72 １命令単位 C* C ENDSR C***************************************************** C* C @MAIN BEGSR C* C SETOF 91 C *IN91 DOWEQ*OFF C READ DBREC 91 C* C *IN91 IFEQ *ON C 69 'EOF' DSPLY C LEAVE 離脱 C ENDIF C* C MOVELSRCDTA DW080 C* C DW080 IFEQ *BLANK C ITER 次行へ C ENDIF C* C 69 DW052 DSPLY C* C '/*' SCAN DW080 71コメント？ C *IN71 IFEQ *ON C MOVELDW080 A133 そのまま C MOVEL'N' P\OUT C* C N72 OPEN EXSQDT C WRITETXREC C CLOSEEXSQDT C SETOF 72 C CALL 'EXSQ30C' P#SQ30 １命令実行 C* C ITER 次行へ C ENDIF C* C ';' SCAN DW080 71デリミタ？ C *IN71 IFEQ *ON C ';':' ' XLATEDW080 A133 区切り除去 C MOVEL'Y' P\OUT C* C N72 OPEN EXSQDT C WRITETXREC C CLOSEEXSQDT C SETOF 72 C CALL 'EXSQ30C' P#SQ30 １命令実行 C* C ITER 次行へ C ENDIF C* C N72 OPEN EXSQDT C SETON 72 C MOVELDW080 A133 そのまま C WRITETXREC C* C ENDDO C* C *IN72 IFEQ *ON 最終行 C W#RCD IFEQ 1 C MOVEL'Y' P\OUT １行のみ C CLOSEEXSQDT C CALL 'EXSQ30C' P#SQ30 １命令実行 C ELSE C MOVEL'N' P\OUT 継続と判断 C CLOSEEXSQDT C CALL 'EXSQ30C' P#SQ30 １命令実行 C ENDIF C ENDIF C* C ENDSR C***************************************************** C* C @END BEGSR C* C 69 '@END' DSPLY C SETON LR C RETRN C* C ENDSR C*****************************************************
追記(2012/3/21)：
EXSQDTが無くコンパイルエラーになるときは
CRTSRCPF FILE(QTEMP/EXSQDT) IGCDTA(*YES)
をしておく。
[プログラミング] SELECT命令を一括実行するツールを作成してみた
http://d.hatena.ne.jp/saul/20101125/p1
[プログラミング] SELECT命令一括実行ツールのプログラム例(1/3)
http://d.hatena.ne.jp/saul/20101125/p2
[プログラミング] SELECT命令一括実行ツールのプログラム例(3/3)
http://d.hatena.ne.jp/saul/20101125/p4
