ここで紹介するTESTREAD というRPGプログラムは
①任意のデータ・ベースを読取る
②任意のレコード長を読取り警告エラーは出ない。
③超高速でデータ・ベースを読取る
という長所を兼ね備えたプログラムである。
大量のデータ・ペースも一瞬に読み取って処理することができる
スグレモノである。
1万レコードの読取りなどはホンの一瞬で終わるので
その速さに驚くかも知れない。
汎用的にどのデータ・ベースでも読取ることができる技術として米国で紹介されていたのを
少し改良したものである。
[TESTREADの実行画面]
C 関数による読取り (TESTREAD)
選択項目を入力して，実行キーを押してください。
ファイル . . . . . . . . . . . SHOHIN 名前
ライブラリー . . . . . . . . QTRFIL 名前 , *LIBL, *CURLIB
メンバー . . . . . . . . . . . *FIRST 名前 , *FIRST, *LAST, *ALL
[コマンド: TESTREAD ]
ソースはこちらから
0001.00 CMD PROMPT('C 関数による読取り ')
0002.00 PARM KWD(FILE) TYPE(FILE) MAX(1) +
0003.00 PROMPT(' ファイル ')
0004.00 FILE: QUAL TYPE(*NAME) LEN(10) MIN(1)
0005.00 QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
0006.00 SPCVAL((*LIBL) (*CURLIB '*CURLIB ')) +
0007.00 EXPR(*YES) PROMPT(' ライブラリー ')
0008.00 PARM KWD(MEMBER) TYPE(*NAME) LEN(10) DFT(*FIRST) +
0009.00 SPCVAL((*FIRST) (*LAST) (*ALL)) +
0010.00 PROMPT(' メンバー ')
[コンパイル]
CRTCMD CMD(OBJLIB/TESTREAD) PGM(OJLIB/TESTREADCL) SRCFILE(R610SRC/QCMDSRC) AUT(*ALL)
[ CLP: TESTREADCL ]
ソースはこちらから
0001.00 PGM PARM(&FILFILLIB &MBR)
0002.00 /*----------------------------------------------------------------------*/
0003.00 /* TESTREADCL : C 関数による読取り */
0004.00 /* */
0005.00 /* 2021/11/25 作成 */
0006.00 /*----------------------------------------------------------------------*/
0007.00 DCL VAR(&FILFILLIB) TYPE(*CHAR) LEN(20)
0008.00 DCL VAR(&FILE) TYPE(*CHAR) LEN(10)
0009.00 DCL VAR(&FILLIB) TYPE(*CHAR) LEN(10)
0010.00 DCL VAR(&MBR) TYPE(*CHAR) LEN(10)
0011.00 DCL VAR(&MSG) TYPE(*CHAR) LEN(132)
0012.00 DCL VAR(&STMMSG) TYPE(*CHAR) LEN(132)
0013.00 DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
0014.00 DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
0015.00 DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
0016.00 DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4)
0017.00 DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132)
0018.00 DCL VAR(&ERRDTA) TYPE(*CHAR) LEN(132)
0019.00 DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)
0020.00 DCL VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)
0021.00 DCL VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) +
0022.00 VALUE('*ESCAPE ')
0023.00 DCL VAR(&ERR) TYPE(*CHAR) LEN(1)
0024.00 DCL VAR(&NULL4) TYPE(*CHAR) LEN(4) +
0025.00 VALUE(X'00000000')
0026.00 DCL VAR(&APIERR) TYPE(*CHAR) LEN(116) +
0027.00 VALUE(X'000074') /* 2 進数 */
0028.00 MONMSG MSGID(CPF9999) EXEC(GOTO CMDLBL(ERROR))
0029.00
0030.00 /*( 環境の取得 )*/
0031.00 RTVJOBA TYPE(&TYPE)
0032.00 IF COND(&TYPE *EQ '0') THEN(DO) /* バッチ */
0033.00 CHGVAR VAR(&TOPGMQ) VALUE('*SYSOPR ')
0034.00 ENDDO /* バッチ */
0035.00 ELSE CMD(DO) /* 対話式 */
0036.00 CHGVAR VAR(&TOPGMQ) VALUE('*TOPGMQ ')
0037.00 ENDDO /* 対話式 */
0038.00
0039.00 /*( 入力パラメータの取得 )*/
0040.00 CHGVAR VAR(&FILE) VALUE(%SST(&FILFILLIB 01 10))
0041.00 CHGVAR VAR(&FILLIB) VALUE(%SST(&FILFILLIB 11 10))
0042.00
0043.00 /*( プログラムの実行 )*/
0044.00 CALL PGM(TEST.COM/TESTREAD) PARM(&FILE &FILLIB +
0045.00 &MBR &ERR &MSG)
0046.00 IF COND(&ERR *EQ ' ') THEN(DO)
0047.00 CHGVAR VAR(&MSGTYPE) VALUE('*DIAG ')
0048.00 ENDDO
0049.00 IF COND(&MSG *NE ' ') THEN(DO)
0050.00 GOTO SNDMSG
0051.00 ENDDO
0052.00 RETURN
0053.00
0054.00 ERROR: RCVMSG MSGTYPE(*LAST) RMV(*NO) KEYVAR(&MSGKEY) +
0055.00 MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
0056.00 MSGFLIB(&MSGFLIB)
0057.00 IF COND(&MSGID *EQ 'CPF9999') THEN(DO)
0058.00 CHGVAR VAR(&ERRDTA) VALUE(&MSGDTA)
0059.00 RCVMSG MSGTYPE(*PRV) MSGKEY(&MSGKEY) RMV(*NO) +
0060.00 MSG(&MSG) MSGDTA(&MSGDTA) MSGID(&MSGID) +
0061.00 MSGF(&MSGF) MSGFLIB(&MSGFLIB)
0062.00 CHGVAR VAR(&STMMSG) VALUE(' プログラム ' *CAT +
0063.00 %SST(&ERRDTA 8 10) *TCAT +
0064.00 ' のステートメント ' *CAT %SST(&ERRDTA +
0065.00 24 4) *CAT ' で次のエラーが発生しました。 ')
0066.00 SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&STMMSG) +
0067.00 TOMSGQ(&TOPGMQ) MSGTYPE(*DIAG)
0068.00 ENDDO
0069.00 SNDMSG: IF COND(&MSGID *EQ ' ') THEN(DO)
0070.00 SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +
0071.00 TOMSGQ(&TOPGMQ) MSGTYPE(&MSGTYPE)
0072.00 MONMSG MSGID(CPF2400) EXEC(RETURN)
0073.00 ENDDO
0074.00 ELSE CMD(DO)
0075.00 SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
0076.00 MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +
0077.00 MSGTYPE(&MSGTYPE)
0078.00 MONMSG MSGID(CPF2400) EXEC(RETURN)
0079.00 ENDDO
0080.00 ENDPGM
[コンパイル]
CRTCLPGM PGM(OBJLIB/TESTREADCL) SRCFILE(MYSRCLIB/QCLSRC) OPTION(*SRCDG) AUT(*ALL)
[解説]
コマンド入力されたファイル名、ライブラリー名とメンバー名をプログラム: TESTREAD に渡して
実行している。
[ RPG : TESTREAD ]
ソースはこちらから
0001.00 H DFTNAME(TESTREAD) DATEDIT(*YMD/)
0002.00 F********** C 関数による読取り ****************************************
0003.00 F*
0004.00 F**********************************************************************
0005.00
0006.00 * CRTBNDRPG OBJ(OBJLIB/TESTREAD) SRCFILE(MYSRCLIB/QRPGLESRC)
0007.00 * DFTACTRP(*NO) ACTGRP(*NEW) DBGVIEW(*SOURCE) AUT(*ALL)
0008.00
0009.00 *-------------------------------------------------------------------*
0010.00 * 2021/11/25 : 作成
0011.00 *-------------------------------------------------------------------*
0012.00 *( 作業変数 )
0013.00 D TRUE# S 4B 0 INZ(0)
0014.00 D FALSE# S 4B 0 INZ(-1)
0015.00 D EOF# S 4B 0 INZ(-1)
0016.00 D DFT C CONST(X'0B000100')
0017.00 D OE# C CONST(X'0E')
0018.00 D OF# C CONST(X'0F')
0019.00
0020.00 D*( _Ropen のプロトタイプ宣言 )
0021.00 *[ 例 ]
0022.00 * RFILE = _Ropen("ASNET.USR/USRLIBL", "rr")
0023.00 D Ropen PR * ExtProc('_Ropen')
0024.00 D RFILE * VALUE OPTIONS(*STRING:*TRIM)
0025.00 D OPTION * Value OPTIONS(*STRING:*TRIM)
0026.00
0027.00 D*( _Rreadn のプロトタイプ宣言 )
0028.00 * _RIOFB_T*_Rreadn(_RFILE *, void *, size_t, int);
0029.00 *[ 例 ]
0030.00 D Rreadn PR * ExtProc('_Rreadn')
0031.00 D RFILE * Value
0032.00 D RECORD * Value
0033.00 D RCD_LEN 10I 0 Value
0034.00 D OPT 10I 0 Value
0035.00
0036.00 D*( _Rclose のプロトタイプ宣言 )
0037.00 D Rclose PR 10I 0 ExtProc('_Rclose')
0038.00 D RFILE * Value
0039.00
0040.00 D IOFB_P S *
0041.00 D RIOFB DS 64 QUALIFIED
0042.00 D BASED(IOFB_P)
0043.00 D KEY *
0044.00 D SYSPRM *
0045.00 D RRN 10I 0
0046.00 D NUM_BYTE 10I 0
0047.00
0048.00 D RFILE DS 336 QUALIFIED
0049.00 D BASED(RFILE_P)
0050.00 D BUF_LENGTH 193 196I 0
0051.00
0052.00 D RCD_LEN S 10I 0
0053.00 D DATA S 5000A
0054.00 D RFILE_P S *
0055.00 D BYTES S 10I 0
0056.00 D HIVAL S 1N INZ(*ON)
0057.00
0058.00 C*-------------------------------------------------------------------------+
0059.00 C *ENTRY PLIST |
0060.00 C PARM FILE 10 |
0061.00 C PARM FILLIB 10 |
0062.00 C PARM MBR 10 |
0063.00 C*-------------------------------------------------------------------------+
0064.00 /FREE
0065.00 RFILE_P = Ropen(%TRIMR(FILLIB) + '/' + %TRIMR(FILE): 'rr');
0066.00 RCD_LEN = RFILE.BUF_LENGTH;
0067.00 DOW HIVAL;
0068.00 IOFB_P = Rreadn(RFILE_P: %ADDR(DATA): RCD_LEN: DFT);
0069.00 IF (RIOFB.NUM_BYTE = EOF#);
0070.00 LEAVE;
0071.00 ENDIF;
0072.00 EXSR CHECK;
0073.00 /END-FREE
0074.00 C********************************
0075.00 C* レコードの処理はここから *
0076.00 C********************************
0077.00 C EXSR PRINT
0078.00 C********************************
0079.00 C* レコードの処理はここまで *
0080.00 C********************************
0081.00 /FREE
0082.00 ENDDO;
0083.00 Rclose(RFILE_P);
0084.00 /END-FREE
0085.00 C SETON LR
0086.00 C RETURN
0087.00 C******************************************************
0088.00 C CHECK BEGSR
0089.00 C******************************************************
0090.00 C ENDSR
0091.00 C******************************************************
0092.00 C PRINT BEGSR
0093.00 C******************************************************
0094.00 C ENDSR
[コンパイル]
CRTBNDRPG PGM(TEST.COM/TESTREAD) SRCFILE(R610SRC/QRPGLESRC) DFTACTGRP(*NO)
ACTGRP(*NEW) DBGVIEW(*SOURCE) AUT(*ALL)
[解説]
RPG : TESTREAD はC言語のデータ・ベース読取り関数: _Ropen, _Rreadn, _Rclose を
使って処理している。
このうち _Rreadn は読取りバイト数を指定して読み取るので
読取りのときに警告エラーが出ることはない。
_Ropen で読み取るとレコード長: BUF_LENGTH を取得することができるので
その長さを指定して読み取ればよい。
0064.00 /FREE 0065.00 RFILE_P = Ropen(%TRIMR(FILLIB) + '/' + %TRIMR(FILE): 'rr'); 0066.00 RCD_LEN = RFILE.BUF_LENGTH; 0067.00 DOW HIVAL; 0068.00 IOFB_P = Rreadn(RFILE_P: %ADDR(DATA): RCD_LEN: DFT); 0069.00 IF (RIOFB.NUM_BYTE = EOF#); 0070.00 LEAVE; 0071.00 ENDIF; 0072.00 EXSR CHECK; 0073.00 /END-FREE : 0081.00 /FREE 0082.00 ENDDO; 0083.00 Rclose(RFILE_P); 0084.00 /END-FREE
が読取り処理である。１万件くらいのファイルを読んでも瞬時に終わるので
驚かれる。
この技術は弊社の次の追加機能にも使われている。
製品とするのであれば高速処理が当然必要なのでこの技術を採用している。
