|
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))
|
|
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
|
|
call RPLSTR (&CMDD 'BIBLIO' &BIBLIO)
call RPLSTR (&CMDD 'OBJET' &OBJET)
chgvar &TOSTR &TYPE
call RPLSTR (&CMDD '*PGM' &TOSTR)
|
|
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
|
|
chgvar var(&MSGFIN) value('Commande executee sur ' +
*CAT &EXECA *CAT ' objets, non executee +
sur ' *CAT &NBERA)
sndpgmmsg msg(&MSGFIN) msgtype(*COMP)
endpgm
|
|
- 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.
- 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.
- The resulting command is checked using the QCMDCHK API , then run using QCMDEXC.
- 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
|
|
CLG: CHGVAR &LONG (&LONG + 1)
IF (%SST(&STRFRM &LONG 1) *NE ' ') GOTO CLG
CHGVAR &LONG (&LONG - 1)
|
|
SUB: CALL PGM(QCLSCAN) PARM(&TGTSTR &STRLEN &STRPOS +
&STRFRM &LONG &TRANSLATE &TRIM &WILD +
&POSDB)
IF (&POSDB *EQ 0) RETURN |
|
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.
- Compute the lenght of the string to replace, discarding trailing blanks.
- Lookup the next occurence of the replaced string using the QCLSCAN API
- 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 */
|
|
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 */
|
|
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
|
|
- Search the library containing the model file for OBJPF, mandatory parameter for the CRTDUPOBJ command used to create a new object list file.
- 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 */
|
|
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)
|
|
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)
|
|
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
|
|
- If the library parameter value is *SAME, the values recorded in a dtaarea of the QTEMP library are red.
- The RPG program UPDOBJPF is called to add the object to the target file.
- 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 */
|
|
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)
|
|
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
|
|
- 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.
- 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.
|
|
|
© Thierry Seunevel (2004) |
www.seusoft.com |
|
|