RPGでのポインタの扱いに慣れたところで
ポインタを使ってIFSストリーム・ファイルのオープンを
練習してみよう。

[ RPG : TESTSTM ]
ソースはこちらから
0001.00 H DFTNAME(TESTSTM) DATEDIT(*YMD/) BNDDIR('QC2LE')
0002.00 F********** IFS ストリー・ファイルのオープン **************************
0003.00 F*
0004.00 F**********************************************************************
0005.00 *( open 関数 )
0006.00 D OPEN PR 4B 0 EXTPROC('open')
0007.00 D PATH * VALUE OPTIONS(*STRING)
0008.00 D OPT 4B 0 VALUE
0009.00
0010.00 *( lstat 関数 )
0011.00 D LSTAT PR 4B 0 EXTPROC('lstat')
0012.00 D FILE * VALUE OPTIONS(*STRING)
0013.00 D INFO * VALUE OPTIONS(*STRING)
0014.00
0015.00 *( read 関数 )
0016.00 D READ PR 4B 0 EXTPROC('read')
0017.00 D FILEID 4B 0 VALUE
0018.00 D FILBUF * VALUE OPTIONS(*STRING)
0019.00 D FILSIZ 4B 0 VALUE
0020.00
0021.00 *( close 関数 )
0022.00 D CLOSE_ PR 4B 0 EXTPROC('close')
0023.00 D FILEID 4B 0 VALUE
0024.00
0025.00 *( perror 関数 )
0026.00 D PERROR PR 4B 0 EXTPROC('perror')
0027.00 D MSGTTL * VALUE OPTIONS(*STRING)
0028.00
0029.00 *( printf 関数 )
0030.00 D PRINTF PR EXTPROC('printf')
0031.00 D STR1 * VALUE OPTIONS(*STRING)
0032.00 D STR2 * VALUE OPTIONS(*NOPASS)
0033.00
0034.00 *( getchar 関数 )
0035.00 D GETCHAR PR EXTPROC('getchar')
0036.00
0037.00 D HTML C CONST('/FILE.FDF')
0038.00 D FILE S 256A
0039.00 D FILDES S 4B 0 INZ(0)
0040.00 D TRUE S 4B 0 INZ(0)
0041.00 D FALSE S 4B 0 INZ(-1)
0042.00 D O_RDONLY S 4B 0 INZ(1)
0043.00 D O_WRONLY S 4B 0 INZ(2)
0044.00 D O_APPEND S 4B 0 INZ(256)
0045.00 D O_CREAT S 4B 0 INZ(8)
0046.00 D O_EXCL S 4B 0 INZ(16)
0047.00 D O_TRUNC S 4B 0 INZ(64)
0048.00 D NULL S 1A INZ(X'00')
0049.00
0050.00 D*( ファイル属性 )
0051.00 D INFO_P S * INZ(%ADDR(INFO))
0052.00 D INFO DS 128 QUALIFIED
0053.00 D ALLOCSIZ 45 48B 0
0054.00
0055.00 D ASCBUF DS 1024 BASED(TMPBUF)
0056.00 D EBCBUF S 1024
0057.00 D TMPBUF S *
0058.00 D TMPLEN S 4B 0 INZ(0)
0059.00 D BYTE_RED S 4B 0 INZ(0)
0060.00
0061.00 /FREE
0062.00 //( ファイルのオープン )
0063.00 FILE = %TRIMR(HTML) + NULL;
0064.00 FILDES = OPEN(FILE: O_RDONLY);
0065.00 //( オープン失敗 )
0066.00 IF FILDES = FALSE;
0067.00 PERROR('OPEN FAILED');
0068.00 //( オープン成功 )
0069.00 ELSE;
0070.00 LSTAT(HTML: INFO_P);
0071.00 TMPLEN = INFO.ALLOCSIZ;
0072.00 TMPBUF = %ALLOC(TMPLEN);
0073.00 BYTE_RED = READ(FILDES: TMPBUF: TMPLEN);
0074.00 CLOSE_(FILDES);
0075.00 ENDIF;
0076.00 /END-FREE
0077.00 C* ( ストリームを EBCDIC に変換して表示する )
0078.00 C Z-ADD BYTE_RED BUFLEN
0079.00 C Z-ADD BUFLEN MAXOTL
0080.00 C*--------------------------------------------------------------------+
0081.00 C CALL 'QDCXLATE' 99 |
0082.00 C PARM BUFLEN 5 0 |
0083.00 C PARM ASCBUF
0084.00 C PARM 'QTCPEBC ' TBL 10 |
0085.00 C PARM 'QUSRSYS ' TBLLIB 10 |
0086.00 C PARM EBCBUF
0087.00 C PARM MAXOTL 5 0 |
0088.00 C PARM OUTLEN 5 0 |
0089.00 C PARM '*JPN ' KANJI 10 |
0090.00 C PARM 'N' SISO 1 |
0091.00 C PARM '*AE ' TRNSLT 10 |
0092.00 C*--------------------------------------------------------------------+
0093.00 C CALLP PRINTF(EBCBUF)
0094.00 C DEALLOC TMPBUF
0095.00 C CALLP GETCHAR
0096.00 C SETON LR
[コンパイル]
CRTBNDRPG PGM(TEST.COM/TESTSTM) SRCFILE(R610SRC/QRPGLESRC) DFTACTGRP(*NO)
ACTGRP(*NEW) DBGVIEW(*SOURCE) AUT(*ALL)
[解説]
IFSのストリーム・ファイルが苦手という方もまだ多いと思うがこのサンプル・プログラムは
任意のIFSにASCIIコードで保管されているIFSストリーム・ファイルを読取って
EBCIDCに変換して表示する。
C言語で記述すると
FILDES = open("/FILE.FDF", O_RDONLY);
if(FILDES == FALSE) perror("OPEN FAILED");
else{
lstat("/FILE.FDF", &info);
TMPLEN = info.allocsize;
TMPBUF = (char*)alloc(TMPLEN);
BYTE_RED = read(FILDES, TMPBUF, TMPLEN);
close(TMPBUF);
}
という記述になる。
lstat関数というのはストリーム・ファイルの属性を取得する関数であり
取得したバイト数 info.allocsize の分だけメモリーを確保(alloc)して
readで読取り読取った実際のバイト数が BYTE_REDである。
ここでのポインタの注目は読取りバッファーが TMPBUF というポインタであり
必要な長さの分だけを alloc でメモリ確保して読取り処理が終わったら
最後に DEALLOC で解放していることである。
このようにストリーム・ファイルを読むときは動的にメモリを
ポインタから始まって確保する必要がある。
