Thierry Seunevel Thierry 
Seunevel 
 Code en stock       
  Accueil   Réalisations Code en stock Téléchargement Curriculum Contact
Accueil > Code en stock > RunMnyCmd

Exécution d'une commande sur une série d'objets (5)

. Principe
. Fichier liste
. Gérer liste
. RunMnyCmd
. Code de l'outil
Le code source des programmes
Ce chapitre propose une description commentée des différentes sources composant l'outil.
La commande RunMnyCmd est présentée en premier, suivie des différentes commandes de gestion des fichiers listes d'objets.
Compte tenu de leur trivialité, les sources des commandes ne sont pas décrites. Vous les trouverez dans l'archive que vous pouvez télécharger.
Commande Type Commentaire
RUNMNYCMD CLP Execution d'une commande sur les objets d'une liste
RPLSTR CLP Effectue les substitutions de paramètres dans la commande.
CRTOBJPF CLP Crée un fichier liste d'objet et/ou y ajoute objets d'une bibliothèque.
ADDOBJPF CLP Ajoute la définition d'un objet à un fichier liste d'objets.
ADDOBJPC CLP CLP de contrôle de la commande ADDOBJPF.
DLTOBJPF CLP Supprime la description d'un objet d'un fichier liste d'objets.
UPDOBJPF RPG Ajout suppression dans un fichier liste d'objets.
PRTOBJPF CLP Impression liste des objets d'une liste.
PRTOBJPR RPG Impression liste des objets d'une liste.
PRTOBJPP DDS Impression liste des objets d'une liste.

CLP RUNMNYCMD : Exécution commande sur une liste d'objets
 
/*-------------------------------------------------------------------+
 * Execution de la commande &CMD sur chacun des objets de la liste   +
 * d'objets &LIB/&FILE membre &MBR. Si &TYPX et/ou &ATTR precises   +
 * filtrage objets de ce type ou de cet attribut                     +
 * Dans chaque commande substitution BIBLIO, OBJET et *PGM par       +
 * bibliotheque, nom et type de l'objet courant                      +
 *-------------------------------------------------------------------*/
             pgm        PARM(&CMD &FILE &LIB &MBR &TYPX &ATTR)

             dclf       FILE(*LIBL/OBJPF)
             dcl        &CMD *CHAR 500   /* commande a executer */
             dcl        &FILE *CHAR 10   /* fichier liste d'objets */
             dcl        &LIB  *CHAR 10   /* biblio de la liste     */
             dcl        &MBR  *CHAR 10   /* membre a traiter       */
             dcl        &TYPX *CHAR 8    /* type a traiter         */
             dcl        &ATTR *CHAR 10  /* attribut a traiter     */
             dcl        &CMDD *CHAR 550
             dcl        &TOSTR *CHAR 10
             dcl        &MSGID *CHAR 7
             dcl        &MSGF   *CHAR 10
             dcl        &MSGDTA *CHAR 100
             dcl        &NBER   *DEC 3 0
             dcl        &EXEC   *DEC 4 0
             dcl        &NBERA  *CHAR 3
             dcl        &EXECA  *CHAR 4
             dcl        &MSGFIN *CHAR 
				 
             if         (&FILE *NE ' ' *AND &LIB *EQ ' ')       +
                         then(chgvar &LIB '*LIBL')
             if         (&MBR *EQ ' ')                          +
                         then(chgvar &MBR '*first')
             if         (&FILE *NE ' ')                         +
                         then(ovrdbf file(OBJPF)                +
                          tofile(&LIB/&FILE) mbr(&MBR))
1
BCLE:        rcvf
             monmsg     MSGID(CPF0864) exec(goto cmdlbl(END))
             if        (&TYPX *ne ' ' *and &TYPX *ne &TYPE) goto BCLE
             if        (&ATTR *ne ' ' *and &ATTR *ne &ATTRB) +
                        goto BCLE

             chgvar     &CMDD &CMD
2
				 
             call       RPLSTR (&CMDD 'BIBLIO' &BIBLIO)
             call       RPLSTR (&CMDD 'OBJET' &OBJET)
             chgvar     &TOSTR &TYPE
             call       RPLSTR (&CMDD '*PGM' &TOSTR)
