Thierry Seunevel Thierry 
Seunevel 
 Tech Corner      
  Home   Missions Tech corner Download Resume Contact
Home > Tech Corner > RunMnyCmd

Running AS/400 commands on many objects (5)

. Example
. List file
. Managing List
. RunMnyCmd
. Tool's Code
The tool source code
This page contains commented sources of the different parts of the tool, except the sources of command wich are trivial, and can be found in the downloadable archive.

The RunMnyCmd is presented first, followed by the programs dealing with the management of the object list file.
Command Type Comment
RUNMNYCMD CLP Running a command on all the object of a list
RPLSTR CLP Achieves substitution of parameter value in the command string.
CRTOBJPF CLP Create a new object list file and/or add all the object of a library.
ADDOBJPF CLP Add a record refering to an object to an object list file.
ADDOBJPC CLP Control program for the ADDOBJPF command.
DLTOBJPF CLP Remove an object record from an object list file.
UPDOBJPF RPG Add or remove records in an object list file.
PRTOBJPF CLP Print the content of an object list file, calling CLP.
PRTOBJPR RPG Print the content of an object list file.
PRTOBJPP DDS Print file for the PRTOBJPR program.

CLP RUNMNYCMD : Running a command on objects of a list
 
/*-------------------------------------------------------------------+
 * 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. Read loop of the records in the object list file.
    If a value has been supplied for the type (and attribute) controls that the object just red matches the parameter value.

  2. Occurences of BIBLIO, OBJET and *PGM in the command string are replaced by the corresponding column values of the input record using the RPLSTR program.

  3. The resulting command is checked using the QCMDCHK API , then run using QCMDEXC.

  4. A completion message displaying the number of object treated and the number of failures is created and sent to the caller.

CLP RPLSTR : Substituting parameter values in the command string
 
/*----------------------------------------------------------------- +
 * 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
The purpose of this program is to replace the string &STRFRM by the content of the &STRTO variable in the &TGTSTR variable.
  1. Compute the lenght of the string to replace, discarding trailing blanks.

  2. Lookup the next occurence of the replaced string using the QCLSCAN API

  3. The new string replaces the searched string, then the program loops to find other occurence of the searched string.

CLP CRTOBJPF : Create an object list file and or add all the object of a library
 
/* 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. Search the library containing the model file for OBJPF, mandatory parameter for the CRTDUPOBJ command used to create a new object list file.

  2. If the source library is not blank a DSPOBJD command with a file as output is used to create the object list, and then a read loop adds a record to the object list file for each object.


CLP ADDOBJPF : Add a record in an object list file.
 
/*------------------------------------------------------------------*/
/* 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. If the library parameter value is *SAME, the values recorded in a dtaarea of the QTEMP library are red.

  2. The RPG program UPDOBJPF is called to add the object to the target file.

  3. The parameters defining the object list file are recorded in a data area in the QTEMP library.


CLP ADDOBJPC : Control program for the ADDOBJPF command
 
 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
This program is associated with the ADDOBJPF command, as its control program.
Its purpose is to control that mandatory parameters are not empty and are valid. If the special value *SAME has been given to the list file library parameter, it controls that the required data area exists in the QTEMP library.

CLP DLTOBJPF : Delete the record corresponding to an object in an object list file.
 
/*------------------------------------------------------------------+
 * 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. If the library containing the list has been specified with the *SAME special value, extracts the values recorded during a preceding use in the QTEMP library.

  2. Call the UPDOBJPF RPG program with a value D (as Delete) for the mode parameter.


RPG UPDOBJPF : Add or Delete the record associated with an object in an object list file.
 
      *-------------------------------------------------------------
      * 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
The same RPG program is used to add or to delete records in the object list file.
The CDACT entry parameter is used to switch to the required action. A A value means Add, D means delete. The same parameter is used to report the execution status. If the action fails, the value 1 is returned to the calling program.

CLP PRTOBJPF : Print the content of an object list file.
 
/*-----------------------------------------------------------------+
 * 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
There is not much to say about the CL program calling the RPG printing program. If the values *LIBL or *CURLIB had been given to the library parameter, the real library is retrieved and the value of the parameter is changed to reflect the actual value.

RPG PRTOBJPR : Printing the list of objects contained in a list.
 
      *----------------------------------------------------------------
      * 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
The RPG printing program defines the object list file as primary and reads its records ordered according to the key values.
It uses an externally described printer file, PRTOBJPP.
If values have been provided for the type (or attribute) parameter, the type (and attribute) of the current record are checked for a match.
The number of selected objects is computed, the subroutine OVRSR is called, and a line is printed for the current record. The OVRSR subroutine prints header lines for the first page and whenever the overflow line has been reached.

DDS PRTOBJPP : Printer file for the PRTOBJPR program.
 
     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*%%***********************************************************************
This printer file has been generated using the RLU program. It can be modified in the same way

The creation parameters are recorded in the source file, and you can change them according to your environment and needs.

    Top  Top  Previous  RunMnyCmd |  


©  Thierry Seunevel (2004) www.seusoft.com