Le web de Dominique Guebey – IBM AS/400 iSeries

Page : http://www.dg77.net/tekno/as400/as400cl.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

Commande AS400 avec prompt pour selection jusqu’à 20 codes

Saisie d’un nombre variable de zones. Utilisation d’OPNQRYF, sélection suivant nom de zones de fichiers BD et mapping de zones numériques. Utilise CPYFRMQRYF Sortie d’un fichier dans l’IFS formaté par un programme Java. Envoi d’un message final à l’utilisateur qui a lancé le job.

                     POSITIONS LISTE CPTES/PERIODE (FACGEN)

 Indiquez vos choix, puis appuyez sur ENTREE.

 Liste de comptes . . . . . . . .   +______       Valeur alpha
              + si autres valeurs   _______
 Depuis   (JJMMAA)  . . . . . . .   ______        Valeur alpha
 Jusqu'à  (JJMMAA)  . . . . . . .   ______        Valeur alpha
 Nom fichier  . . . . . . . . . .   __________    Valeur alpha











                                                                            Fin
 F3=Exit   F4=Invite   F5=Réafficher   F12=Annuler   F13=Mode d'emploi invite
 F24=Autres touches
 Paramètre LISTE obligatoire.                                                 +

En mettant "+" sur la première zone, l’écran offrira les 20 zones prévues :

             Définition d'autres valeurs du paramètre LISTE

 Indiquez vos choix, puis appuyez sur ENTREE.

 Liste de comptes . . . . . . . .   _______       Valeur alpha
                                    _______
                                    _______
                                    _______
                                    _______
                                    _______
                                    _______
                                    _______
                                    _______
                                    _______
                                    _______
                                    _______
                                    _______
                                    _______
                                    _______

                                                                    A suivre...
 F3=Exit   F4=Invite   F5=Réafficher   F12=Annuler   F13=Mode d'emploi invite
 F24=Autres touches
 Paramètre LISTE obligatoire.

Commande

/* Dernier parametre : CONSTANTE recuperee dans une data area nommee */
/* DGBIBLIO, contenant le nom de la bibliotheque ou se trouvent tous */
/* les modules.                                                      */
/*                                                                   */
/* 1er parametre "LISTE" : 20 zones de 7 caracteres                  */
/*                                                                   */
CMD PROMPT('POSITIONS LISTE CPTES/PERIODE')

PARM KWD(LISTE) TYPE(*CHAR) LEN(7) MIN(1) MAX(20) FULL(*YES) +
     PROMPT('Liste de comptes')
PARM KWD(DAT6D) TYPE(*CHAR) LEN(6) MIN(1) FULL(*YES) +
     PROMPT('Depuis   (JJMMAA)')
PARM KWD(DAT6F) TYPE(*CHAR) LEN(6) MIN(1) FULL(*YES) +
     PROMPT('Jusqu''à  (JJMMAA)')
PARM KWD(NOMFIC) TYPE(*CHAR) LEN(10) FULL(*NO )      +
     PROMPT('Nom fichier')

PARM DTA *CNAME 10 CONSTANT(DGBIBLIO) DTAARA(*YES)
PARM WKSTN *PNAME 10 CONSTANT('          ') DTAARA(*YES)

Création de la commande


/** FACGEN   : LISTE DE POSITIONS FACTURES (LISTE DE CPTE/PERIODE)
CRTCMD     CMD(&LIB/FACGEN) PGM(&LIB/FACGENCL) +
           SRCFILE(&LIB/QCMDSRC) SRCMBR(FACGENCMD) +
           TEXT('POS. POUR COMPTES/PERIODE    ')

Programme CLP FACGENCL.

/* CE CL SE LANCE LUI-MEME EN BATCH                     */

