DLTLIBRCVP





Exemple : utilisation des API en CL V5R30


|
             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(&TAILLE) TYPE(*INT) VALUE(32767)
             DCL        VAR(&DEBUT)  TYPE(*INT)
             DCL        VAR(&DEBUTS)   TYPE(*INT)
             DCL        VAR(&TAILLEP) TYPE(*INT) VALUE(32767)
             DCL        VAR(&NOMBRE) TYPE(*INT)
             DCL        VAR(&RETOUR) TYPE(*CHAR) LEN(30)
             DCL        VAR(&QUAL) TYPE(*CHAR) LEN(20) VALUE(*ALL)
             DCL        VAR(&BIB) TYPE(*CHAR) LEN(10)
         /* 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 QUSCRTUS PARM('DLTLIBRCV QTEMP'  /* USRSPC   */       +                                 '          '       /* ATTRIBUT */       +                                 &TAILLE            /* TAILLE   */       +                                 X'00'              /* VAL INITIALE */   +                                 '*USE'             /* DROITS */         +                                 'POUR DLTLIBRCV')  /* 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     */       +                                )              CHGVAR     VAR(&DEBUT) VALUE(125) /* DEBUT DE LISTE */              CHGVAR     VAR(&TAILLE) VALUE(4)              CALL       PGM(QUSRTVUS) PARM('DLTLIBRCV QTEMP' &DEBUT +                           &TAILLE &DEBUTS)
             CHGVAR     VAR(&DEBUT) VALUE(133) /* NOMBRE DE POSTES */              CALL       PGM(QUSRTVUS) PARM('DLTLIBRCV QTEMP' &DEBUT +                           &TAILLE &NOMBRE)              CHGVAR     VAR(&DEBUT) VALUE(137) /* TAILLE D'1 POSTE */              CALL       PGM(QUSRTVUS) PARM('DLTLIBRCV QTEMP' &DEBUT +                           &TAILLE &TAILLEP)
             CHGVAR     VAR(&DEBUT) VALUE(&DEBUTS + 1) /* DEBUT */              CHGVAR     VAR(&TAILLE) VALUE(30) /* lg de retour */
             DOFOR      VAR(&COMPTEUR) FROM(1) TO(&NOMBRE) BY(1)
              CALL       PGM(QUSRTVUS) PARM('DLTLIBRCV QTEMP' &DEBUT +                            &TAILLE &RETOUR)
              DLTJRNRCV  JRNRCV(%SST(&RETOUR 11 10)/%SST(&RETOUR 1 10))                MONMSG     MSGID(CPF7022)
              CHGVAR &DEBUT (&DEBUT + &TAILLEP)              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





©AF400