|
|
| 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))
|
 |
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
|
|
- 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.
- Les occurences de BIBLIO, OBJET et *PGM sont remplacées par les valeurs correspondantes de l'objet courant dans la chaine de commande.
- La commande résultante est contrôlée en utilisant l'API QCMDCHK, puis exécutée avec QCMDEXC.
- 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
|
|
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
|
|
Ce programme a pour but de remplacer les occurences de la variable &STRFRM par le contenu de la variable &STRTO dans la variable &TGTSTR.
- Calcul de la longueur de la chaine à remplacer, en éliminant les blancs éventuels.
- On recherche l'occurence suivante de la chaine à remplacer en utilisant QCLSCAN
- 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 */
|
|
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
|
|
- 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.
- 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 */
|
|
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
|
|
- 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.
- Le programme RPG UPDOBJPF est appelé pour ajouter l'objet à la liste.
- 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 */
|
|
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
|
|
- 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.
- 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.
|
|
|
|
| © Thierry Seunevel (2004) |
www.seusoft.com |
|
|