/* PARAMETRES :                                         */
/* &LISTE  : LISTE DES COMPTES                          */
/* &DAT6D  : DATE DE DEBUT (AAMMJJ)                     */
/* &DAT6F  : DATE DE FIN   (AAMMJJ)                     */
/* &NOMFIC : NOM DE FICHIER SORTI                       */
/* &DTA    : DTAARA CONTENANT LE NOM DE LA BIBLIO       */
/*           DE CES PROGRAMMES                          */
/*                                                                   */
/* Variable LISTE : saisie par prompt de jusqu'a 20 zones de 7 carac-*/
/* teres : on recupere 142 octets, les deux premiers contiennent en  */
/* binaire la longueur des zones saisies.                            */
/* Voir la commande RENTACMD pour le parametrage d'une liste saisie. */

/* ATTENTION : LE NOM DE BIBLIOTHEQUE DE TRAVAIL ET DES */
/* PROGRAMMES (&LIB) EST UN PARAMETRE FIXE DE LA        */
/* COMMANDE     , VOIR   &LIB/QCMDSRC(       )          */
/* VOIR   &LIB/QCLSRC(GENCOMCL) POUR CREER LA COMMANDE  */

PGM PARM(&LISTE &DAT6D &DAT6F &NOMFIC &DTA &WKSTN)
DCL &LISTE  *CHAR 142
DCL &DAT6D  *CHAR 06
DCL &DAT6F  *CHAR 06
DCL &TRAV   *CHAR 160
DCL &CT     *DEC  3 0
DCL &C01 *CHAR 7
DCL &C02 *CHAR 7
DCL &C03 *CHAR 7
DCL &C04 *CHAR 7
DCL &C05 *CHAR 7
DCL &C06 *CHAR 7
DCL &C07 *CHAR 7
DCL &C08 *CHAR 7
DCL &C09 *CHAR 7
DCL &C10 *CHAR 7
DCL &C11 *CHAR 7
DCL &C12 *CHAR 7
DCL &C13 *CHAR 7
DCL &C14 *CHAR 7    
DCL &C15 *CHAR 7
DCL &C16 *CHAR 7
DCL &C17 *CHAR 7
DCL &C18 *CHAR 7
DCL &C19 *CHAR 7
DCL &C20 *CHAR 7
DCL &TYPE   *CHAR 01
DCL &NOMFIC *CHAR 10
DCL &DTA    *CHAR 10
DCL &WKSTN  *CHAR 10
DCL &LIB    *CHAR 10

ADDLIBLE GUEBEY
MONMSG CPF0000
CALL SBRBIBCL PARM(&DTA &LIB)/* Nom de la bibliotheque de travail */
MONMSG CPF0000
    /* NOM JOB = NOM FICHIER SORTI */
IF COND(&NOMFIC *EQ '          ') THEN(CHGVAR +
                          VAR(&NOMFIC) VALUE('Enzliste'))

/* INTERACTIF SEULEMENT POUR TESTS */
/* GOTO OK */
/* TESTE SI BATCH : --------------------------------- */
         RTVJOBA    TYPE(&TYPE)
    /* SI OUI : TRAITEMENT                */
         IF         COND(&TYPE *EQ '0') THEN(GOTO CMDLBL(OK))
    /* SI NON, ENVOI EN BATCH            */
RTVJOBA    JOB(&WKSTN)
            RTVDTAARA  DTAARA(&DTA (1 10)) RTNVAR(&LIB)
         SBMJOB CMD(CALL PGM(&LIB/FACGENCL) +
PARM(&LISTE &DAT6D &DAT6F &NOMFIC &DTA &WKSTN)) JOB(&NOMFIC)
         RETURN

/* --------------------------------------------- */
OK:
CALL &LIB/SBRDATCL PARM(&DAT6D) /* inverse jj et aa */
MONMSG CPF0000
CALL &LIB/SBRDATCL PARM(&DAT6F)
MONMSG CPF0000
ADDLIBLE FR_SPPDTA
MONMSG CPF0000
ADDLIBLE FR_SPPARC
MONMSG CPF0000
DLTF QTEMP/ENZSORTIE
MONMSG CPF0000

