| 
Exemple d'utilisation d'un user space. 1/ Appel d'un pgm CL "EXEMP01" + création *USRSPC "EXEMP" dans QTEMP. + remplissage par API QUSMBRL (liste des membres) 2/ Appel d'un pgm RPG "EXEMP02" + lecture du user space et traitement /* PGM CL "EXEMPL01" */ PGM PARM(&FIC &LIB) DCL &FIC *CHAR 10 DCL &LIB *CHAR 10 DCL &FICLIB *CHAR 20 /* */ /* Ce pgm reçoit en paramètre */ /* 1/ un nom de fichier */ /* 2/ un nom de bibli (ou *LIBL) */ /* */ |
|
/* Il va remplir un user space dans qtemp */
/* avec la liste des membres de ce */
/* fichier puis appeler un pgm RPG */
/* */
/* SI LE *USRSPC N'EXISTE PAS ==> CREATION */
/* */
CHKOBJ OBJ(QTEMP/EXEMP) OBJTYPE(*USRSPC)
MONMSG CPF9801 EXEC(DO)
CALL QUSCRTUS PARM('EXEMP QTEMP ' +
/* Attribut */ 'MBRLIST ' +
/* Taille initiale */ X'00000FFF' +
/* caractere initial */ ' ' +
/* Autorisations */ '*CHANGE ' +
/* Texte */ 'USER SPACE POUR LISTE DES MEMBRES')
ENDDO
|
|
/* STOCKAGE TEXTE DE LA BIBLI DANS 64 OCTETS LIBRES */
IF (&LIB = '*LIBL') CHGVAR &TXTL 'Liste de bibliothèque'
ELSE RTVOBJD OBJ(&LIB) OBJTYPE(*LIB) TEXT(&TXTL)
CALL QUSCHGUS PARM('EXEMP QTEMP ' +
/* Position de début */ X'00000001' +
/* Lg des données=50 */ X'00000032' +
/* Données (=TXTL) */ &TXTL +
/* FEOD (0=no) */ '0' )
/* REMPLISSAGE AVEC LISTE DES MEMBRES */
CHGVAR &FICLIB (&FIC *CAT &LIB)
CALL QUSLMBR PARM('EXEMP QTEMP ' +
/* Format API */ 'MBRL0200' +
/* Fichier-bibli */ &FICLIB +
/* Membre */ '*ALL ' +
/* Tenir compte des OVRDBF */ '0' )
CALL EXEMP02 /* Appel du pgm rpg */
|
|
----------------------------------------------------------------------- * * Pgm EXEMP02 (GAP III) va lire le contenu du user space * * Data structures RTVINF ==> Extraction d'infos dans l'entete * BINDS ==> Déclaration de données binaires * QUALDS ==> User space + bibliothèque * IRTVINF DS I B 1 40FIN I B 5 80TAILLE I 1 8 RTVH I B 9 120NBPOST I B 13 160LGPOST IBINDS DS I B 1 40DEBUT I B 5 80LG I B 9 120LGDS IQUALDS DS I 1 10 SPCNAM I 11 20 SPCLIB I 1 20 USRSPC |
|
* * Data structures HEADER ==> Entete générée par l'API * LIST ==> Découpage d'un poste de la liste IHEADER DS I 1 10 FICNAM I 11 20 FICLIB I 21 30 FILATR I 31 80 FICTXT I B 81 840MBRNAH I 85 85 SRCF ILIST DS I 1 10 MBRNAM I 11 20 TYPE I 21 33 CRTDAT I 34 46 LSTCHG I 47 96 MBRTXT * * Initialisation des variables (user space et bibliothèque) * C MOVEL'EXEMP ' SPCNAM C MOVEL'QTEMP' SPCLIB * |
|
* * Extraction texte de la bibliothèque, placé par le pgm CL. * (rappel de la DS utilisée) *BINDS DS * B 1 40DEBUT * B 5 80LG C Z-ADD1 DEBUT C Z-ADD50 LG C CALL 'QUSRTVUS' C PARM USRSPC C PARM DEBUT C PARM LG C PARM TXTLIB |
|
* * Extraction position de l'entète (renvoyée dans FIN) ---- * ! *RTVINF DS ! * B 1 40FIN <----! * B 5 80TAILLE * 1 8 RTVH C Z-ADD117 DEBUT C Z-ADD8 LG C CALL 'QUSRTVUS' C PARM USRSPC C PARM DEBUT C PARM LG C PARM RTVH C FIN ADD 1 DEBUT C Z-ADDTAILLE LG |
|
* * Extraction des infos d'entète (Retrouve nom du fichier) --- * ! *HEADER DS ! * 1 10 FICNAM <------! * 11 20 FICLIB * 21 30 FILATR * 31 80 FICTXT * B 81 840MBRNAH * 85 85 SRCF C CALL 'QUSRTVUS' C PARM USRSPC C PARM DEBUT C PARM LG C PARM HEADER |
|
* * Extraction des infos sur la liste * (POSITION DE DEBUT NOMBRE DE POSTES LG D'UN POSTE) * ! ! ! *RTVINF DS ! ! ! * !------------!->B 1 40FIN ! * ! B 5 80TAILLE ! * !->B 9 120NBPOST ! * B 13 160LGPOST <---! C Z-ADD125 DEBUT C Z-ADD16 LG C CALL 'QUSRTVUS' C PARM USRSPC C PARM DEBUT C PARM LG C PARM RTVINF C Z-ADDLGPOST LG C FIN ADD 1 DEBUT 1ER POSITION |
|
* * * Boucle sur nombre de postes extraits * C DO NBPOST * * Extraction d'un poste par API QUSRTVUS * *LIST DS * 1 10 MBRNAM * 11 20 TYPE * 21 33 CRTDAT * 34 46 LSTCHG * 47 96 MBRTXT C CALL 'QUSRTVUS' C PARM USRSPC C PARM DEBUT C PARM 96 LGDS (lg de LIST) C PARM LIST * C* traitement du poste lu C* (par exemple ecriture dans sous-fichier) |
|
* * Positionnement sur prochain poste C ADD LG DEBUT C ENDDO * * Fin du pgm RPG * C MOVE *ON *INLR ----------------------------------------------------------------------- /* Retour au pgm CL EXEMP01 DLTUSRSPC QTEMP/EXEMP /* ou API QUSDLTUS */ ENDPGM |
|
Autre exemple en RPG-IV avec des pointeurs (Spécif C étendue)
Dusrspc s 20 inz('EXEMP QTEMP')
* va contenir l'adresse de début du User Space
Dpointeur s *
DI s 10i 0
* l'entête
Dptrinfos s *
DRTVINF ds based(ptrinfos)
D offset 10i 0
D taille 10i 0
D nbpostes 10i 0
D lgposte 10i 0
* la liste
dptrliste s *
DLIST ds based(ptrliste)
d ... (informations membre, idem RPG III)
|
|
* prototype pour API qui retrouve pointeur de début
dQUSPTRUS PR EXTPGM('QUSPTRUS')
d space 20
d ptr *
* extraction du pointeur de début
c callp QUSPTRUS(usrspc : pointeur)
* positionnement sur la partie entête
c eval ptrinfos = pointeur + 124
* maintenant RTVINF (DS) a un contenu valide
* (rappel)
*DRTVINF e ds based(ptrinfos)
*D offset 10i 0
*D taille 10i 0
*D nbpostes 10i 0
*D lgposte 10i 0
|
|
* positionnement sur le premier poste * (la structure "LIST" vient se positionner "par dessus") c eval ptrliste = pointeur + offset * boucle (nbpostes fois) c for i = 1 to nbpostes * traitement d'un élément c ... c ... c ... c ... c ... c if i < nbpostes c eval ptrliste = ptrliste + lgposte c endif c endfor |
|
/free // en format libre QUSPTRUS(usrspc : pointeur); ptrinfos = pointeur + 124; ptrliste = pointeur + offset; // boucle (nbpostes fois) for i = 1 to nbpostes; // traitement d'un élément ... ... ... if i < nbpostes; ptrliste = ptrliste + lgposte; endif; endfor; /end-free |
|
PGM PARM(&BIB) /* ===================================================================== */ /* BUT : lister les RÉCEPTEURS DE JOURNAUX AFIN DE LES DÉTRUIRE */ /* -> utilisation des pointeurs en CL V5R40 */ /* -> utilisation des variables basées sur pointeur */ /* -> utilisation des sous zones (comme une DS en RPG) */ /* ===================================================================== */ DCL VAR(&COMPTEUR) TYPE(*INT) DCL VAR(&QUAL) TYPE(*CHAR) LEN(20) VALUE(*ALL) DCL VAR(&BIB) TYPE(*CHAR) LEN(10) DCL VAR(&pointeur) TYPE(*PTR) /* un pointeur */ DCL VAR(&PTRINFOS) TYPE(*PTR) DCL VAR(&DATA) TYPE(*CHAR) STG(*BASED) LEN(16) + BASPTR(&PTRINFOS) /* basée sur un pointeur */ DCL VAR(&DEBUT) TYPE(*INT) STG(*DEFINED) + DEFVAR(&DATA) /* sous zone de &DATA */ DCL VAR(&NOMBRE) TYPE(*INT) STG(*DEFINED) DEFVAR(&DATA + 9) /* sous zone de &DATA */ DCL VAR(&TAILLE) TYPE(*INT) STG(*DEFINED) DEFVAR(&DATA + 13) /* sous zone de &DATA */ |
|
DCL VAR(&ptrretour) TYPE(*PTR)
DCL VAR(&RETOUR) TYPE(*CHAR) STG(*BASED) LEN(30) +
BASPTR(&PTRRETOUR)
DCL VAR(&OBJ) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
DEFVAR(&RETOUR)
DCL VAR(&OBJLIB) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
DEFVAR(&RETOUR 11)
DCL VAR(&OBJTYPE) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
DEFVAR(&RETOUR 21)
DLTUSRSPC QTEMP/DLTLIBRCV
MONMSG MSGID(CPF2105) EXEC(RCVMSG PGMQ(*SAME) +
MSGTYPE(*EXCP))
/* CRÉATION DU USER SPACE */
CALL PGM(QUSCRTUS) PARM('DLTLIBRCV QTEMP' /* USRSPC */ +
' ' /* ATTRIBUT */ +
X'0000FFFF' /* TAILLE */ +
X'00' /* VAL INIT */ +
'*USE' /* DROITS */ +
'POUR DLTLIBRCV') /* TEXTE */
|
|
/* REMPLISSAGE, LISTE DES OBJETS (de type *JRNRCV) */
CHGVAR VAR(%SST(&QUAL 11 10)) VALUE(&BIB)
CALL QUSLOBJ PARM('DLTLIBRCV QTEMP' /* USRSPC */ +
'OBJL0100' /* FORMAT */ +
&QUAL /* bib/obj */ +
'*JRNRCV' /* type */ +
)
/* positionnement sur début du User Space (adresse 1) */
CALL PGM(QUSPTRUS) PARM('DLTLIBRCV QTEMP' &Pointeur)
/* récupération de &DATA, donc de &DEBUT &TAILLE ET &NOMBRE */
chgvar &ptrinfos &pointeur
CHGVAR %OFFSET(&ptrinfos) VALUE(%OFFSET(&ptrinfos) + 124 )
/* positionnement début de liste (on place &retour DANS le USer Space)*/
chgvar &ptrretour &pointeur
CHGVAR %OFFSET(&ptrretour) VALUE(%OFFSET(&ptrretour) +
+ &DEBUT )
|
|
DOFOR VAR(&COMPTEUR) FROM(1) TO(&NOMBRE) BY(1)
DLTJRNRCV JRNRCV(&OBJLIB/&OBJ)
MONMSG MSGID(CPF7022) /* récepteur attaché */
if (&compteur < &nombre) then(do)
CHGVAR %OFFSET(&ptrretour) VALUE(%OFFSET(&ptrretour) +
+ &TAILLE)
ENDDO
ENDDO
/* RENVOI D'UN MASSAGE d'ACHEVEMENT */
COMPMSG:
DLTUSRSPC QTEMP/DLTLIBRCV
SNDPGMMSG MSG('Ménage sur les récepteurs de journaux +
effectué') TOPGMQ(*PRV (*PGMBDY)) +
MSGTYPE(*COMP)
ENDPGM
|
