最新では IFSのストリーム・ファイルを取り扱うことも多くなっているが
CPYFRMSTMF などのコマンドを使って DB2/400 にコピーや復元を繰り返すのは
泥臭い方法でもあり、何より CPYFRMSTMF や CPYTOSTMF 等の IFS関連のコマンドは
まだまだバグが多く安心して使用することができない。
それでは RPG プログラムで直接、 IFSのストリーム・ファイル を処理することは
できないのであろうか ?
C/400 プログラムでないとストリーム・ファイルの入出力はできないのではないかと
あきらめている方に、今回、RPGで直接、ストリーム・ファイルを処理する方法を紹介しよう。
RPG プログラムでストリーム・ファイルを処理する方法は IBMマニュアルも含めて
どこにも紹介されていないが、実現は可能である。
ILE-RPG でも直接、 IFSSのストリーム・ファイルを読み取ることができるのである。
通常、 IFS に保管されているストリーム・ファイルは API : open, read, ... 等を
使ってC/400で読み取るのが普通であるが、ここでは RPG によって C/400関数を
直接、起動して読み取る方法を紹介する。
米国ではこのような事例を紹介するときは RPG のフリーフォーマット形式の RPGソースを
紹介するのがほとんどであるが、国内では RPGフリーフォーマットは、それほどまだ
普及していないようであるので、わかりやすいように通常の固定形式の RPGソースを作成した。
従って C/400関数のプロト・タイプも自前で RPG の中で定義している。
0001.00 H DFTNAME(OPNSTMF) DATEDIT(*YMD/) BNDDIR('QC2LE')
0002.00 F********** ストリーム・ファイルの読取り *****************************
0003.00 F*
0004.00 F**********************************************************************
0005.00 D OPEN PR 4B 0 EXTPROC('open')
0006.00 D PATH * VALUE OPTIONS(*STRING)
0007.00 D OPT 4B 0 VALUE
0008.00
0009.00 D LSTAT PR 4B 0 EXTPROC('lstat')
0010.00 D FILE * VALUE OPTIONS(*STRING)
0011.00 D INFO * VALUE OPTIONS(*STRING)
0012.00
0013.00 D READ PR 4B 0 EXTPROC('read')
0014.00 D FILEID 4B 0 VALUE
0015.00 D FILBUF * VALUE OPTIONS(*STRING)
0016.00 D FILSIZ 4B 0 VALUE
0017.00
0018.00 D CLOSE PR 4B 0 EXTPROC('close')
0019.00 D FILEID 4B 0 VALUE
0020.00
0021.00 D PERROR PR 4B 0 EXTPROC('perror')
0022.00 D MSGTTL * VALUE OPTIONS(*STRING)
0023.00
0024.00 D PRINTF PR EXTPROC('printf')
0025.00 D STR1 * VALUE OPTIONS(*STRING)
0026.00 D STR2 * VALUE OPTIONS(*NOPASS)
0027.00
0028.00 D GETCHAR PR EXTPROC('getchar')
0029.00
0030.00 D HTML C CONST('/A001/INDEX.HTM')
0031.00 D FILE S 256A
0032.00 D FILDES S 4B 0 INZ(0)
0033.00 D TRUE S 4B 0 INZ(0)
0034.00 D FALSE S 4B 0 INZ(-1)
0035.00 D O_RDONLY S 4B 0 INZ(1)
0036.00 D O_WRONLY S 4B 0 INZ(2)
0037.00 D O_APPEND S 4B 0 INZ(256)
0038.00 D O_CREAT S 4B 0 INZ(8)
0039.00 D O_EXCL S 4B 0 INZ(16)
0040.00 D O_TRUNC S 4B 0 INZ(64)
0041.00 D NULL S 1A INZ(X'00')
0042.00
0043.00 D*( ファイル属性 )
0044.00 D INFO_P S * INZ(%ADDR(INFO))
0045.00 D INFO DS 128
0046.00 D ALLOCSIZ 45 48B 0
0047.00
0048.00 D ASCBUF DS 1024 BASED(TMPBUF)
0049.00 D EBCBUF S 1024
0050.00 D TMPBUF S *
0051.00 D TMPLEN S 4B 0 INZ(0)
0052.00 D BYTE_RED S 4B 0 INZ(0)
0053.00
0054.00 C*( ファイルのオープン )
0055.00 C MOVEL HTML FILE
0056.00 C CAT(P) NULL:0 FILE
0057.00 C EVAL FILDES = OPEN(FILE: O_RDONLY)
0058.00 C* ( オープン失敗 )
0059.00 C FILDES IFEQ FALSE
0060.00 C CALLP PERROR('OPEN FAIL')
0061.00 C ELSE
0062.00 C* ( オープン成功 )
0063.00 C CALLP LSTAT(HTML: INFO_P)
0064.00 C EVAL TMPLEN = ALLOCSIZ
0065.00 C EVAL TMPBUF = %ALLOC(TMPLEN)
0066.00 C EVAL BYTE_RED = READ(FILDES:TMPBUF:TMPLEN)
0067.00 C CALLP CLOSE(FILDES)
0068.00 C* ( ストリームを EBCDIC に変換して表示する )
0069.00 C Z-ADD BYTE_RED BUFLEN
0070.00 C Z-ADD BUFLEN MAXOTL
0071.00 C*--------------------------------------------------------------------+
0072.00 C CALL 'QDCXLATE' 99
0073.00 C PARM BUFLEN 5 0
0074.00 C PARM ASCBUF
0075.00 C PARM 'QTCPEBC ' TBL 10
0076.00 C PARM 'QUSRSYS ' TBLLIB 10
0077.00 C PARM EBCBUF
0078.00 C PARM MAXOTL 5 0
0079.00 C PARM OUTLEN 5 0
0080.00 C PARM '*JPN ' KANJI 10
0081.00 C PARM 'N' SISO 1
0082.00 C PARM '*AE ' TRNSLT 10
0083.00 C*--------------------------------------------------------------------+
0084.00 C CALLP PRINTF(EBCBUF)
0085.00 C END
0086.00 C CALLP GETCHAR
0087.00 C SETON LR 
【 コンパイル 】
CRTRPGMOD QTEMP/OPNSTMF SRCFILE(MYSRCLIB/QRPGLESRC) AUT(*ALL) CRTPGM MYLIB/OPNSTMF MODULE(QTEMP/OPNSTMF) ACTGRP(*NEW) AUT(*ALL)
【 解説 】
ファイルのオープン関数 : open によって /A001/INDEX.HTM という IFS のをオープンしてから ファイルの属性を取得すると
ストリーム・ファイル関数 : lstat によって、
このファイルが割り振られているサイズ ALLOCSIZ を取得している。
サイズ ALLOCSIZ が取得できたら、その大きさの変数 : をTMPBUF %ALLOC によって動的に
割り振っている。
TMPBUF は元々、単なるポインターであるが %ALLOC によって、そのポインターから
サイズ分の変数領域を生成しているのである。
ストリーム・ファイルの大きさは一定ではないので初めにサイズを調べておいてから
読み取り関数 : read によってストリーム・ファイルを読み取るのである。
実際に読み取られたバイト数は BYTE_READ に保管される。
結果を表示するために コード変換 API: QDCXLATE によって ASCII から EBCDIC に変換して
C/400 の printf 関数によってストリーム・ファイルの内容を表示している。
printf 関数とは C/400 で頻繁に使用される標準出力の表示/印刷の関数である。
RPG で QHTTPSVR/QTMHCGI を使って CGI を開発した人であれば QtmhWrStout という何やら
難しい名前のプロシージャーを使うことになったはずだが 実は標準出力を行うには
QtmhWrStoutの代わりに C/400 の printf を上記のように使用するだけでよい。
このプログラムを十分、理解できるようになれば、RPGプログラマーであっても
C/400 にだけしか使用できないと思われていた、どのような API でも RPG で使用することが
できるようになるはずである。
参考までに上記を C/400 で記述したソース・コードを以下に紹介する。
0001.00 #include <stdio.h>
0002.00 #include <stdlib.h>
0003.00 #include <string.h>
0004.00 #include <fcntl.h>
0005.00
0006.00 #define TRUE 0
0007.00 #define FALSE -1
0008.00 void main(void){
0009.00 int fildes = FALSE;
0010.00 struct stat info;
0011.00 char* tmpbuf;
0012.00 long tmplen, m_byte_red;
0013.00
0014.00 if((fildes = open("/A001/INDEX.HTM", O_RDONLY)) == FALSE){/* OPEN ER
0015.00 perror("FAILED OPEN");
0016.00 exit(0);
0017.00 }/* OPEN ERR */
0018.00 lstat("/A001/INDEX.HTM", &info);
0019.00 tmplen = (int)info.st_allocsize;
0020.00 tmpbuf = (char*)malloc(tmplen);
0021.00 memset(tmpbuf, 0, sizeof(tmpbuf));
0022.00 m_byte_red = read(fildes, tmpbuf, tmplen);
0023.00 close(fildes);
0024.00 tmpbuf[m_byte_red] = 0x00;
0025.00 free(tmpbuf);
0026.00 printf("%sn", tmpbuf);
0027.00 getchar();
0028.00 }
【 コンパイル 】
CRTBNDC MYLIB/OPNSTMF SRCFILE(MYSRCLIB/QCSRC) AUT(*ALL)