3
             call       QCMDCHK (&CMDD 550)
             monmsg     CPF0006 exec(goto ERREUR)

             call       QCMDEXC (&CMDD 550)
             monmsg     CPF9999 exec(goto ERREUR1)

             chgvar     &EXEC (&EXEC + 1)
             goto       BCLE

ERREUR:      sndpgmmsg  msgid(CPF9898) msgf(QCPFMSG) msgdta(&CMDD) +
                          topgmq(*EXT)
             chgvar     &NBER (&NBER + 1)
             goto       BCLE

ERREUR1:     chgvar     &NBER (&NBER + 1)
             goto       BCLE

END:         chgvar     &EXECA &EXEC
             chgvar     &NBERA &NBER
4
				 
             chgvar     var(&MSGFIN) value('Commande executee sur ' +
                          *CAT &EXECA *CAT ' objets, non executee +
                          sur ' *CAT &NBERA)
             sndpgmmsg  msg(&MSGFIN) msgtype(*COMP)
             endpgm
  1. Boucle de lecture des enregistrements du fichier liste d'objets.
    Si le type (et l'attribut) ont été spécifiés en paramètres, on contrôle que l'objet courant correspond à la sélection, sinon on lit l'enregistrement suivant.

  2. Les occurences de BIBLIO, OBJET et *PGM sont remplacées par les valeurs correspondantes de l'objet courant dans la chaine de commande.

  3. La commande résultante est contrôlée en utilisant l'API QCMDCHK, puis exécutée avec QCMDEXC.

  4. Un message d'achèvement, indiquant le nombre d'objets traités et le nombre d'echecs est affiché.

CLP RPLSTR : Substitution des paramètres dans la commande
 
/*----------------------------------------------------------------- +
 * Substitution chaine &STRFRM par chaine &STRTO dans &TGTSTR       +
 *------------------------------------------------------------------*/
             PGM        PARM(&TGTSTR &STRFRM &STRTO)

             DCL        &TGTSTR *CHAR 550
             DCL        &STRFRM *CHAR 10
             DCL        &STRTO  *CHAR 10
             DCL        &POSDB  *DEC  3
             DCL        &POSFN  *DEC  3
             DCL        &LGFIN  *DEC  3
             DCL        &LONG   *DEC  2
             DCL        &TRIM *CHAR 1 '1'
             DCL        &WILD *CHAR 1 ' '
             DCL        &TRANSLATE *CHAR 1 '1'
             DCL        &STRLEN    *DEC 3  550
             DCL        VAR(&STRPOS) TYPE(*DEC) LEN(3 0) VALUE(1)

             IF        (&STRFRM *EQ &STRTO) RETURN
				 
1
CLG:         CHGVAR &LONG (&LONG + 1)
             IF        (%SST(&STRFRM &LONG 1) *NE ' ') GOTO CLG
             CHGVAR &LONG (&LONG - 1)
2
SUB:         CALL       PGM(QCLSCAN) PARM(&TGTSTR &STRLEN &STRPOS +
                          &STRFRM &LONG &TRANSLATE &TRIM &WILD +
                          &POSDB)

             IF        (&POSDB *EQ 0) RETURN
3
             CHGVAR     &POSDB (&POSDB - 1)
             CHGVAR     &POSFN (&POSDB + &LONG)
             CHGVAR     &LGFIN (&STRLEN - &POSFN)
             CHGVAR     &POSFN (&POSFN + 1)
             CHGVAR     &TGTSTR  +
                             (%SST(&TGTSTR 1 &POSDB) +
                        *CAT &STRTO             +
                        *TCAT %SST(&TGTSTR &POSFN &LGFIN))
             CHGVAR     &STRPOS (&POSDB + 10)
             GOTO       SUB

             ENDPGM
Ce programme a pour but de remplacer les occurences de la variable &STRFRM par le contenu de la variable &STRTO dans la variable &TGTSTR.
  1. Calcul de la longueur de la chaine à remplacer, en éliminant les blancs éventuels.

  2. On recherche l'occurence suivante de la chaine à remplacer en utilisant QCLSCAN

  3. On remplace la valeur à substituer par la valeur de substitution, puis on boucle pour traiter les occurences suivantes éventuelles.

CLP CRTOBJPF : Crée fichier liste d'objets et/ou y ajoute objets d'une bibliothèque
 
/* Cree fichier d'objets indique ou y ajoute un nouveau membre      */
/* puis y ajoute tous les objets de la bibliotheque source fournie  */
/*----------------------------------------------------------------- */
/*   Parms : Nom du fichier liste d'objets                          */
/*           Bibliotheque du fichier                                */
/*           Nom du membre a creer ou a ajouter                     */
/*           Nom bibliotheque source (peut etre a blanc)            */
/*----------------------------------------------------------------- */
             pgm        parm(&OBJPF &LIB &MBR &LIBS)
             dclf       file(QADSPOBJ)
             dcl    &OBJPF   *CHAR 10 /* NOM FICH OBJETS */
             dcl    &LIB     *CHAR 10 /* BIBLIO DU FICHIER  */
             dcl    &MBR     *CHAR 10 /* MEMBRE A CREER     */
             dcl    &LIBS    *CHAR 10 /* BIBLIO SOURCE POUR AJOUT */
             dcl    &LIBO    *CHAR 10 /* BIBLIO CONTENANT APPLI   */
             dcl    &CRET    *CHAR 1
             dcl    &NBOB    *DEC  5  /* NBRE OBJETS COPIES DS LST */
             dcl    &NBOBA   *CHAR 5

             if (&MBR *EQ ' ') chgvar &MBR &OBJPF
				 
/* Recherche bibliotheque contenant modele OBJPF pour CRTDUPOBJ  */
1
             rtvobjd    obj(OBJPF) objtype(*FILE) rtnlib(&LIBO)

/* controle existence bibliotheque cible                         */

             chkobj     obj(QSYS/&LIB) objtype(*LIB)
             monmsg     msgid(CPF9800) exec(do)
                sndpgmmsg  msg('Bibliotheque' *BCAT &LIB *BCAT    +
                  ' non trouvee') msgtype(*DIAG)
                return
                enddo

/* si fichier liste absent le creer par copie fichier modele */

             chkobj     obj(&LIB/&OBJPF) objtype(*FILE)
             monmsg     msgid(CPF9800) exec(do)
                crtdupobj  obj(OBJPF) fromlib(&LIBO) objtype(*FILE) +
                          tolib(&LIB) newobj(&OBJPF)
                enddo

 /* si besoine ajouter le membre demande au fichier liste    */

             chkobj     obj(&LIB/&OBJPF) objtype(*FILE) mbr(&MBR)
             monmsg     msgid(CPF9800) exec(addpfm +
                        file(&LIB/&OBJPF) mbr(&MBR))

             if (&LIBS *EQ ' ') return

 /* si biblio sourcee ajouter les objets de cette biblio a la liste */
2
             dspobjd    obj(&LIBS/*ALL) objtype(*ALL) +
                          detail(*SERVICE) output(*OUTFILE) +
                          outfile(QTEMP/QADSPOBJ)

             ovrdbf     file(QADSPOBJ) tofile(QTEMP/QADSPOBJ)
             ovrdbf     file(OBJPF) tofile(&LIB/&OBJPF) mbr(&MBR) +
                          seqonly(*NO)

READ:        rcvf
             monmsg     msgid(CPF0864) exec(goto cmdlbl(SUIT))
             if (&ODOBTP *EQ '*LIB') goto read
             chgvar     &CRET 'A'
             call       pgm(UPDOBJPF) parm(&ODLBNM  +
                                           &ODOBNM  +
                                           &ODOBTP  +
                                           &ODOBTX  +
                                           &CRET    +
                                           &ODOBAT  +
                                           &LIBS)
             if (&CRET *NE '1') chgvar &NBOB (&NBOB+1)
             goto READ

SUIT:        chgvar &nboba &nbob
             sndpgmmsg  msg(&NBOBA *BCAT 'objets ajoutes a la liste +
                          indiquee') msgtype(*COMP)
             endpgm
  1. On recherche la bibliothèque hébergeant le fichier modèle OBJPF, paramètre obligatoire pour exécuter CRTDUPOBJ et créer un nouveau fichier liste d'objets.

  2. Si une bibliothèque source a été spécifiée, on utilise la commande DSPOBJD avec une sortie fichier pour obtenir la liste des objets, puis on boucle sur cette liste pour ajouter la description de chaque objet au fichier.


CLP ADDOBJPF : Ajoute description d'un objet à un fichier liste d'objets
 
/*------------------------------------------------------------------*/
/* Ce programme ajoute un enregistrement au fichier liste d'objets  */
/* specifie.                                                        */
/* Parametres : bibliotheque, nom, type, description objet          */
/*              plus attributs et biblio srce                       */
/*              nom, bibliotheque et membre fichier d'objets        */
/*              si nom biblio de la liste=*SAME, utiliser valeurs   */
/*              trouvees dans DTAARA nommee ADDOBJPF de QTEMP       */
/*------------------------------------------------------------------*/
             pgm        parm(&BIBLIO +
                             &OBJET  +
                             &TYPE   +
                             &DESC   +
                             &LIBPF +
                             &OBJPF  +
                             &MBRPF  +
                             &ATTRB  +
                             &FRMLIB)

             dcl        &BIBLIO  *CHAR 10   /* biblio de l'objet */
             dcl        &OBJET   *CHAR 10   /* nom objet         */
             dcl        &TYPE    *CHAR 8    /* type objet        */
             dcl        &ATTRB   *CHAR 10   /* attributs objet   */
             dcl        &DESC    *CHAR 50   /* description objet  */
             dcl        &LIBPF  *CHAR 10   /* biblio liste       */
             dcl        &OBJPF   *CHAR 10
             dcl        &MBRPF   *CHAR 10   /* membre de la liste */
             dcl        &FRMLIB  *CHAR 10   /* biblio source     */

             dcl        &ANLIB   *CHAR 10
             dcl        &CRET    *CHAR 1 VALUE('A')

/* si LIBPF = *SAME, recherche DTAARA QTEMP/ADDOBJPF               */
1
             if (&LIBPF *EQ '*SAME')  do
               rtvdtaara  dtaara(QTEMP/ADDOBJPF (1 10)) rtnvar(&LIBPF)
               monmsg     msgid(CPF1015) exec(do)
                 chgvar     &LIBPF ' '
                 chgvar     &OBJPF  ' '
               enddo
               rtvdtaara  dtaara(QTEMP/ADDOBJPF (11 10)) rtnvar(&OBJPF)
               monmsg     msgid(CPF1015)
               rtvdtaara  dtaara(QTEMP/ADDOBJPF (21 10)) rtnvar(&MBRPF)
               monmsg     MSGID(CPF1015)
               enddo

 /* controle existence liste d'objets … alimenter              */

             chkobj     obj(&LIBPF/&OBJPF) objtype(*FILE) mbr(&MBRPF)
             monmsg     msgid(CPF9800) exec(do)
                sndpgmmsg msg('Fichier ou mbre ' *CAT &OBJPF *TCAT   +
                ' non trouve dans biblio ' *CAT &LIBPF) +
                msgtype(*COMP)
                return
                enddo
             ovrdbf     file(OBJPF) tofile(&LIBPF/&OBJPF) mbr(&MBRPF)
2
				 
             call       pgm(UPDOBJPF) parm(&BIBLIO   +
                                            &OBJET   +
                                            &TYPE    +
                                            &DESC    +
                                            &CRET    +
                                            &ATTRB   +
                                            &FRMLIB)
             dltovr     file(OBJPF)

 /* si execution reussie, stocker parametres dans DTAARA de QTEMP    */

             if         (&CRET *NE '1') do
                sndpgmmsg msg('Objet ajoute … '         +
                     *CAT &LIBPF *TCAT '/' *CAT &OBJPF *TCAT +
                    ' membre ' *CAT &MBRPF) msgtype(*COMP)
3
                chgdtaara  dtaara(QTEMP/ADDOBJPF) value(&LIBPF *CAT +
                    &OBJPF *CAT &MBRPF)
                monmsg     MSGID(CPF1015) exec(crtdtaara +
                          dtaara(QTEMP/ADDOBJPF) type(*CHAR) +
                          LEN(30) value(&LIBPF *CAT &OBJPF *CAT +
                          &MBRPF))
                enddo

             else       sndpgmmsg msg('Objet deja present dans +
                          membre ' *CAT &MBRPF *TCAT ' de ' *CAT +
                          &LIBPF *TCAT '/' *CAT &OBJPF) +
                          msgtype(*COMP)
             endpgm
  1. Si la valeur *SAME a été utilisée pour spécifier la bibliothèque du fichier liste, on extrait les valeurs mémorisées à l'exécution précédente dans une zone de données de QTEMP.

  2. Le programme RPG UPDOBJPF est appelé pour ajouter l'objet à la liste.

  3. Les paramètres définissant le fichier liste sont mémorisés dans la zone de données de QTEMP pour utilisation éventuelle lors d'une commande future.


CLP ADDOBJPC : Programme de contrôle des paramètres de ADDOBJPF
 
 PGM        PARM(&BIBLIO &OBJET &TYPE &DESC &LIBPTF +
                          &OBJPF &MBRPF &ATTRB &FRMLIB)
             DCL        &BIBLIO  *CHAR 10
             DCL        &OBJET   *CHAR 10
             DCL        &TYPE    *CHAR 8
             DCL        &DESC    *CHAR 50
             DCL        &LIBPTF  *CHAR 10
             DCL        &OBJPF   *CHAR 10
             DCL        &MBRPF   *CHAR 10
             DCL        &ATTRB   *CHAR 10
             DCL        &FRMLIB  *CHAR 10
             IF        (&LIBPTF *NE ' ' *AND &LIBPTF *NE '*SAME') DO
               IF         COND(&OBJPF *EQ ' ') THEN(DO)
                 SNDPGMMSG  MSGID(CPD0006) MSGF(QCPFMSG) +
                 MSGDTA('0000 +
                 Nom de fichier obligatoire si nom biblio +
                 indique.') MSGTYPE(*DIAG)
                 GOTO ERR
               ENDDO
             CHKOBJ     OBJ(&LIBPTF/&OBJPF) OBJTYPE(*FILE) MBR(&MBRPF)
               MONMSG     MSGID(CPF9800) EXEC(DO)
                 SNDPGMMSG  MSGID(CPD0006) MSGF(QCPFMSG) +
                 MSGDTA('0000 Fichier indique inconnu dans la +
                 bibliotheque specifiee.') +
                 MSGTYPE(*DIAG)
               GOTO ERR
               ENDDO
               RETURN
             ENDDO
             IF (&LIBPTF *EQ '*SAME') DO
                CHKOBJ     OBJ(QTEMP/ADDOBJPF) OBJTYPE(*DTAARA)
                MONMSG     MSGID(CPF9800) EXEC(DO)
                 SNDPGMMSG  MSGID(CPD0006) MSGF(QCPFMSG) +
                 MSGDTA('0000 *SAME ne peut etre indique lors +
                 du premier appel.') +
                 MSGTYPE(*DIAG)
                  GOTO ERR
                  ENDDO
             RETURN
             ENDDO
             IF (&LIBPTF *eq ' ') DO
                 SNDPGMMSG  MSGID(CPD0006) MSGF(QCPFMSG) +
                 MSGDTA('0000 Nom de bibliotheque obligatoire.') +
                 MSGTYPE(*DIAG)
             goto ERR
             ENddo
             RETURN
ERR:         SNDPGMMSG MSGID(CPF0002) MSGF(QCPFMSG) MSGTYPE(*ESCAPE)
             endpgm
Ce programme est associé à la commande ADDOBJPF comme programme de contrôle.
Il s'assure de la présence et de la validité des paramètres passés à la commande, et, si la valeur *SAME a été indiquée pour le nom de bibliothéque de la liste, il contrôle que la zone de donnée de QTEMP existe, ce qui n'est pas la cas à la première utilisation pour la session de travail en cours.

CLP DLTOBJPF : Supprime description d'un objet d'un fichier liste d'objets.
 
/*------------------------------------------------------------------+
 * Suppression d'un objet dans une liste d'objets                   +
 *  seul l'enregistrement correspondant a l'objet est supprime      +
 *  l'objet lui-meme n'est pas concerne.                            +
 *------------------------------------------------------------------*/
             pgm        parm(&LIBPF &OBJPF &MBRPF &LIBOB &OBJET &TYPE)

             dcl        &LIBPF   *CHAR 10  /* biblio de la liste  */
             dcl        &OBJPF   *CHAR 10  /* liste d'objets      */
             dcl        &MBRPF   *CHAR 10  /* membre de la liste  */
             dcl        &LIBOB   *CHAR 10  /* biblio de l'objet   */
             dcl        &OBJET   *CHAR 10  /* nom objet           */
             dcl        &TYPE    *CHAR 8   /* type objet          */
             dcl        var(&CDRET) type(*CHAR) len(1) value('D')
             dcl        &DESC    *CHAR 50  /* texte non utilise   */
             dcl        &ATTRB   *CHAR 10  /* attribut, non util  */
             dcl        &FRMLIB  *CHAR 10  /* biblio srce, non u  */


/* si LIBPF = *SAME, recherche DTAARA QTEMP/ADDOBJPF               */
1
             if (&LIBPF *EQ '*SAME')  do
               rtvdtaara  dtaara(QTEMP/ADDOBJPF (1 10)) rtnvar(&LIBPF)
               monmsg     msgid(CPF1015) exec(do)
                 chgvar     &LIBPF  ' '
                 chgvar     &OBJPF  ' '
               enddo
               rtvdtaara  dtaara(QTEMP/ADDOBJPF (11 10)) rtnvar(&OBJPF)
               monmsg     msgid(CPF1015)
               rtvdtaara dtaara(QTEMP/ADDOBJPF (21 10)) rtnvar(&MBRPF)
               monmsg     MSGID(CPF1015)
               enddo

             ovrdbf     file(OBJPF) tofile(&LIBPF/&OBJPF) mbr(&MBRPF)
2
             call       pgm(UPDOBJPF) parm(&LIBOB    +
                                            &OBJET   +
                                            &TYPE    +
                                            &DESC    +
                                            &CDRET   +
                                            &ATTRB   +
                                            &FRMLIB)

             if        (&CDRET *EQ '1') do
                sndpgmmsg  msgid(CPF9898) msgf(QCPFMSG) msgdta('Objet +
                  ou liste non trouve') msgtype(*COMP)
                return
                enddo

             sndpgmmsg  msgid(CPF9898) msgf(QCPFMSG) msgdta('Objet +
                  supprime de la liste') msgtype(*COMP)
             endpgm
  1. Si la bibliothèque de la liste a été indiquée par la valeur *SAME, recherche les noms de bibliothèque, fichier et membre dans la zone de données ADDOBJPF de QTEMP.

  2. Appelle le programme RPG UPDOBJPF en mode D (paramètre &CDRET) pour supprimer l'enregistrement correspondant à l'objet visé.


RPG UPDOBJPF : Ajoute/supprime description d'un objet dans un fichier liste d'objets.
 
      *-------------------------------------------------------------
      * PROGRAMME RPGIII POUR CREER/SUPPRIMER UN OBJET DANS UNE
      * LISTE D'OBJETS
      * PARAMETRES :
      * I BIBLIO (10) NOM BIBLIOTHEQUE DE L'OBJET
      * I OBJET  (10) NOM DE L'OBJET
      * I TYPE   (8)  TYPE DE L'OBJET
      * I DESC   (50) DESCRIPTION OBJET (TEXT)
      * U CDACT  (1)  ACTION DEMANDEE/CODE RETOUR
      *               ACTION = A POUR AJOUT, D POUR SUPPRESSION
      *               CODE RETOUR 1 = ERREUR, BLANC = OK
      * I ATTRB  (10) ATTRIBUT OBJET
      * I FRMBIB (10) BIBLIOTHEQUE ORIGINE
      *-------------------------------------------------------------
     FOBJPF   UF  E           K        DISK                      A
     F            OBJPF                             KRENAMEROBJPF
      *
     C           KOBJPF    KLIST
     C                     KFLD           BIBLIO
     C                     KFLD           OBJET
     C                     KFLD           TYPE
     C*
     C           *ENTRY    PLIST
     C                     PARM           BIBLIO
     C                     PARM           OBJET
     C                     PARM           TYPE
     C                     PARM           DESC
     C                     PARM           CDACT   1        CODE ACTION ERR
     C                     PARM           ATTRB
     C                     PARM           FRMBIB
     C*
     C                     SELEC
     C           CDACT     WHEQ 'A'
     C                     WRITEROBJPF                 99
     C*
     C           CDACT     WHEQ 'D'
     C           KOBJPF    DELETROBJPF                 99
     C*
     C                     OTHER
     C                     MOVE *ON       *IN99
     C                     ENDSL
     C*
     C           *IN99     IFEQ *OFF
     C                     MOVE *BLANK    CDACT
     C                     ELSE
     C                     MOVE '1'       CDACT
     C                     ENDIF
     C*
     C                     MOVE '1'       *INLR
Un même programme RPG est utilisé pour ajouter des définitions d'objets à une liste, et pour les supprimer.
Le paramètre CDACT sert en entrée à spécifier l'action à exécuter (A=Ajout, D=Delet) et en sortie à refléter le résultat de la transaction. Il est retourné avec la valeur = 1 si l'opération demandée a échoué.

CLP PRTOBJPF : Impression contenu d'une liste d'objets.
 
/*-----------------------------------------------------------------+
 * Impression de la liste des objets du fichier &LIB/&FILE         +
 *   membre = &MBR. La liste peut être limitée aux objets de       +
 *   type = &TYPE, et attribut = &ATTRB                            +
 *   3 lignes de commentaires peuvent être imprimés &COM1 à &COM3  +
 *----------------------------------------------------------------/*

             pgm        parm(&LIB &FILE &MBR &TYPE &ATTRB &COM1 +
                          &COM2 &COM3)

             dcl        &LIB    *CHAR 10
             dcl        &FILE   *CHAR 10
             dcl        &MBR    *CHAR 10
             dcl        &TYPE   *CHAR 8
             dcl        &ATTRB  *CHAR 10
             dcl        &COM1   *CHAR 50
             dcl        &COM2   *CHAR 50
             dcl        &COM3   *CHAR 50

/* si biblio liste *XXX, recherche biblio reelle pour impression */

             if        (%sst(&LIB 1 1) *eq '*')
                rtvobjd  obj(&LIB/&FILE) objtype(*FILE) rtnlib(&LIB)

             ovrdbf     file(OBJPF) tofile(&LIB/&FILE) mbr(&MBR)
             call       pgm(PRTOBJPR) parm(&LIB &FILE &MBR &TYPE +
                          &ATTRB &COM1 &COM2 &COM3)

             endpgm
Le CL d'appel du programme d'impression d'une liste d'objets ne présente aucune caractéristique particulière. Si la bibliothèque contenant la liste a été indiquée par *LIBL ou *CURLIB, on recherche la bibliothèque réelle dont le nom est imprimé en haut de page dans la liste.

RPG PRTOBJPR : Impression contenu d'une liste d'objets.
 
      *----------------------------------------------------------------
      * Impression liste d'objets. Selection possible suivant type
      * et attributs
      * Parametres :
      *    BIBLIO contenant la liste
      *    FICHIER liste
      *    MEMBRE
      *    TYPE objets a selectionner
      *    ATTRIBUT a selectionner
      *    Commentaire : 3 lignes de 50 caracteres
      *---------------------------------------------------------------
     FOBJPF   IP  E           K        DISK
     F            OBJPF                             KRENAMEROBJPF
     FPRTOBJPPO   E                    PRINTER
     C           *ENTRY    PLIST
     C                     PARM           BIBLIP
     C                     PARM           OBJETP
     C                     PARM           MBREP  10
     C                     PARM           TYPEP
     C                     PARM           ATTRBP
     C                     PARM           COM1   50
     C                     PARM           COM2   50
     C                     PARM           COM3   50
     C*
     C           *LIKE     DEFN BIBLIO    BIBLIP
     C           *LIKE     DEFN OBJET     OBJETP
     C*
     C           TYPEP     IFEQ *BLANKS                    TOUS TYPES
     C           TYPEP     OREQ TYPE
     C*
     C           ATTRBP    IFEQ *BLANKS
     C           ATTRBP    OREQ ATTRB
     C*
     C                     ADD  1         NBOBJ   50
     C                     EXSR OVRSR
     C                     WRITEDETAIL                 98
     C                     ENDIF                           ATTRB
     C                     ENDIF                           TYPEP
     CLR         NBOBJ     IFGT *ZERO
     CLR                   WRITETOTAL                  98
     CLR                   ENDIF
     C*----------------------------------------------------		 
     C           OVRSR     BEGSR
     C           *IN98     IFEQ *ON
     C                     WRITEHEADER
     C                     MOVE *OFF      *IN98
     C                     ENDIF
     C                     ENDSR
     C*----------------------------------------------------
     C           *INZSR    BEGSR
     C                     MOVELBIBLIP    NMQUAL 32
     C                     CAT  '/':0     NMQUAL
     C                     CAT  OBJETP:0  NMQUAL
     C                     CAT  ' (':0    NMQUAL
     C                     CAT  MBREP:0   NMQUAL
     C                     CAT  ')':0     NMQUAL
     C*
     C           ATTRBP    COMP *BLANKS              1111
     C           COM2      COMP *BLANKS              1212
     C           COM3      COMP *BLANKS              1313
     C                     MOVE *ON       *IN98
     C                     ENDSR
Le programme RPG d'impression d'une liste d'objets lit le fichier liste en lecture primaire, dans l'ordre des clés.
Il utilise un fichier d'impression décrit en externe, PRTOBJPP.
Si le type (et l'attribut) sont précisés en paramètres, on teste si l'objet courant satisfait les valeurs requises.
On calcule le nombre d'objets sélectionnés, et on imprime la ligne détail aprés avoir fait appel au sous-programme OVRSR chargé de l'impression du haut de page au début de l'impression, et quand on atteint la ligne de dépassement de capacité de la page.

DDS PRTOBJPP : Liste des objets d'une liste.
 
     A*%%***********************************************************************
     A*%%TS  RD  20031007  174331  SEUSOFT     REL-V4R4M0  5769-PW1
     A*%%FI+10660100000000000000000000000000000000000000000000000000
     A*%%FI       0000000000000000000000000000000000000000000000000
     A*%%***********************************************************************
     A                                      REF(OBJPF)
     A          R HEADER
     A*%%***********************************************************************
     A*%%RI 00000
     A*%%FS 001
     A*%%***********************************************************************
     A                                      SKIPB(002)
     A                                     1
     A                                      'PRTOBJPF'
     A                                    20
     A                                      'Liste des objets de'
     A            NMQUAL        32        +2
     A                                    +5
     A                                      DATE
     A                                      EDTCDE(Y)
     A                                    +4
     A                                      TIME
     A                                      EDTWRD('  :  :  ')
     A                                    +4
     A                                      'Page'
     A                                    +1
     A                                      PAGNBR
     A                                      SPACEA(002)
     A            COM1          50        46
     A  11                                 1
     A                                      'Type '
     A  11        TYPEP          8        +1
     A  11                                +2
     A                                      'Attribut '
     A  11        ATTRBP        10        +1
     A  12        COM2          50        46
     A                                      SPACEB(001)
     A  13        COM3          50        46
     A                                      SPACEB(001)
     A                                     1
     A                                      'Biblio    '
     A                                      SPACEB(002)
     A                                    +2
     A                                      'Nom objet '
     A                                    +2
     A                                      'Type    '
     A                                    +2
     A                                      'Attribut  '
     A                                    +1
     A                                      'Description'
     A                                     1
     A                                      '----------'
     A                                      SPACEB(001)
     A                                    +2
     A                                      '----------'
     A                                    +2
     A                                      '--------'
     A                                    +2
     A                                      '----------'
     A                                    +1
     A                                      '----------------------------------'
     A                                      SPACEA(001)
     A*%%***********************************************************************
     A*%%SS
     A*%%CL 002
     A*%%CL 001
     A*%%CL 001
     A*%%CL 002
     A*%%CL 001
     A*%%CL 001
     A*%%***********************************************************************
     A          R DETAIL
     A*%%***********************************************************************
     A*%%RI 00000
     A*%%***********************************************************************
     A                                      SPACEB(001)
     A            BIBLIO    R              1
     A            OBJET     R             +2
     A            TYPE      R             +2
     A            ATTRB     R             +2
     A            DESC      R             +1
     A            FRMBIB    R             +1
     A*%%***********************************************************************
     A*%%SS
     A*%%***********************************************************************
     A          R TOTAL
     A*%%***********************************************************************
     A*%%RI 00000
     A*%%FS 001
     A*%%***********************************************************************
     A                                      SPACEB(002)
     A                                     1
     A                                      'Nombre d''objets '
     A            NBOBJ          5  0     +2
     A                                      EDTCDE(Z)
     A*%%***********************************************************************
     A*%%SS
     A*%%CP+999CRTPRTF
     A*%%CP+    FILE(TSTOOLS/PRTOBJPP)
     A*%%CP+    DEVTYPE(*SCS)
     A*%%CP+    PAGESIZE(*N 110)
     A*%%CP     HOLD(*YES)
     A*%%***********************************************************************
Le fichier d'impression de la liste d'objets a été généré en utilisant RLU. Il peut être modifié de la même façon.

Les paramètres de création du fichier sont mémorisés dans la source, et vous devez leur attribuer des valeurs conformes à votre environnement.

    Haut de page  Haut de page  Précédent  RunMnyCmd |  


©  Thierry Seunevel (2004) www.seusoft.com