H DFTNAME(TESTDBF) DATEDIT(*YMD/) BNDDIR('QC2LE') DFTACTGRP(*NO)                               
     F**********  D/B レコード名の検索 ********************************                             
     F*                                                                                             
     F*****************************************************************                             
                                                                                                    
     D APIERR          DS                  QUALIFIED                                                
     D  GETBYT                 1      4B 0 INZ(160)                                                 
     D  AVLBYT                 5      8B 0 INZ(0)                                                   
     D  MSGID                  9     15                                                             
     D  MSGDTA                17    160                                                             
                                                                                                    
     D*( QDBRTVFD のプロトタイプ宣言 )                                                              
     D QDBRTVFD        PR                  EXTPGM('QSYS/QDBRTVFD')                                  
     D  FMTBUF                    32727A   CONST                                                    
     D  FMTLEN                       10I 0 CONST                                                    
     D  RTNFILLIB                    20A   CONST                                                    
     D  FOTMAT                        8A   CONST                                                    
     D  FILFILLIB                    20A   CONST                                                    
     D  MBR                          10A   CONST                                                    
     D  OPT                           1A   CONST                                                    
     D  FILETYPE                     10A   CONST                                                    
     D  EXT                          10A   CONST                                                    
     D  APIERR                             LIKEDS(APIERR)                                           
     D                                     OPTIONS(*VARSIZE)                                        
                                                                                                    
      *( 作業変数 )                                                                                 
     D FILSCOPE        S            160A                                                            
     D RECORD          S             10A                                                            
     D POS             S             10I 0 INZ(513)                                                 
     D SIZE            S             10I 0 INZ(160)                                                 
     D N               S              4S 0                                                          
     D ANS             S              1A                                                            
     D FMTBUF          DS         32767    QUALIFIED                                                
     D  RECNUM                15     16B 0                                                          
     D FMTLEN          S             10I 0 INZ(32767)                                               
     D RTNFILLIB       DS                  QUALIFIED                                                
     D  FILE                   1     10                                                             
     D  FILLIB                11     20                                                             
                                                                                                    
     D FILEDS          DS                  QUALIFIED                                                
     D  FILE                   1     10                                                             
     D  FILLIB                11     20                                                             
                                                                                                    
     C*-------------------------------------------------------------------------+                   
     C     *ENTRY        PLIST                                                  |                   
     C                   PARM                    FILE_            10            | ファイル名        
     C                   PARM                    FILLIB_          10            | ライブラリー名    
     C*-------------------------------------------------------------------------+                   
      /FREE                                                                                         
          QDBRTVFD(FMTBUF:FMTLEN:RTNFILLIB:'FILD0100':FILEDS:'*FIRST':'0':                          
                '*FILETYPE ': '*EXT': APIERR);                                                      
          IF APIERR.AVLBYT > 0;                                                                     
            DSPLY  (%TRIMR(FILEDS) + ' の誤りです。 ' ) '' ANS;                                     
          ELSE;                                                                                     
            FOR N = 1 TO FMTBUF.RECNUM;                                                             
              FILSCOPE = %SUBST(FMTBUF:POS:160);                                                    
              RECORD   = %SUBST(FILSCOPE:69:10); // 取得したレコード名                              
              POS = POS + SIZE;                                                                     
            ENDFOR;                                                                                 
          ENDIF;                                                                                    
          *INLR = *ON;                                                                              
          RETURN;                                                                                   
      /END-FREE                                                                                     
      ***********************************************************                                   
     C     *INZSR        BEGSR                                                  * 初期値セット      
      ***********************************************************                                   
      /FREE                                                                                         
        FILEDS.FILE   = FILE_;                                                                      
        FILEDS.FILLIB = FILLIB_;                                                                    
      /END-FREE                                                                                     
     C                   ENDSR