Le web de Dominique Guebey – IBM AS/400 iSeries

Page : http://www.dg77.net/tekno/as400/cl_sqlftp.htm


   D o m i n i q u e   G u e b e y    J u n g l e     IBM AS/400 iSeries

Extraction de fichiers sur AS/400-iSeries puis envoi par FTP

Résumé

Adaptations éventuelles

Le CL

/* ENVOI D'UNE EXTRACTION DE DEUX FICHIERS                                */

/* Principe : on enregistre dans une dataarea la date du dernier jour   . */
/*  traîté. Format : jjmmaa                                               */
/*  On sélectionne les enregistrements dont la date d'enregistrement du   */
/*  paiement est dans une plage qui va du LENDEMAIN de la date contenue   */
/*  dans la dataarea à la VEILLE de la date en cours.                     */

/*  Pour relancer dans une plage donnée, on peut modifier la DATAAREA     */
/*  (CHGDTAARA ...), modifier la date du jour (CHGJOB DATE(jjmmaa))       */
/*  puis envoyer : CALL SCH_PGC                                           */

PGM

DCL &NOMDTAR *CHAR 0010 'SCH_PGC   '  /* NOM DE LA DTAARA             */
DCL &DATDEB  *CHAR 0006               /* DERNIERE DATE + 1 JOUR       */
DCL &DATFIN  *CHAR 0006               /* JOUR EN COURS -1             */
DCL &ERR     *CHAR 0001 ' '           /* ERREUR DATE ENVOYEE          */
DCL &ZDEB    *CHAR 0010 '20  -  -  '
DCL &ZFIN    *CHAR 0010 '20  -  -  '
DCL &SQL1    *CHAR 0512
DCL &SQL2    *CHAR 0512
DCL &NBRE    *CHAR 0009
DCL &NOMFIFE *CHAR 0026
DCL &NOMFIFL *CHAR 0026
DCL &SED     *CHAR 0128
DCL &PUT     *CHAR 0128
DCL &MSGERR  *CHAR 0256

/* FICHIERS DE TRAVAIL - du fait de l'utilisation de cdes QSHELL, on ne  */
/*                       peut se servir de la bibliothèque QTEMP.        */
CRTLIB TRAVAIL
  MONMSG CPF0000
DLTF   TRAVAIL/PGCECDE
  MONMSG CPF0000
DLTF   TRAVAIL/PGCLCDE
  MONMSG CPF0000
CRTDUPOBJ PGCECDE BIBLIO_SRC *FILE TOLIB(TRAVAIL)
  MONMSG CPF0000
CRTDUPOBJ PGCLCDE BIBLIO_SRC *FILE TOLIB(TRAVAIL)
  MONMSG CPF0000

/* RECUPERATION DE LA DATE DERNIER TRAITEMENT                            */
RTVDTAARA BIBLIO_SRC/&NOMDTAR &DATDEB
MONMSG CPF1015 EXEC(DO)
   CHGVAR &MSGERR VALUE('DTAARA ' !! &NOMDTAR !! ' NON TROUVéE')
   GOTO FINERR                                                              
ENDDO                                                                       
MONMSG CPF1016 EXEC(DO)                                                     
   CHGVAR &MSGERR VALUE('ACCES NON AUTORISE A LA DTAARA ' !! &NOMDTAR)
   GOTO FINERR                                                              
