| 
PGM PARM(&COD &LIB &SIZRT &TYP)
DCL &COD *CHAR 1
DCL &LIB *CHAR 10
DCL &SIZRT *DEC 15 0
DCL &TYP *CHAR 7
DCL &WTYP *CHAR 10
DCL &TAILLE *DEC 15 0
DCL &MULT *DEC (15 0)
DCL &TOTAL *DEC (15 0)
DCL &TOTALC *CHAR 15
DCL &TOTALCL *CHAR 19
DCL &OBJLIB *CHAR 20 VALUE('*ALL')
DCL &RETOUR *CHAR 585
DCL &POS *CHAR 4
DCL &LG *CHAR 4
DCL &LGUS *DEC (15 0)
DCL &DEBUT *DEC (15 0)
DCL &NOMBRE *DEC (15 0)
DCL &COMPTEUR *DEC (15 0)
DCL &UNITE *CHAR 10
DCL &POSEDT *DEC (2 0)
DCL &LGEDT *DEC (2 0)
/* VARIABLES UTILISEES PAR LA GESTION DE MESSGAES */
DCL &ERRORSW *LGL /* SWITCH */
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)
/* CREATION DU USER SPACE */
CRTUSRSPC USRSPC(QTEMP/LIBSIZ)
CHGVAR %SST(&OBJLIB 11 10) &LIB
/* REMPLISSAGE AVEC LISTE DES OBJETS */
CHGVAR &TYP &TYP /* TEST PARAM RENSEIGNÉ */
MONMSG MCH0000 EXEC(DO) /* (CDE ANCIENNE VERSION) */
CHGVAR &WTYP '*ALL'
GOTO LISTE
ENDDO
IF (&TYP ^= ' ') CHGVAR &WTYP &TYP
ELSE CHGVAR &WTYP '*ALL'
LISTE: CALL QUSLOBJ PARM('LIBSIZ QTEMP ' +
'OBJL0700' +
&OBJLIB +
|
|
&WTYP)
/* EXTRACTIONS NOMBRE D'OBETS ET INFOS GENERALES */
CHGVAR %BIN(&POS) 125
CHGVAR %BIN(&LG) 16
CALL QUSRTVUS PARM('LIBSIZ QTEMP ' +
&POS &LG &RETOUR)
CHGVAR &NOMBRE %BIN(&RETOUR 9 4)
IF (&NOMBRE > 0) THEN(DO)
CHGVAR &LGUS %BIN(&RETOUR 13 4)
CHGVAR &DEBUT %BIN(&RETOUR 1 4)
CHGVAR &DEBUT (&DEBUT + 1)
CHGVAR %BIN(&LG) 585
/* BOUCLE LECTURE D'UN OBJET */
BCL:
CHGVAR %BIN(&POS) &DEBUT
CALL QUSRTVUS PARM('LIBSIZ QTEMP ' +
&POS &LG &RETOUR)
/* CALCUL DE LA TAILLE DE CET OBJET ET CUMUL */
CHGVAR &TAILLE %BIN(&RETOUR 577 4)
CHGVAR &MULT %BIN(&RETOUR 581 4) /* 1 OU 1024 */
CHGVAR &TAILLE (&TAILLE * &MULT)
CHGVAR &TOTAL (&TOTAL + &TAILLE)
/* SI'IL RESTE DES OBJETS(SUIVANT "NOMBRE" , BOUCLE */
CHGVAR &COMPTEUR (&COMPTEUR + 1)
IF (&COMPTEUR < &NOMBRE) THEN(DO)
CHGVAR &DEBUT (&DEBUT + &LGUS)
GOTO BCL
ENDDO
ENDDO
IF (&COD = 'R') THEN(CHGVAR &SIZRT &TOTAL)
ELSE DO
/* TOTAL EN KO SI > À 1024 OCTETS */
IF (&TOTAL > 1024) THEN(DO)
CHGVAR &TOTAL (&TOTAL / 1024)
CHGVAR &UNITE 'Ko'
ENDDO
ELSE CHGVAR &UNITE 'Octets'
CHGVAR &TOTALC &TOTAL
/* MISE EN FORME */
CHGVAR &POSEDT 1
IF (%SST(&TOTALC 1 3) ^= '000') +
CHGVAR %SST(&TOTALCL 1 4) (%SST(&TOTALC 1 3) *CAT '.')
ELSE CHGVAR &POSEDT 5
|
|
IF (%SST(&TOTALC 4 3) ^= '000') +
CHGVAR %SST(&TOTALCL 5 4) (%SST(&TOTALC 4 3) *CAT '.')
ELSE CHGVAR &POSEDT 9
IF (%SST(&TOTALC 7 3) ^= '000') +
CHGVAR %SST(&TOTALCL 9 4) (%SST(&TOTALC 7 3) *CAT '.')
ELSE CHGVAR &POSEDT 13
IF (%SST(&TOTALC 10 3) ^= '000') +
CHGVAR %SST(&TOTALCL 13 4) (%SST(&TOTALC 10 3) *CAT '.')
ELSE CHGVAR &POSEDT 17
CHGVAR %SST(&TOTALCL 17 3) %SST(&TOTALC 13 3)
CHGVAR &LGEDT (20 - &POSEDT)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA('La +
taille de la bibliothèque ' *CAT &LIB +
*BCAT 'est de :' *BCAT %SST(&TOTALCL +
&POSEDT &LGEDT) *BCAT &UNITE) MSGTYPE(*COMP)
ENDDO
RETURN
/*----------------------------------------*/
ERREUR: /* GESTION DES ERREURS */
/*----------------------------------------*/
IF &ERRORSW SNDPGMMSG MSGID(CPF9899) +
MSGF(QCPFMSG) MSGTYPE(*ESCAPE) /* 2EME FOIS*/
/* ARRET PGM*/
CHGVAR &ERRORSW '1' /* MISE EN PLACE DU SWTICH */
/* RENVOI DES MESSAGES DE TYPE *DIAG SI FIN ANORMALE */
DIAGMSG: RCVMSG MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB)
IF (&MSGID *EQ ' ') GOTO EXCPMSG
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
GOTO DIAGMSG /* BOUCLE SUR MESSAGES *DIAG */
/* RENVOI DU MESSAGE D'ERREUR */
EXCPMSG: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
ENDPGM
|
