最新では 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)