* -------------------------------------------------------------- */
/* Ejemplo de obtencion del espacio ocupado y la cantidad de */
/* objetos que contiene una biblioteca utilizando el API QLIRLIB */
/* -------------------------------------------------------------- */
PGM PARM(&BIBLIO)
/* El contenido de la variable &BIBLIO, debe estar en mayusculas */
/* de lo contrario el API no la encuentra. */
DCL VAR(&BIBLIO) TYPE(*CHAR) LEN(10)
DCL VAR(&STR) TYPE(*CHAR) LEN(48)
DCL VAR(&LENG) TYPE(*CHAR) LEN(4) VALUE(X'00000030')
DCL VAR(&CERR) TYPE(*CHAR) LEN(128)
DCL VAR(&OPC) TYPE(*CHAR) LEN(8)
DCL VAR(&TEXT) TYPE(*CHAR) LEN(50)
DCL VAR(&TAM1) TYPE(*CHAR) LEN(9)
DCL VAR(&MUL1) TYPE(*CHAR) LEN(9)
DCL VAR(&TAM2) TYPE(*DEC) LEN(12 0)
DCL VAR(&MUL2) TYPE(*DEC) LEN(9 0)
DCL VAR(&TAM3) TYPE(*CHAR) LEN(12)
DCL VAR(&COBJ) TYPE(*CHAR) LEN(12)
DCL VAR(&XMSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&XMSGDT) TYPE(*CHAR) LEN(112)
/* Manejo de Errores */
DCL VAR(&MsgId) TYPE(*CHAR) LEN(7)
DCL VAR(&MsgDta) TYPE(*CHAR) LEN(50)
DCL VAR(&Msgf) TYPE(*CHAR) LEN(10)
DCL VAR(&MsgfLib) TYPE(*CHAR) LEN(10)
DCL VAR(&Error) TYPE(*LGL) VALUE('0')
/* -------------------------------------------------- */
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
/* -------------------------------------------------- */
/* Obtiene tamaño de biblioteca */
CHGVAR %SST(&CERR 1 8) VALUE(X'0000012800000000')
CHGVAR &OPC VALUE(X'0000000100000006')
CALL QLIRLIBD PARM(&STR &LENG &BIBLIO &OPC &CERR)
CHGVAR &XMSGID %SST(&CERR 9 7)
CHGVAR &XMSGDT %SST(&CERR 17 112)
IF (&XMSGID ¬= ' ') DO /* Error en API */
SNDPGMMSG MSGID(&XMSGID) MSGF(QCPFMSG) +
MSGDTA(&XMSGDT) +
TOPGMQ(*PRV) MSGTYPE(*INFO)
GOTO END
ENDDO
CHGVAR VAR(&TAM1) VALUE(%BIN(&STR 29 4))
CHGVAR VAR(&MUL1) VALUE(%BIN(&STR 33 4))
CHGVAR VAR(&TAM2) VALUE(&TAM1)
CHGVAR VAR(&MUL2) VALUE(&MUL1)
CHGVAR VAR(&TAM2) VALUE(&TAM2*&MUL2)
CHGVAR VAR(&TAM3) VALUE(&TAM2)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA('Biblioteca : ' || &BIBLIO || ' +
Tamaño : ' || &TAM3) TOPGMQ(*PRV) +
MSGTYPE(*INFO)
/* Obtiene cantidad de objetos en biblioteca */
CHGVAR &OPC VALUE(X'0000000100000007')
CALL QLIRLIBD PARM(&STR &LENG &BIBLIO &OPC &CERR)
CHGVAR &XMSGID %SST(&CERR 9 7)
CHGVAR &XMSGDT %SST(&CERR 17 112)
IF (&XMSGID ¬= ' ') DO /* Error en API */
SNDPGMMSG MSGID(&XMSGID) MSGF(QCPFMSG) +
MSGDTA(&XMSGDT) +
TOPGMQ(*PRV) MSGTYPE(*INFO)
GOTO END
ENDDO
CHGVAR VAR(&TAM1) VALUE(%BIN(&STR 29 4))
CHGVAR VAR(&MUL1) VALUE(%BIN(&STR 33 4))
CHGVAR VAR(&TAM2) VALUE(&TAM1)
CHGVAR VAR(&MUL2) VALUE(&MUL1)
CHGVAR VAR(&TAM2) VALUE(&TAM2*&MUL2)
CHGVAR VAR(&COBJ) VALUE(&TAM2)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA('Biblioteca : ' || &BIBLIO || ' +
Cantidad de Objetos: ' || &COBJ) +
TOPGMQ(*PRV) MSGTYPE(*INFO)
GOTO CMDLBL(END)
/* Rutina de errores --------------------------------------------- */
ERROR: IF COND(¬ &Error) THEN(DO)
CHGVAR VAR(&Error) VALUE('1')
RCVMSG MSGTYPE(*EXCP) MSGDTA(&MsgDta) +
MSGID(&MsgId) MSGF(&Msgf) +
MSGFLIB(&MsgfLib)
SNDPGMMSG MSGID(&MsgId) MSGF(&MsgfLib/&Msgf) +
MSGDTA(&MsgDta) MSGTYPE(*ESCAPE)
ENDDO
END: ENDPGM