ENDDO                                                                       
MONMSG CPF1021 EXEC(DO)                                                     
   CHGVAR &MSGERR VALUE('BIBLIOTHEQUE DE LA DTAARA ' !! &NOMDTAR !! ' +
   NON TROUVEE')      
   GOTO FINERR                                                              
ENDDO                                                                       
MONMSG CPF1022 EXEC(DO)                                                     
   CHGVAR &MSGERR VALUE('ACCES NON AUTORISE A LA BIBLIOTHEQUE DE LA +
   DTAARA ' !! &NOMDTAR)
   GOTO FINERR                                                              
ENDDO                                                                       
MONMSG CPF1063 EXEC(DO)                                                     
   CHGVAR &MSGERR VALUE('IMPOSSIBLE D ALLOUER LA DTAARA ' !! &NOMDTAR)
   GOTO FINERR                                                              
ENDDO                                                                       
MONMSG CPF1067 EXEC(DO)                                                     
   CHGVAR &MSGERR VALUE('IMPOSSIBLE D ALLOUER LA BIBLIOTHEQUE DE LA DTAARA ' +
   !! &NOMDTAR)
   GOTO FINERR                                                              
ENDDO                                                                       

/* CALCULE LA FOURCHETTE DE DATES à TRAITER  */
CALL SCH_PGC1 (&DATDEB &DATFIN &ERR)
IF COND(&ERR *EQ '1') THEN(DO)
   CHGVAR &MSGERR VALUE('DATE ' !! &DATDEB !! ' FAUSSE, VOIR DTAARA SCH_PGC' +
   !! &NOMDTAR)
   GOTO FINERR
ENDDO

CHGVAR (%SST(&ZDEB 3 2)) (%SST(&DATDEB 5 2))
CHGVAR (%SST(&ZDEB 6 2)) (%SST(&DATDEB 3 2))
CHGVAR (%SST(&ZDEB 9 2)) (%SST(&DATDEB 1 2))
CHGVAR (%SST(&ZFIN 3 2)) (%SST(&DATFIN 5 2))
CHGVAR (%SST(&ZFIN 6 2)) (%SST(&DATFIN 3 2))
CHGVAR (%SST(&ZFIN 9 2)) (%SST(&DATFIN 1 2))

/* "POPULATION" DES FICHIERS DE TRAVAIL                                */
/* UTILISATION DE QSHELL :                                   */
/*   1) NOTER L'ANTISLASH AVANT LE DOLLAR                    */
/*      (SINON ERREUR CAR LA ZONE E OU L N'EXISTE PAS ! )    */
/*   2) BIBLIOTHEQUE QTEMP INUTILISABLE                      */
  /* REDIRIGE LES SORTIES DE QSHELL */
  DLTF       FILE(TRAVAIL/STDOUTPGC)
  MONMSG     CPF2105
  CRTPF      FILE(TRAVAIL/STDOUTPGC) RCDLEN(128)
  OVRDBF     STDOUT TRAVAIL/STDOUTPGC

/* Extraction par SQL - 1er fichier                          */
CHGVAR &SQL1 VALUE('DB2 "INSERT INTO TRAVAIL.PGCECDE SELECT * +
  FROM BIBLIO_SRC.PGCECDE WHERE E\$DISP >= ''' *CAT &ZDEB *CAT '''' +
  *BCAT 'AND E\$DISP <= ''' *CAT &ZFIN *CAT ''' AND E\$CMOO +
  NOT IN (''1'', ''2'', ''3'', ''4'')"')
QSH CMD(&SQL1)

/* Extraction par SQL - 2e fichier                         */
CHGVAR &SQL2 VALUE('DB2 "INSERT INTO TRAVAIL.PGCLCDE             + 
        SELECT * FROM SHARBDD.PGCLCDE WHERE L\$ICDE IN            + 
        (SELECT E\$ICDE FROM SHARBDD.PGCECDE                      + 
        WHERE E\$DISP >= ''' *CAT &ZDEB *CAT '''' *BCAT           + 
         'AND E\$DISP <= ''' *CAT &ZFIN *CAT '''                  + 
          AND E\$CMOO NOT IN (''1'', ''2'', ''3'', ''4''))"')
QSH CMD(&SQL2)

/* Transfert dans l'IFS avec la date de fin dans le nom      */
DEL '/tmp/SCH_PGC_tmp.txt'
  MONMSG CPF0000

CPYTOIMPF TRAVAIL/PGCECDE TOSTMF('/tmp/SCH_PGC_tmp.txt')      +
   MBROPT(*REPLACE) STMFCODPAG(*PCASCII) RCDDLM(*CRLF)   +
   FLDDLM(';') DECPNT(*COMMA) DATFMT(*EUR)
CHGVAR &NOMFIFE VALUE('/tmp/pgcecde' *CAT &ZFIN *CAT '.csv')
   /* Ote les blancs du fichier - et gare au CCSID ! */
CHGVAR &SED VALUE('sed -e "s/ //g" /tmp/SCH_PGC_tmp.txt | + 
       iconv -f 1147 -t 1252 > ' !! &NOMFIFE)
QSH CMD(&SED)

CPYTOIMPF TRAVAIL/PGCLCDE TOSTMF('/tmp/SCH_PGC_tmp.txt')      +
   MBROPT(*REPLACE) STMFCODPAG(*PCASCII) RCDDLM(*CRLF)   +
   FLDDLM(';') DECPNT(*COMMA) DATFMT(*EUR)
CHGVAR &NOMFIFL VALUE('/tmp/pgclcde' *CAT &ZFIN *CAT '.csv')
   /* Ote les blancs du fichier - et gare au CCSID ! */
CHGVAR &SED VALUE('sed -e "s/ //g" /tmp/SCH_PGC_tmp.txt | + 
       iconv -f 1147 -t 1252 > ' !! &NOMFIFL)               
QSH CMD(&SED)                                                      

/* CREATION DU SCRIPT                                             */
CPYF BIBLIO_SRC/QFTPSRC BIBLIO_SRC/QFTPSRC FROMMBR(SCH_PGC_I1) +
    TOMBR(SCH_PGC_IN) MBROPT(*REPLACE) CRTFILE(*NO)
CHGVAR &PUT VALUE('print "PUT' *BCAT &NOMFIFE *CAT +
    '" >> /qsys.lib/BIBLIO_SRC.lib/qftpsrc.file/SCH_pgc_in.mbr')
QSH CMD(&PUT)
CHGVAR &PUT VALUE('print "PUT' *BCAT &NOMFIFL *CAT +
    '" >> /qsys.lib/BIBLIO_SRC.lib/qftpsrc.file/SCH_pgc_in.mbr')
QSH CMD(&PUT)
CPYF BIBLIO_SRC/QFTPSRC BIBLIO_SRC/QFTPSRC FROMMBR(SCH_PGC_I2) +
    TOMBR(SCH_PGC_IN) MBROPT(*ADD)

/* ENVOI DES FICHIERS PAR FTP                                     */
DLTOVR    INPUT
  MONMSG    CPF0000
DLTOVR    OUTPUT
  MONMSG    CPF0000
CLRPFM BIBLIO_SRC/QFTPSRC SCH_PGC_OU
  MONMSG CPF0000
OVRDBF    INPUT  BIBLIO_SRC/QFTPSRC SCH_PGC_IN   /* SCRIPT                  */
OVRDBF    OUTPUT BIBLIO_SRC/QFTPSRC SCH_PGC_OU   /* REDIRIGE LA SORTIE LOG  */

FTP       DRAYAF2.SCRIBTEL.NET              /* LANCE LE TRANSFERT    */

DLTOVR    INPUT
  MONMSG    CPF0000
DLTOVR    OUTPUT
  MONMSG    CPF0000

/* Vérifier la bonne fin du ftp : on doit avoir 2 transmissions OK */
DLTDTAARA TRAVAIL/SCH_TMP
  MONMSG CPF0000
CRTDTAARA TRAVAIL/SCH_TMP *CHAR 9
  MONMSG CPF0000
QSH CMD('grep -c "226 Transfer OK" +
/QSYS.LIB/BIBLIO_SRC.LIB/QFTPSRC.FILE/SCH_PGC_OU.MBR | datarea -w +
/QSYS.LIB/TRAVAIL.LIB/SCH_tmp.dtaara')
RTVDTAARA  BIBLIO_SRC/SCH_TMP RTNVAR(&NBRE)
IF COND(&NBRE *NE '2        ') THEN(DO)
       CHGVAR &MSGERR VALUE('LE TRANSFERT VERS SCHMURKTZ A ÉCHOUÉ, +
       VOIR LE LOG SHARBDD/QFTPSRC(SCH_PGC_OU)')   GOTO FINERR
ENDDO

/* - - - - - - - - - - - - - - - - - - - - - */
/* ON MET A JOUR LA DATE DERNIER JOUR TRAITE                         */
CHGDTAARA (BIBLIO_SRC/&NOMDTAR (1 6)) VALUE(&DATFIN)
  MONMSG CPF0000

FIN:  /* - - - - - - - - - - - - - - - - - - - - - */
/*GOTO FINFIN            /* SAUT POUR DEBUG */

        /* MENAGE FINAL - - - - - */
DLTOVR STDOUT
  MONMSG CPF0000
DLTF   TRAVAIL/STDOUTPGC
  MONMSG CPF0000
DLTF   TRAVAIL/PGCECDE
  MONMSG CPF0000
DLTF   TRAVAIL/PGCLCDE
  MONMSG CPF0000
DEL &NOMFIFE
  MONMSG CPF0000
DEL &NOMFIFL
  MONMSG CPF0000
CLRPFM BIBLIO_SRC/QFTPSRC SCH_PGC_OU
  MONMSG CPF0000
DLTDTAARA TRAVAIL/SCH_TMP
  MONMSG CPF0000
DEL '/tmp/SCH_PGC_tmp.txt'
  MONMSG CPF0000          
DLTSPLF *SELECT SELECT(*CURRENT *ALL *ALL QZSHSH)    
  MONMSG CPF0000                                     
DLTSPLF *SELECT SELECT(*CURRENT *ALL *ALL QP0ZSPWP)  
  MONMSG CPF0000

GOTO FINFIN

FINERR: /* Message + eMail signalant une anomalie - - - - - - - */
SNDUSRMSG MSG(&MSGERR) MSGTYPE(*INFO)
SNDDST TYPE(*LMSG) TOINTNET(('yukyo.mushimoyaàbigfoot.org')) DSTD('x') +
    LONGMSG(&MSGERR) + 
    SUBJECT('Probleme pour SCH_PGC')
MONMSG CPF0000
/*  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
FINFIN:
ENDPGM

Le programme RPG

Nom : SCH_PGC1. Noter l’instruction MONITOR pour prévoir le cas où la donnée entrée n’est pas une date valable (Erreur RNX0112). Noter aussi l’utilisation des fonctions évoluées de calculs de dates par ajout où soustraction.

 * Ce programme reçoit en premier paramètre une date au format JJMMAA. 
 * Cette date (DATDEB) est transformée en la date du jour suivant.     
 * Dans une deuxième date (DATFIN), on met la date de la veille        
 *  du jour en cours.                                                  
d caldeb          S               D   DATFMT(*DMY)                     
d calfin          S               D   DATFMT(*DMY)                     
C     *Entry        PList                                              
C                   Parm                    DATDEB            6        
C                   Parm                    DATFIN            6        
C                   Parm                    ERR               1        
C                   MONITOR                                            
C                   MOVE      DATDEB        N6                6 0      
C     *DMY          MOVE      N6            caldeb                     
C                   adddur    1:*D          caldeb                     
C                   MOVE      UDATE         calfin                     
C     calfin        subdur    1:*D          calfin                     
 /FREE                                             
  if  caldeb > calfin;                             
      caldeb = calfin;                             
  endif;                                           
 /END-FREE                                         
C                   MOVE      caldeb        N6     
C                   MOVE      N6            DATDEB 
C                   MOVE      calfin        N6     
C                   MOVE      N6            DATFIN 
 /FREE                                             
  On-Error 112;                                    
       ERR = '1';                                  
  endmon;                                          
  *inlr='1';                                       
 /END-FREE                                         

Le script 1ère partie

Cf nom dans le CL : BIBLIO_SRC/QFTPSRC(SCH_PGC_I1). Namefmt 1 pour utilisation des noms de répertoires à la mode UNIX. Si namefmt 0, on localise les objets dans des bibliothèques OS/400, avec une syntaxe du genre : /QSYS.LIB/MABIBLIO.LIB/CLIENTS.FILE/TOTO.MBR.

alfons 2trt984ff
alfons 2trt984ff
namefmt 1      
BINARY         

Le script 2e partie

Cf nom dans le CL : BIBLIO_SRC/QFTPSRC(SCH_PGC_I2).

QUIT

Le script aprés exécution.

Cf nom dans le CL : BIBLIO_SRC/QFTPSRC(SCH_PGC_IN).

alfons 2trt984ff
alfons 2trt984ff
namefmt 1                      
BINARY                         
PUT /tmp/pgcecde2004-01-02.csv 
PUT /tmp/pgclcde2004-01-02.csv 
QUIT                           

Exemple de log

Commande DSPPFM BIBLIO_SRC/QFTPSRC MBR(SCH_PGC_OU)

Output redirected to a file.                                          
Input read from specified override file.                              
Connecting to host Konsole-SKATZ at address 192.168.1.118 using port 21.
220-FileZilla Server version 0.9.22 beta                              
220-written by Tim Kosse (Tim.Kosse@gmx.de)                           
220 Please visit http://sourceforge.net/projects/filezilla/           
Enter login ID (django):                                              
331 Password required for alfons
230 Logged on                                                         
UNIX emulated by FileZilla                                            
Enter an FTP subcommand.                                              
> > alfons ********                                                      
Subcommand 'alfons' not valid.                                         
For a list of available FTP subcommands, enter subcommand HELP.       
Enter an FTP subcommand.                                              
> > namefmt 1                                                           
200 Now using naming format "1"                                       
Client NAMEFMT is 1.                                                  
Enter an FTP subcommand.                                                
> > BINARY                                                                
200 Type set to I                                                       
Enter an FTP subcommand.                                                
> > PUT /tmp/pgcecde2004-01-02.csv                                        
227 Entering Passive Mode (192,168,6,8,6,219)                           
150 Connection accepted                                                 
226 Transfer OK
825099 bytes transferred in 0.882 seconds. Transfer rate 935.660 KB/sec.
Enter an FTP subcommand.                                                
> > PUT /tmp/pgclcde2004-01-02.csv                                        
227 Entering Passive Mode (192,168,6,8,6,220)                           
150 Connection accepted                                                 
226 Transfer OK
524853 bytes transferred in 0.561 seconds. Transfer rate 936.323 KB/sec.
Enter an FTP subcommand.                 
> > QUIT                                   
221 Goodbye