H DFTNAME(ADDINPUT) DATEDIT(*YMD/)                                                             
     F********** FTP INPUT ファイルの作成 **********************************                        
     FINPUT     UF A F   92        DISK                                                             
     F**********************************************************************                        
                                                                                                    
      * CRTRPGMOD  OBJ(QTEMP/ADDINPUT)    SRCFILE(R610SRC/QRPGLESRC)                                
      * DBGVIEW(*SOURCE) AUT(*ALL)                                                                  
      * CRTPGM PGM(QUATTRO/ADDINPUT)  MODULE(QTEMP/ADDINPUT)  ACTGRP(*NEW)                          
      *        AUT(*ALL)                                                                            
                                                                                                    
      *-------------------------------------------------------------------*                         
      *  2020/12/04 : 作成                                                                          
      *-------------------------------------------------------------------*                         
      *( 作業変数 )                                                                                 
     D DTR             S             80    DIM(4) CTDATA PERRCD(1)                                  
     D AR              S              1A   DIM(256)                                                 
     D N               S              4S 0                                                          
     D M               S              4S 0                                                          
     D LEN             S              4S 0                                                          
     D TRUE            S              1A   DIM(256)                                                 
     D TRUE#           S              4B 0 INZ(0)                                                   
     D FALSE#          S              4B 0 INZ(-1)                                                  
     D QUOT            C                   CONST(X'7D')                                             
     D OE              C                   CONST(X'0E')                                             
     D OF              C                   CONST(X'0F')                                             
     D NULL            C                   CONST(X'00')                                             
     D ELEM            S              4S 0                                                          
     D HEAD            S             80A                                                            
     D TRAIL           S             80A                                                            
                                                                                                    
     D*( プログラム状況データ構造 )                                                                 
     D INFDS_THIS     SDS                                                                           
     D  PROC_NAM         *PROC                                                                      
     D  ROUTINE          *ROUTINE                                                                   
     D                              512A                                                            
     D  PGMINFO                1    512                                                             
     D  LINE_NUM              21     28                                                             
     D  CPFID                 40     46                                                             
     D  CPFDTA                91    170                                                             
     D  ERRMSGID              46     51                                                             
     D  CURUSR               358    367                                                             
                                                                                                    
     D*( WORK 日付 YYMMDD ｺﾞｰn 構造  )                                                              
     D DATEDS          DS                                                                           
     D  CENTURY                1      2  0 INZ(20)                                                  
     D  YYMMDD                 3      8  0                                                          
     D  YY                     3      4                                                             
     D  MM                     5      6                                                             
     D  DD                     7      8                                                             
     D  CYY                    1      4                                                             
                                                                                                    
     IINPUT     BB  01                                                                              
     I                                 13   92  SRCDTA                                              
                                                                                                    
     C*-------------------------------------------------------------------------+                   
     C     *ENTRY        PLIST                                                  |                   
     C                   PARM                    LIB              10            |                   
     C                   PARM                    FROMIP           15            |                   
     C                   PARM                    FROMPASS        128            |                   
     C                   PARM                    TOIP             15            |                   
     C                   PARM                    TOPASS          128            |                   
     C                   PARM                    USER             13            |                   
     C                   PARM                    PASWRD           13            |                   
     C                   PARM                    OPT               4            |                   
     C*-------------------------------------------------------------------------+                   
     C                   EVAL      SRCDTA = %TRIMR(USER) + ' ' +                                    
     C                               %TRIMR(PASWRD)                                                 
     C*-----------------------------------------------------------------                            
     C                   EXCEPT    @SRCDTA                                                          
     C*-----------------------------------------------------------------                            
     C                   ADD       1             SRCNO                                              
     C                   EVAL      ELEM = %ELEM(DTR)                                                
     C     1             DO        ELEM          N                              DO-LOOP-N           
     C                   MOVEL     DTR(N)        SRCDTA                                             
      *( LIB )                                                                                      
     C     N             IFEQ      2                                            N=2                 
     C                   IF        OPT = '*LIB'                                 *LIB                
     C                   EXSR      REPLACE                                                          
     C                   ELSE                                                   *LIB                
     C                   ITER                                                                       
     C                   ENDIF                                                  *LIB                
     C                   ENDIF                                                  N=2                 
      *( IFS )                                                                                      
     C     N             IFEQ      3                                            N=2                 
     C                   IF        OPT = '*IFS'                                 *IFS                
     C                   EXSR      REPLACE                                                          
     C                   ELSE                                                   *IFS                
     C                   ITER                                                                       
     C                   ENDIF                                                  *IFS                
     C                   ENDIF                                                  N=2                 
     C*-----------------------------------------------------------------                            
     C                   EXCEPT    @SRCDTA                                                          
     C*-----------------------------------------------------------------                            
     C                   ADD       1             SRCNO                                              
     C                   ENDDO                                                  DO-LOOP-N           
     C                   SETON                                        LR                            
     C                   RETURN                                                                     
     C******************************************************                                        
     C     *INZSR        BEGSR                                                                      
     C******************************************************                                        
     C*  初期 CYCLE のみの実行                                                                      
     C                   Z-ADD     1             SRCNO             6 2                              
     C                   ENDSR                                                                      
     C******************************************************                                        
     C     REPLACE       BEGSR                                                                      
     C******************************************************                                        
     C     AGAIN         TAG                                                                        
     C     '%ﾍ'          SCAN      SRCDTA:1      M                        50                        
     C     *IN50         IFEQ      *ON                                          FOUND               
     C                   SUB       1             M                                                  
     C                   EVAL      HEAD = %SUBST(SRCDTA:1:M)                                        
     C                   ADD       3             M                                                  
     C     80            SUB       M             LEN                                                
     C                   EVAL      TRAIL = %SUBST(SRCDTA:M:LEN)                                     
     C                   EVAL      SRCDTA = %TRIMR(HEAD) +                                          
     C                               %TRIMR(LIB) + TRAIL                                            
     C                   GOTO      AGAIN                                                            
     C                   ENDIF                                                  FOUND               
     C                   ENDSR                                                                      
     OINPUT     EADD         @SRCDTA                                                                
     O                       SRCDTA              92                                                 
     O                       SRCNO                6                                                 
                                                                                                    
** DTR                                                                                              
BINARY                                                                                              
PUT QTEMP/%ﾍ /BACKUP/V3R7/LIB/%ﾍ.SAV                                                                
PUT IFSLIB/%ﾍ /BACKUP/V3R7/IFS/%ﾍ.SAV                                                               
QUIT