CHGVAR &CT VALUE(%BINARY(&LISTE 1 2))
IF (&CT > 00) THEN(CHGVAR &C01 %SST(&LISTE 003 7))
IF (&CT > 01) THEN(CHGVAR &C02 %SST(&LISTE 010 7))
IF (&CT > 02) THEN(CHGVAR &C03 %SST(&LISTE 017 7))
IF (&CT > 03) THEN(CHGVAR &C04 %SST(&LISTE 024 7))
IF (&CT > 04) THEN(CHGVAR &C05 %SST(&LISTE 031 7))
IF (&CT > 05) THEN(CHGVAR &C06 %SST(&LISTE 038 7))
IF (&CT > 06) THEN(CHGVAR &C07 %SST(&LISTE 045 7))
IF (&CT > 07) THEN(CHGVAR &C08 %SST(&LISTE 052 7))
IF (&CT > 08) THEN(CHGVAR &C09 %SST(&LISTE 059 7))
IF (&CT > 09) THEN(CHGVAR &C10 %SST(&LISTE 066 7))
IF (&CT > 10) THEN(CHGVAR &C11 %SST(&LISTE 073 7))
IF (&CT > 11) THEN(CHGVAR &C12 %SST(&LISTE 080 7))
IF (&CT > 12) THEN(CHGVAR &C13 %SST(&LISTE 087 7))
IF (&CT > 13) THEN(CHGVAR &C14 %SST(&LISTE 094 7))
IF (&CT > 14) THEN(CHGVAR &C15 %SST(&LISTE 101 7))      
IF (&CT > 15) THEN(CHGVAR &C16 %SST(&LISTE 108 7))      
IF (&CT > 16) THEN(CHGVAR &C17 %SST(&LISTE 115 7))      
IF (&CT > 17) THEN(CHGVAR &C18 %SST(&LISTE 122 7))      
IF (&CT > 18) THEN(CHGVAR &C19 %SST(&LISTE 129 7))      
IF (&CT > 19) THEN(CHGVAR &C20 %SST(&LISTE 136 7))      

IF (&C01 *GE '0000000' *AND &C01 *LE '9999999') THEN(DO)
   CHGVAR &TRAV VALUE(&C01 *BCAT &C02 +
             *BCAT &C03 *BCAT &C04 +
             *BCAT &C05 *BCAT &C06 +
             *BCAT &C07 *BCAT &C08 +
             *BCAT &C09 *BCAT &C10 +
             *BCAT &C11 *BCAT &C12 +
             *BCAT &C13 *BCAT &C14 +
             *BCAT &C15 *BCAT &C16 +
             *BCAT &C17 *BCAT &C18 +
             *BCAT &C19 *BCAT &C20)
   GOTO PASDTA
   ENDDO
ELSE GOTO TOUT

