PGM PARM(&BIB)
/* ===================================================================== */
/* BUT : lister les RÉCEPTEURS DE JOURNAUX AFIN DE LES DÉTRUIRE */
/* sauf ceux attachés */
/* ===================================================================== */
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)
DCL VAR(&ptrinfos) TYPE(*PTR)
DCL VAR(&DATA) TYPE(*CHAR) STG(*BASED) LEN(16) +
BASPTR(&PTRINFOS)
DCL VAR(&DEBUT) TYPE(*INT) STG(*DEFINED) DEFVAR(&DATA)
DCL VAR(&NOMBRE) TYPE(*INT) STG(*DEFINED) DEFVAR(&DATA +
9)
DCL VAR(&TAILLE) TYPE(*INT) STG(*DEFINED) DEFVAR(&DATA +
13)
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)
/* VARIABLES UTILISEES PAR LA GESTION DE MESSAGES */
DCL &MSGID *CHAR LEN(7) /* ID MSG */
DCL &MSGDTA *CHAR LEN(100) /* DATA */
DCL &MSGF *CHAR LEN(10) /* FICHIER */
DCL &MSGFLIB *CHAR LEN(10) /* BIBLI */
MONMSG MSGID(CPF0000) EXEC(GOTO ERREUR)
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 */
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 */
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)
if (&compteur < &nombre) then(do)
CHGVAR %OFFSET(&ptrretour) VALUE(%OFFSET(&ptrretour) +
+ &TAILLE)
ENDDO
ENDDO
/* RENVOI DES MESSAGES DE TYPE *COMP SI FIN NORMALE */
COMPMSG:
DLTUSRSPC QTEMP/DLTLIBRCV
SNDPGMMSG MSG('Ménage sur les récepteurs de journaux +
effectué') TOPGMQ(*PRV (*PGMBDY)) +
MSGTYPE(*COMP)
return
/* RENVOI DU MESSAGE D'ERREUR RECU */
ERREUR:
RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) TOPGMQ(*PRV (*PGMBDY)) +
MSGTYPE(*ESCAPE)
ENDPGM
|
| 
