IFS

32. RPGでIFSファイルをオープンする

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 で解放していることである。
このようにストリーム・ファイルを読むときは動的にメモリを
ポインタから始まって確保する必要がある。