H DFTNAME(TESTSTM) DATEDIT(*YMD/) BNDDIR('QC2LE')                                              
     F********** IFS ストリー・ファイルのオープン **************************                        
     F*                                                                                             
     F**********************************************************************                        
      *( ﾅﾆｵﾄ 関数 )                                                                                
     D OPEN            PR             4B 0 EXTPROC('ﾅﾆｵﾄ')                                          
     D   PATH                          *   VALUE OPTIONS(*STRING)                                   
     D  OPT                           4B 0 VALUE                                                    
                                                                                                    
      *( ﾂﾍﾎｱﾎ 関数 )                                                                               
     D LSTAT           PR             4B 0 EXTPROC('ﾂﾍﾎｱﾎ')                                         
     D   FILE                          *   VALUE OPTIONS(*STRING)                                   
     D   INFO                          *   VALUE OPTIONS(*STRING)                                   
                                                                                                    
      *( ﾈｵｱｴ 関数 )                                                                                
     D READ            PR             4B 0 EXTPROC('ﾈｵｱｴ')                                          
     D  FILEID                        4B 0 VALUE                                                    
     D  FILBUF                         *   VALUE OPTIONS(*STRING)                                   
     D  FILSIZ                        4B 0 VALUE                                                    
                                                                                                    
      *( ｳﾂﾅﾍｵ 関数 )                                                                               
     D CLOSE_          PR             4B 0 EXTPROC('ｳﾂﾅﾍｵ')                                         
     D  FILEID                        4B 0 VALUE                                                    
                                                                                                    
      *( ﾆｵﾈﾈﾅﾈ 関数 )                                                                              
     D PERROR          PR             4B 0 EXTPROC('ﾆｵﾈﾈﾅﾈ')                                        
     D   MSGTTL                        *   VALUE OPTIONS(*STRING)                                   
                                                                                                    
      *( ﾆﾈｹﾄﾎｶ 関数 )                                                                              
     D PRINTF          PR                  EXTPROC('ﾆﾈｹﾄﾎｶ')                                        
     D   STR1                          *   VALUE OPTIONS(*STRING)                                   
     D   STR2                          *   VALUE OPTIONS(*NOPASS)                                   
                                                                                                    
      *( ｷｵﾎｳｸｱﾈ 関数 )                                                                             
     D GETCHAR         PR                  EXTPROC('ｷｵﾎｳｸｱﾈ')                                       
                                                                                                    
     D HTML            C                   CONST('/FILE.FDF')                                       
     D FILE            S            256A                                                            
     D FILDES          S              4B 0 INZ(0)                                                   
     D TRUE            S              4B 0 INZ(0)                                                   
     D FALSE           S              4B 0 INZ(-1)                                                  
     D O_RDONLY        S              4B 0 INZ(1)                                                   
     D O_WRONLY        S              4B 0 INZ(2)                                                   
     D O_APPEND        S              4B 0 INZ(256)                                                 
     D O_CREAT         S              4B 0 INZ(8)                                                   
     D O_EXCL          S              4B 0 INZ(16)                                                  
     D O_TRUNC         S              4B 0 INZ(64)                                                  
     D NULL            S              1A   INZ(X'00')                                               
                                                                                                    
     D*( ファイル属性 )                                                                             
     D INFO_P          S               *   INZ(%ADDR(INFO))                                         
     D INFO            DS           128    QUALIFIED                                                
     D  ALLOCSIZ              45     48B 0                                                          
                                                                                                    
     D ASCBUF          DS          1024    BASED(TMPBUF)                                            
     D EBCBUF          S           1024                                                             
     D TMPBUF          S               *                                                            
     D TMPLEN          S              4B 0 INZ(0)                                                   
     D BYTE_RED        S              4B 0 INZ(0)                                                   
                                                                                                    
      /FREE                                                                                         
       //( ファイルのオープン )                                                                     
       FILE = %TRIMR(HTML) + NULL;                                                                  
       FILDES = OPEN(FILE: O_RDONLY);                                                               
       //( オープン失敗 )                                                                           
       IF FILDES = FALSE;                                                                           
         PERROR('OPEN FAILE');                                                                      
       //( オープン成功 )                                                                           
       ELSE;                                                                                        
         LSTAT(HTML: INFO_P);                                                                       
         TMPLEN = INFO.ALLOCSIZ;                                                                    
         TMPBUF = %ALLOC(TMPLEN);                                                                   
         BYTE_RED = READ(FILDES: TMPBUF: TMPLEN);                                                   
         CLOSE_(FILDES);                                                                            
       ENDIF;                                                                                       
      /END-FREE                                                                                     
     C*  ( ストリームを EBCDIC に変換して表示する )                                                 
     C                   Z-ADD     BYTE_RED      BUFLEN                                             
     C                   Z-ADD     BUFLEN        MAXOTL                                             
     C*--------------------------------------------------------------------+                        
     C                   CALL      'QDCXLATE'                           99      |                   
     C                   PARM                    BUFLEN            5 0          |                   
     C                   PARM                    ASCBUF                                             
     C                   PARM      'QTCPEBC   '  TBL              10            |                   
     C                   PARM      'QUSRSYS   '  TBLLIB           10            |                   
     C                   PARM                    EBCBUF                                             
     C                   PARM                    MAXOTL            5 0          |                   
     C                   PARM                    OUTLEN            5 0          |                   
     C                   PARM      '*JPN '       KANJI            10            |                   
     C                   PARM      'N'           SISO              1            |                   
     C                   PARM      '*AE '        TRNSLT           10            |                   
     C*--------------------------------------------------------------------+                        
     C                   CALLP     PRINTF(EBCBUF)                                                   
     C                   DEALLOC                 TMPBUF                                             
     C                   CALLP     GETCHAR                                                          
     C                   SETON                                        LR