/* SELECTION DANS *DTA*                          */
CLOF OPNID(ENZENDZE)
MONMSG CPF0000
/* SELECTIONNE COMPTE/PERIODE */
OPNQRYF    FILE((FR_SPPDTA/ENZENDZE)) OPTION(*INP) +
           QRYSLT('                                              +
                   IDZDZE *GT 0                                  +
           *AND    TPZDZE *EQ ''R''                              +
           *AND    DTRGZE *GE D6D                                +
           *AND    DTRGZE *LE D6F                                +
           *AND    FNSTZE *EQ SFDZZE                             +
           *AND    RDSTZE *NE ''XB''                             +
           *AND    DERFZE *EQ %VALUES(' !! &TRAV !! ')           +
           *AND    PFVBZE *NE ''£££''                            +
                 ')                                              +
                   MAPFLD((D6D &DAT6D *DEC 6 0)                  +
                          (D6F &DAT6F *DEC 6 0))
/* FICHIER DE TRAVAIL */
DLTF QTEMP/ENZENDTA
MONMSG CPF0000
CPYFRMQRYF FROMOPNID(ENZENDZE) TOFILE(QTEMP/ENZENDTA) CRTFILE(*YES)
MONMSG CPF0000

TOUT:
CLOF OPNID(ENZENDZE)
MONMSG CPF0000
/* SELECTION /COMPTE/PERIODE */
OPNQRYF    FILE((FR_SPPARC/ENZENDZE)) OPTION(*INP) +
           QRYSLT('                                              +
                   IDZDZE *GT 0                                  +
           *AND    TPZDZE *EQ ''R''                              +
           *AND    DTRGZE *GE D6D                                +
           *AND    DTRGZE *LE D6F                                +
           *AND    FNSTZE *EQ SFDZZE                             +
           *AND    RDSTZE *NE ''XB''                             +
           *AND    PFVBZE *NE ''£££''                            +
                 ')                                              +
                   MAPFLD((D6D &DAT6D *DEC 6 0)                  +
                          (D6F &DAT6F *DEC 6 0))
MONMSG CPF0000
GOTO SUI

PASDTA:

/* SELECTION DANS *ARCHIVES*                          */
CLOF OPNID(ENZENDZE)
MONMSG CPF0000
/* SELECTION /COMPTE/PERIODE */
OPNQRYF    FILE((FR_SPPARC/ENZENDZE)) OPTION(*INP) +
           QRYSLT('                                              +
                   IDZDZE *GT 0                                  +
           *AND    TPZDZE *EQ ''R''                              +
           *AND    DTRGZE *GE D6D                                +
           *AND    DTRGZE *LE D6F                                +
           *AND    FNSTZE *EQ SFDZZE                             +
           *AND    RDSTZE *NE ''XB''                             +
           *AND    DERFZE *EQ %VALUES(' !! &TRAV !! ')           +
           *AND    PFVBZE *NE ''£££''                            +
                 ')                                              +
                   MAPFLD((D6D &DAT6D *DEC 6 0)                  +
                          (D6F &DAT6F *DEC 6 0))
MONMSG CPF0000

SUI:
/* FICHIER DE TRAVAIL */
DLTF QTEMP/ENZENARC
MONMSG CPF0000
/*           CPYFRMQRYF FROMOPNID(ENZENDZE) TOFILE(QTEMP/ENZENARC) +
                          CRTFILE(*YES)                           */
             CPYFRMQRYF FROMOPNID(ENZENDZE) TOFILE(QTEMP/ENZSORTIE) +
                          MBROPT(*REPLACE) CRTFILE(*YES)
MONMSG CPF0000
GOTO PASFUS

/* LES DEUX FICHIERS ACCOLES */
        RUNQRY &LIB/ENZFUSARC /* SELECTIONNE ENZENDTA PAS DANS ENZENARC
             CHKOBJ     OBJ(QTEMP/ENZSORTIE) OBJTYPE(*FILE)
             MONMSG     MSGID(CPF9801) EXEC(DO)
             CRTDUPOBJ  OBJ(ENZENARC) FROMLIB(QTEMP) OBJTYPE(*FILE) +
                          TOLIB(*FROMLIB) NEWOBJ(ENZSORTIE)
                        ENDDO
CPYF QTEMP/ENZENARC QTEMP/ENZSORTIE MBROPT(*ADD) FMTOPT(*NOCHK)
MONMSG CPF0000
PASFUS:
/* DSPPFM QTEMP/ENZSORTIE    */
/* FORMATAGE GENRE CLEROUX/FACTRUC */
/* LIT QTEMP/ENZSORTIE SORT GUEBEY/FACGEN */
RUNQRY &LIB/FACGEN
MONMSG QRY0000 EXEC(DO)
       GOTO ERR
       ENDDO

DLTF   GUEBEY/&NOMFIC
MONMSG CPF0000
RNMOBJ GUEBEY/FACGEN *FILE &NOMFIC
MONMSG CPF0000

/* M.AJ. TEXTE FICHIER + SORTIE DANS IFS                */
CALL &LIB/SBRSORTIE +
     PARM(&LIB &LIB &NOMFIC &C01 ' ')
MONMSG CPF0000

CLOF OPNID(ENZENDZE)
MONMSG CPF0000

/* GARDER FIC. TRAVAIL POUR TESTS */
/* GOTO FIN */

/* DLTF QTEMP/ENZENDTA   */
MONMSG CPF0000
/* DLTF QTEMP/ENZENARC   */
MONMSG CPF0000
/* DLTF QTEMP/ENZSORTIE  */
MONMSG CPF0000

IF COND(&TYPE *EQ '0') THEN(DO)
   CALL PGM(&LIB/SBRMSGCL) PARM(&NOMFIC &LIB &WKSTN)
   MONMSG CPF0000
   ENDDO
GOTO FIN
ERR:
IF COND(&TYPE *EQ '0') THEN(DO)
IF COND(&WKSTN *NE '          ') THEN(DO)
      SNDBRKMSG  MSG('Anomalie : ' !! &NOMFIC !! 'non créé' ) +
           TOMSGQ(&WKSTN)
      MONMSG CPF0000
      ENDDO
   ENDDO
FIN: ENDPGM

Routine SBRBIBCL

/* Ce CL charge le nom de la bibliotheque des programmes             */

PGM PARM(&DTA &LIB)
DCL &DTA    *CHAR 10     /* Nom dtaara contenant le nom de la biblio */
DCL &LIB    *CHAR 10

/* RECUPERE LE NOM DE LA BIBLIOTHEQUE */
RTVDTAARA  DTAARA(&DTA (1 10)) RTNVAR(&LIB)
MONMSG CPF0000
IF COND(&LIB *EQ '          ') THEN(DO)
                         CHGVAR &LIB 'GUEBEY    '
                         ENDDO
ENDPGM

Routine SBRDATCL

/* recoit une date JJMMAA et la restitue sous la forme AAMMJJ, et vice-sersa  */
PGM PARM(&DATE)
DCL &DATE   *CHAR 6
DCL &AA     *CHAR 2
DCL &JJ     *CHAR 2
CHGVAR &AA %SST(&DATE 5 2)
CHGVAR &JJ %SST(&DATE 1 2)
CHGVAR %SST(&DATE 1 2) &AA
CHGVAR %SST(&DATE 5 2) &JJ
ENDPGM

Routine SBRMSGCL

PGM PARM(&NOMFIC &LIB &WKSTN)
DCL &NOMFIC  *CHAR 10
DCL &LIB     *CHAR 10
DCL &WKSTN   *CHAR 10

IF COND(&WKSTN *NE '          ') THEN(DO)
      SNDBRKMSG  MSG('Fichier ' !! &NOMFIC !! ' créé' ) +
           TOMSGQ(&WKSTN)
      MONMSG CPF0000
      ENDDO

FIN: ENDPGM

Routine SBRSORTIE

PGM PARM(&LIB &XBIBL &XFICH &XDESC &PREFIX)
DCL &LIB    *CHAR 10
DCL &XBIBL  *CHAR 10
DCL &XFICH  *CHAR 10
DCL &XDESC  *CHAR 14
DCL &PREFIX *CHAR 14

/* MàJ description du fichier (user date heure taille ...)        */
CALL &LIB/SBRFICTXT PARM(&XBIBL &XFICH &XDESC)
MONMSG CPF0000

/* Génération d'un fichier en format csv dans l'IFS               */
CALL &LIB/SBREXPORT PARM(&LIB &XBIBL &XFICH &PREFIX)
MONMSG CPF0000

ENDPGM

Routine SBRFICTXT

/******************************************************************* */
/*  MODIFICATION DU TEXTE DESCRIPTIF D'UN FICHIER                    */
/*                                                                   */
/*  ON INDIQUE : UTILISATEUR,                                        */
/*               DATE,                                               */
/*               HEURE,                                              */
/*               NOMBRE D'ENREG DU DERNIER MEMBRE DANS L'ORDRE DE    */
/*                   DATE                                            */
/*                   (OU TAILLE SI CE N'EST PAS UN FICHIER PHYSIQUE) */
/*               LIBELLE COURT                                       */
/*                                                                   */
/*  PARAMETRES : NOM DE LA BIBLIOTHEQUE 10 CAR.                      */
/*               NOM DE L'OBJET         10 CAR.                      */
/*               TEXTE LIBRE            14 CAR.                      */
/*                                                                   */
/******************************************************************* */

PGM        PARM(&XBIBL &XFICH &XDESC)

             DCL VAR(&XBIBL) TYPE(*CHAR) LEN(10)
             DCL VAR(&XFICH) TYPE(*CHAR) LEN(10)
             DCL VAR(&XDESC) TYPE(*CHAR) LEN(14)
             DCL VAR(&USRID) TYPE(*CHAR) LEN(10)
             DCL VAR(&DATE)  TYPE(*CHAR) LEN(06)
             DCL VAR(&HEURE) TYPE(*CHAR) LEN(06)
             DCL VAR(&RECO)  TYPE(*DEC)  LEN(10 0)
             DCL VAR(&SIZE)  TYPE(*DEC)  LEN(15 0)
             DCL VAR(&TEXT)  TYPE(*CHAR) LEN(50)

             RTVJOBA    USER(&USRID)
             RTVSYSVAL  SYSVAL(QDATE) RTNVAR(&DATE)
             RTVSYSVAL  SYSVAL(QTIME) RTNVAR(&HEURE)
             /* FICHIER PHYSIQUE : NOMBRE D'ENREG */
             RTVMBRD    FILE(&XBIBL/&XFICH) MBR(*LAST) NBRCURRCD(&RECO)
             /* AUTRE TYPE DE FICHIER : TAILLE */
             MONMSG CPF0000 EXEC(DO)
                            RTVOBJD &XBIBL/&XFICH *FILE SIZE(&SIZE)
                            MONMSG CPF0000
                            CHGVAR &RECO &SIZE
                            CHGVAR %SST(&TEXT 25 1) '*'
                            ENDDO

             CHGVAR %SST(&TEXT 01 10) &USRID
             CHGVAR %SST(&TEXT 12 06) &DATE
             CHGVAR %SST(&TEXT 19 06) &HEURE
             CHGVAR %SST(&TEXT 26 10) &RECO
             CHGVAR %SST(&TEXT 37 14) &XDESC

CHGOBJD &XBIBL/&XFICH *FILE &TEXT
MONMSG CPF0000
ENDPGM

Routine SBREXPORT

**************  Début des données  ************************************
/* CREE UN FICHIER DELIMITE DANS L'IFS                               */
/*                                                                   */
/* Parametres :                                                      */
/* - XBIBL  : bibliotheque du fichier lu                             */
/* - XFICH  : nom du fichier lu                                      */
/* - PREFIX : prefixe facultatif (defaut = userid)                   */
/* - PATH   : emplacement du lecteur reseau dans l'IFS               */
/*            (defaut = /home/guebey/transferts')                    */
/* - NOMF   : nom du fichier a sortir (prefixe + nom fichier)        */
/* - NOMP   : nom complet PATH + NOMF                                */

PGM PARM(&LIB &XBIBL &XFICH &PREFIX)
DCL &LIB     *CHAR 10
DCL &XBIBL   *CHAR 10
DCL &XFICH   *CHAR 10
DCL &PREFIX  *CHAR 10
DCL &PATH    *CHAR 256 *BLANK
DCL &NOMF    *CHAR 256
DCL &NOMFEXT *CHAR 256
DCL &NOMP    *CHAR 256
DCL &CLASSES *CHAR 256
DCL &SYSTEM  *CHAR 10 
DCL &USER    *CHAR 10

RTVNETA SYSNAME(&SYSTEM)

/* CHEMIN PAR DEFAUT */
IF COND(&PATH *EQ *BLANK) THEN(CHGVAR &PATH VALUE('/home/guebey/transferts'))

RTVJOBA USER(&USER)
IF COND(&PREFIX *EQ '          ') THEN(CHGVAR &PREFIX VALUE(&USER))
ELSE IF COND(&XFICH  *EQ &PREFIX) THEN(CHGVAR &PREFIX VALUE(&USER))

  GOTO JAVA

/* UTILISATION DE L'INSTRUCTION CPYTOIMPF */
/* -------------------------------------- */
/* COPIE DANS IFS AVEC SEPARATEUR DE ZONE AUTOMATIQUE                */
  CHGVAR &NOMF VALUE(&PREFIX *TCAT  '_' *TCAT &XFICH *TCAT '.TXT')
  CHGVAR &NOMP VALUE(&PATH *TCAT '/' *TCAT &NOMF)
  CPYTOIMPF  FROMFILE(&XBIBL/&XFICH) TOSTMF(&NOMP) +
           MBROPT(*REPLACE) STMFCODPAG(*STDASCII) +
           RCDDLM(*CRLF) STRDLM(*NONE) FLDDLM(';')
  MONMSG CPF0000
CHGAUT OBJ(&NOMP      ) USER(*PUBLIC) DTAAUT(*NONE) OBJAUT(*ALL)
MONMSG CPF0000
  GOTO FIN

/* UTILISATION D'UNE CLASSE JAVA */
/* ----------------------------- */
JAVA:
CHGVAR &NOMF VALUE(&PREFIX *TCAT  '_' *TCAT &XFICH)
RTVDTAARA &LIB/DGCLASSES &CLASSES
MONMSG CPF0000 EXEC(DO)
       CHGVAR &CLASSES '/home/guebey/java'
       ENDDO
CHGCURDIR &CLASSES
RUNJVA CLASS(JDBCQcsv) PARM(&SYSTEM &XBIBL &XFICH &PATH &NOMF)   +
CLASSPATH('.:/QIBM/PRODDATA/HTTP/PUBLIC/JT400/LIB/JT400.JAR')    +
OUTPUT(*PRINT)
MONMSG JVA0000

/* LE PROGRAMME JAVA RAJOUTE L'EXTENSION AU NOM DU FICHIER */
CHGVAR &NOMFEXT VALUE(&PATH *TCAT '/' *TCAT &NOMF *TCAT '.TXT')
CHGAUT OBJ(&NOMFEXT   ) USER(*PUBLIC) DTAAUT(*R) OBJAUT(*ALL)
MONMSG CPF0000

FIN: ENDPGM

Classe JAVA JDBCQcsv

/**
Lecture d’un fichier AS400/iSeries par SQL/Jdbc, <br />
sort dans l’IFS un fichier CSV (separateurs ";"). <br />
Exemple : java  JDBCQcsv  nomsysteme  nombiblio  nomfichier  cheminIFS nomfichIFS<br />

@author Dominique Guebey d.guebey@abxlogistics.fr
@param nom de l’as400, nom de la bibliotheque, nom du fichier as400,  chemin_ifs, nom_fich_ifs.
@version 25 octobre 2004
*/

// Utilisation de com.ibm.as400.access de jt400.jar
//      cf dans /QIBM/ProdData/HTTP/Public/jt400/lib/
// Inspire au depart du manuel IBM Toolbox for Java version 6. 
// Voir JDBCQtxt derive de JDBCQuery et IFSCopyFile

// Modifications :
//      2004-05-19 : optimisation : sortir une ligne en un bloc au lieu de zone par zone
//      2004-07-21 : optimisation : utiliser "trim" pour supprimer les blancs non significatifs
//      2004-07-21 : si presence d'un ";", remplacement par ","
//      2004-10-25 : optimisation : utilisation de StringBuffer pour charger l'enreg.
// TODO :
//      - AS400Text est "deprecated"
//      - mettre le nom d'user dans le nom du fichier si nomfichIFS=null
//      - pour Excel : remplacer le '.' decimal par ','

import java.sql.*;
import java.io.*;
import java.util.*;
import com.ibm.as400.access.*;

public class JDBCQcsv extends Object 
{
        
// 2004-07-21 : methode "format" supprimee

public static void main (String[] parameters)
{
// Verifie les parametres (2 derniers facultatifs)
if (parameters.length < 3) { return; }
if (parameters.length > 5) { return; }

String chemin = null;
String nomfic = null;

String system = parameters[0];
String collectionName = parameters[1];
String tableName = parameters[2];
if (parameters.length > 3) { chemin = parameters[3]; }
if (parameters.length > 4) { nomfic = parameters[4]; }

Connection connection = null;
IFSTextFileOutputStream target = null;
int textLength = 0;
byte[] data = null;
String wzone = null;
String zone = null;
String javaText = null;
AS400Text textConverter = null;
AS400Text textConvert = null;

try {

if (chemin == null) { chemin = "/home/guebey/transferts"; }
if (nomfic == null) { nomfic = tableName; }
// Definir et ouvrir le fichier en sortie et obtenir la connexion...
String targetName = chemin + "/" + nomfic + ".txt";
AS400 as400 = new AS400(system);
target = new IFSTextFileOutputStream(as400,targetName);

// Charge le driver JDBC du IBM Toolbox for Java.
DriverManager.registerDriver(new com.ibm.as400.access.AS400JDBCDriver());

// Connection a la base de donnee.
connection = DriverManager.getConnection ("jdbc:as400://" + system);
DatabaseMetaData dmd = connection.getMetaData ();

// Query sur le fichier
Statement select = connection.createStatement ();
ResultSet rs = select.executeQuery ("SELECT * FROM "
+ collectionName + dmd.getCatalogSeparator() + tableName);

// Obtenir des informations du "result set". 
// Etablir la largeur de colonne a sa plus grande valeur : data ou label
ResultSetMetaData rsmd = rs.getMetaData ();
int columnCount = rsmd.getColumnCount ();
String[] columnLabels = new String[columnCount];
int[] columnWidths = new int[columnCount];
for (int i = 1; i <= columnCount; ++i) {
columnLabels[i-1] = rsmd.getColumnLabel (i);
columnWidths[i-1] = Math.max (columnLabels[i-1].length(),
rsmd.getColumnDisplaySize (i));
}

// SORTIE DE L ENTETE
for (int i = 1; i <= columnCount; ++i) {
        // 2004-07-21
        zone = rsmd.getColumnLabel(i);
        textLength = zone.length();
        // page de code 850 sinon recupere de l'UNICODE
        textConverter = new AS400Text(textLength,850);
        // 2004-07-21 : plus de "format", trim et remplacer les ";"
        wzone = rsmd.getColumnLabel(i);
        zone = wzone.trim();
        zone = zone.replace(';',',');
        data = textConverter.toBytes(zone);
        target.write(data);
        textConvert = new AS400Text(1,850);
        data = textConvert.toBytes(";");
        target.write(data);
}
data = textConvert.toBytes("\n");
target.write(data);

// Boucle de lecture du fichier
// colonne par colonne
while (rs.next ()) {
        // 2004-05-19 : String ligne : sortie enreg en une fois au lieu de zone par zone
        String ligne = "";
        // 2004-10-25 UTILISATION de StringBuffer
        StringBuffer buf = new StringBuffer();
        for (int i = 1; i <= columnCount; ++i) {
                String value = rs.getString (i);
                if (rs.wasNull ()) value = "<null>";
                // 2004-07-21 : plus de "format", trim et remplacer les ";"
                zone = value.trim();
                zone = zone.replace(';',',');
                buf.append(zone).append(";");
//                ligne = ligne + zone + ";";
                }
        ligne = buf.toString();
        textLength = ligne.length();
        textConverter = new AS400Text(textLength,850);
        data = textConverter.toBytes(ligne);
        target.write(data);
        data = textConvert.toBytes("\n");
        target.write(data);
}

target.close();
}
catch (Exception e) {
// System.out.println ();
// System.out.println ("ERROR: " + e.getMessage());
}
finally {
// Clean up.
try {
if (connection != null)
connection.close ();

}

catch (SQLException e) {
// Ignore.
}
}
System.exit (0);
}

}