文字項目にCHECK(RB)又はCHECK(RZ)を指定していると、IBM i(AS/400)Web化ツールのほうで入力操作に不都合が発生する。緑端末では問題にならないので判らない。
いくつものDSPFメンバーを一つずつ開いて、目検して、修正する。
まぁそうなんだけど、表示５と削除４を間違えたり（最新ソースを削除したら大変！）、ソース検索が繰り返して何度も回ったり、ってとても気を使う。
しかも、１回だけの作業とは限らない。
っていうことで、検査用のツールを作ってみた。
詳細仕様的では、コーディング規約に一応添って作っていて、またコンパイラを作るわけではないので、すべての指定方法でなくて暗黙の了解をしてしまいましょう。
コーディングの美醜は目をつむってくださいｗ
IBM i (eSever iSeries)専用。
CLPとRPG（※）の４本で構成。
OS はV6R1M0。
[操作]
・コマンドラインでソースファイル・ライブラリーを指定する。
・検査結果は、エラーが存在する可能性があるメンバーリストを出力する。
[１]CDSCLP（CLP）
PGM PARM(&TLIB)
DCL VAR(&TLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&TSRC) TYPE(*CHAR) LEN(10) +
VALUE('QDSPSRC ') /* Fixed value */
DCL VAR(&WLIB) TYPE(*CHAR) LEN(10) +
VALUE('TOOLLIB ') /* Fixed value */
DCL VAR(&WSRC) TYPE(*CHAR) LEN(10) +
VALUE('QSRCML ') /*８字以内 Fixed value */
DCL VAR(&WSID) TYPE(*CHAR) LEN(10)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&NBR) TYPE(*CHAR) LEN(06)
DCL VAR(&STS) TYPE(*DEC) LEN(1 0)
MONMSG MSGID(CPF0000)
START:
RTVJOBA JOB(&WSID) USER(&USER) NBR(&NBR)
DSPFD FILE(&TLIB/&TSRC) TYPE(*MBRLIST) +
OUTPUT(*OUTFILE) OUTFILE(&WLIB/&WSRC)
OVRPRTF FILE(QSYSPRT) HOLD(*YES)
CALL PGM(&WLIB/CDS1) PARM(&TLIB &TSRC &WLIB &WSRC +
&WSID &USER &NBR &STS)
DLTOVR FILE(*ALL)
IF COND(&STS *EQ 0) THEN(DO)
SNDPGMMSG MSGID(CPF9302) MSGF(QCPFMSG)
ENDDO
ELSE CMD(DO)
SNDPGMMSG MSGID(CPF9301) MSGF(QCPFMSG)
ENDDO
END:
ENDPGM
[２]CDS1（RPG）
H Y/ 1
FQSRCML UF E DISK
F QWHFDML KRENAMEDBREC
F KINFDS W#INFO
FQPRINT O F 132 OF PRINTER
E TITL 1 1 70
C *ENTRY PLIST
C PARM P#TLIB 10 target lib
C PARM P#TSRC 10 srcfile name
C PARM P#WLIB 10 tool lib
C PARM P#WSRC 10 work file
C PARM P#WSID 10 JOB
C PARM P#USER 10 USER
C PARM P#JNBR 6 JOB NBR
C PARM P#STS 10 status
C*
C EXSR @INIT
C EXSR @MAIN
C EXSR @END
C*
C*****************************************************
C @INIT BEGSR
C MOVELTITL,1 PHTITL 70
C SETON 77
C SETOF OF
C Z-ADD*ZERO P#STS status
C ENDSR
C*****************************************************
C @MAIN BEGSR
C*
C SETOF 91
C *IN91 DOWEQ*OFF
C READ DBREC 91
C*
C *IN91 IFEQ *ON
C LEAVE 離脱
C ENDIF
C*
C '@' SCAN MLNAME RC 20 88
C*
C *IN88 IFEQ *ON
C ITER 次へ
C ENDIF
C*
C*１メンバーのデータを用意する
C CALL 'CDS2' CLP
C PARM MLNAME 10 target Member
C PARM P#TLIB 10 target lib
C PARM P#TSRC 10 srcfile name
C PARM P#WLIB 10 tool lib
C PARM P#WSID 10 JOB
C PARM P#USER 10 USER
C PARM P#JNBR 6 JOB NBR
C*１メンバーのデータを検査する
C CALL 'CDS3' RPG
C PARM MLNAME 10 target Member
C PARM P#TLIB 10 target lib
C PARM P#TSRC 10 srcfile name
C PARM P#WLIB 10 tool lib
C PARM *ZERO W#STS 10 status
C PARM *BLANK W#FLDN 10 Field name
*結果の後処理
C W#STS IFNE *ZERO
*検査で結果の出たメンバー名を印刷する
C 77 SETON OF
C 77 SETOF 77
C OF EXCPTPH01 見出
C EXCPTPM01 明細
*更新する
C MOVEL'9' MLRCEN
C UPDATDBREC
C ELSE
C MOVEL'8' MLRCEN
C UPDATDBREC
C ENDIF
C*
C ENDDO
C*
C *IN77 IFEQ *OFF
C Z-ADD1 P#STS status:ER
C ENDIF
C*
C ENDSR
C*****************************************************
C @END BEGSR
C SETON LR
C RETRN
C ENDSR
C*****************************************************
OQPRINT E 01 PH01
O 1 ' '
O + 0 '***'
O PHTITL + 1
O PAGE Z 128
O + 0 '頁'
O E 02 PH01
O 1 ' '
O E 1 PM01
O 1 ' '
O MLNAME + 0
O W#FLDN + 2
O MLMTXT + 2
O*
** TITL 123456789012345678901234564890123456789012345678901234567890
エラーが存在する可能性があるメンバーリスト
[３]CDS2（CLP）
PGM PARM(&TMBR &TLIB &TSRC &WLIB &WSID &USER &NBR)
DCL VAR(&TMBR) TYPE(*CHAR) LEN(10) /* target Member */
DCL VAR(&TLIB) TYPE(*CHAR) LEN(10) /* target lib */
DCL VAR(&TSRC) TYPE(*CHAR) LEN(10) /* srcfile name */
DCL VAR(&WLIB) TYPE(*CHAR) LEN(10) /* tool lib */
DCL VAR(&WSPL) TYPE(*CHAR) LEN(10) +
VALUE('QSRCTX ') /* spooled file */
DCL VAR(&WSID) TYPE(*CHAR) LEN(10)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&NBR) TYPE(*CHAR) LEN(06)
START:
/*メンバーを印刷する*/
CPYSRCF FROMFILE(&TLIB/&TSRC) TOFILE(*PRINT) +
FROMMBR(&TMBR)
/*印刷をデータに変える*/
CPYSPLF FILE(QSYSPRT) TOFILE(&WLIB/&WSPL) +
JOB(&NBR/&USER/&WSID) SPLNBR(*LAST) +
MBROPT(*REPLACE)
MONMSG MSGID(CPF3303 CPF3309 CPF3342 CPF3344 CPF3478)
DLTSPLF FILE(QSYSPRT) JOB(&NBR/&USER/&WSID) +
SPLNBR(*LAST)
MONMSG MSGID(CPF3303 CPF3309 CPF3342 CPF3344 CPF3478)
ENDPGM
[４]CDS3（RPG）
H Y/ 1
FQSRCTX IF E DISK
F* DTREC KRENAMEDTREC
F KINFDS W#INFO
IDTREC 99
I TEXTDATA SRCDTA
I*ソースレコード
I DS
I 1 198 TXREC
I 7 7 A07
I 17 17 A17
I 19 29 A19NM
I 30 38 A38W
I 30 34 A30S
I 36 37 A36SS
I 37 37 A37
I 38 38 A38
I 45 80 A45K
C *ENTRY PLIST
C PARM MLNAME 10 target Member
C PARM P#TLIB 10 target lib
C PARM P#TSRC 10 srcfile name
C PARM P#WLIB 10 tool lib
C PARM P#STS 10 status
C PARM P#FLDN 10 Field name
C*
C EXSR @INIT
C EXSR @MAIN
C EXSR @END
C*
C*****************************************************
C @INIT BEGSR
C Z-ADD*ZERO P#STS status
C MOVEL*BLANK P#FLDN Field name
C MOVEL*BLANK W@FLDN 10 Field name
C SETOF 5152
C SETOF 6062
C ENDSR
C*****************************************************
C @MAIN BEGSR
*
C SETOF 88 91
C *IN91 DOWEQ*OFF =
C READ DTREC 91
*
C *IN91 IFEQ *ON
C LEAVE 離脱
C ENDIF
*
C 80 SUBSTSRCDTA:21 TXREC 198 P
*
C A07 IFNE *BLANK
C SRCDTA OREQ *BLANK
C ITER 次へ
C ENDIF
*
C EXSR @51 レコード行
C *IN51 IFEQ *ON
C SETOF 88
C ITER 次へ
C ENDIF
*
C EXSR @52 項目名
C *IN88 IFEQ *OFF
C *IN52 IFEQ *ON
C ELSE
C ITER 次へ
C ENDIF
C ENDIF
*
C EXSR @KWD キーワード
C P#STS IFNE *ZERO
C LEAVE 離脱
C ENDIF
C SETON 88 継続する
*
C ENDDO =
*
C ENDSR
C*****************************************************
C @51 BEGSR
C*レコード行を見つける
C*名前または仕様のタイプ１７桁目 R, H, BLANK
C*名前 １９−２８桁目
C A07 IFEQ ' '
C A17 ANDEQ'R'
C A19NM ANDNE*BLANK
C SETON 51
C MOVELA19NM W@FLDN Field name
C ELSE
C SETOF 51
C ENDIF
C ENDSR
C*****************************************************
C @52 BEGSR
C*項目名を見つける
C*使用目的３８桁目 BLANK=O, I, B, H, M, P
C A07 IFEQ ' '
C A17 ANDEQ' '
C A19NM ANDNE*BLANK
C A38 ANDEQ'I'
C A38 OREQ 'B'
C SETON 52
C MOVELA19NM W@FLDN Field name
C EXSR @6061
C ELSE
C SETOF 52
C ENDIF
C ENDSR
C*****************************************************
C @6061 BEGSR
C*文字項目か数字項目か
C A37 IFGE '0' =
C A37 ANDLE'9'
*数字
C SETON 60 文字
C A30S IFEQ ' 1'
C A30S OREQ ' 01'
C SETON 61 １桁
C ELSE
C SETOF 61 １桁でない
C ENDIF
C ELSE =
*文字
C SETOF 60 文字
C ENDIF =
C ENDSR
C*****************************************************
C @KWD BEGSR
C*ＤＤＳキーワードを検査する
C 'CHECK(' SCAN A45K RC 20 77
C *IN77 IFEQ *ON =
C RC ADD 6 W 20
C 'RB' SCAN A45K:W R8 20 78
* CHECK(RB)
C *IN78 IFEQ *ON --
C*** *IN60 IFEQ *ON 数字
C*** *IN61 ANDEQ*OFF １桁でない
C*** Z-ADD1 P#STS status:ER
C*** MOVELW@FLDN P#FLDN P Field name
C*** ENDIF
C *IN60 IFEQ *OFF 文字
C *IN61 ANDEQ*OFF １桁でない
C Z-ADD1 P#STS status:ER
C MOVELW@FLDN P#FLDN P Field name
C ENDIF
C ELSE --
C 'RZ' SCAN A45K:W R8 20 79
* CHECK(RZ)
C *IN79 IFEQ *ON ---
C *IN60 IFEQ *OFF 文字
C Z-ADD1 P#STS status:ER
C MOVELW@FLDN P#FLDN P Field name
C ENDIF
C ENDIF ---
C ENDIF --
C ENDIF =
*
C ENDSR
C*****************************************************
C @END BEGSR
C SETON LR
C RETRN
C ENDSR
C*****************************************************（補足１）汎用の198桁のテキストデータTOOLLIB/QSRCTX。事前に準備する。
A R DTREC
A TEXTDATA 198O
