/*---------------------------------------------------------------------------*/ /* SHOLIBSIZ: Retrieves library size and displays it in a message... */ /*---------------------------------------------------------------------------*/ SHOLIBSIZ: PGM PARM(&LIB) DCL VAR(&LIB) TYPE(*CHAR) LEN(10) /* */ /* RTVLIBSIZ returns variable records into this field. We'll process the */ /* two records returned to extract the data we need... */ /* */ DCL VAR(&LIBDTA) TYPE(*CHAR) LEN(256) /* */ /* Each variable record is extracted in turn and various descriptive data */ /* is set up... */ /* */ DCL VAR(&VARRCD) TYPE(*CHAR) LEN(64) DCL VAR(&VARRCDRTN) TYPE(*DEC) LEN(3) /* The + number of variable records returned + (RTVLIBSIZ returns 2)... */ DCL VAR(&VARRCDLEN) TYPE(*DEC) LEN(3) /* The + length of the current VARRCD... */ DCL VAR(&OFFSVARRCD) TYPE(*DEC) LEN(3) /* Offset + into the current VARRCD... */ DCL VAR(&KEYID) TYPE(*DEC) LEN(3) /* The key ID + of the current VARRCD... */ DCL VAR(&SIZFLD) TYPE(*DEC) LEN(3) /* The size + of the current VARRCD data field... */ /* Loop counter... */ DCL VAR(&CNT) TYPE(*DEC) LEN(3) /* */ /* *DEC and *CHAR representations of the *LIB object size and the reported */ /* "library size" from RTVLIBSIZ... */ /* */ DCL VAR(&LIBOBJSIZ) TYPE(*DEC) LEN(15) /* The + size of the LIB object itself... */ DCL VAR(&LO_SIZE_C) TYPE(*CHAR) LEN(15) DCL VAR(&SIZE) TYPE(*DEC) LEN(15) DCL VAR(&SIZE_C) TYPE(*CHAR) LEN(15) /* */ /* *DEC and *CHAR representations of number of objects in the library... */ /* */ DCL VAR(&OBJNBR) TYPE(*DEC) LEN(15) DCL VAR(&OBJNBR_C) TYPE(*CHAR) LEN(15) /* */ /* Object count and library size is displayed in numeric edited form. These */ /* are used for the editing operations... */ /* */ DCL VAR(&EDTMSK) TYPE(*CHAR) LEN(256) /* The + edit mask... */ DCL VAR(&EDTMSKLEN) TYPE(*CHAR) LEN(4) /* Length + of the edit mask... */ DCL VAR(&RCVVARLEN) TYPE(*CHAR) LEN(4) /* Length + of output returned by the edit mask... */ DCL VAR(&ZERBALFIL) TYPE(*CHAR) LEN(1) /* Zero + balance fill character... */ DCL VAR(&RCVVAR) TYPE(*CHAR) LEN(512) /* The + returned edited value... */ DCL VAR(&RVLEN) TYPE(*DEC) LEN(3) /* Decimal + version of RCVVARLEN... */ /* */ /* Used for left-justifying edited variables... */ /* */ DCL VAR(&JSTSTR) TYPE(*CHAR) LEN(128) /* The + string to left-justify... */ DCL VAR(&JSTLEN) TYPE(*DEC) LEN(3) /* The length + to left-justify... */ /* */ /* Verify that the requested library exists... */ /* */ CHKOBJ OBJ(QSYS/&LIB) OBJTYPE(*LIB) MONMSG MSGID(CPF9801) EXEC(DO) SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) + MSGDTA('Library' *BCAT &LIB *BCAT 'not + found') MSGTYPE(*ESCAPE) RETURN ENDDO /* */ /* Convert editcode 'Z' into an edit mask. This will be used by other edit */ /* functions later... */ /* */ CVTEDTCDE EDTMSK(&EDTMSK) EDTMSKLEN(&EDTMSKLEN) + RCVVARLEN(&RCVVARLEN) + ZERBALFIL(&ZERBALFIL) EDTCDE(Z) SRCPRE(15) /* */ /* Convert the *bin(4) length of the edited value to *dec... */ /* */ CHGVAR VAR(&RVLEN) VALUE(%BIN(&RCVVARLEN)) /* */ /* Retrieve the size and object count via Retrieve Library Description */ /* (QLIRLIBD) API using RTVLIBSIZ command. The command is structured to */ /* return two description records. The first is for key ID 6, library */ /* size information, and the second is for key ID 7, number of objects */ /* in the library.... */ /* */ RTVLIBSIZ LIBSIZDTA(&LIBDTA) LIBNAM(&LIB) /* */ /* Because the returned structure contains two variable records, we must */ /* parse the structure according to the API documentation. This initializes */ /* two fields needed for the parsing: the number of variable records */ /* actually returned is a *bin(4) value beginning at position 9 of the */ /* returned structure. Although this should always = 2, we check just in */ /* case. We might want future changes in the command and need to change */ /* the code in this program. The offset to the first variable length */ /* record will always be 16 (position 17)... */ /* */ CHGVAR VAR(&VARRCDRTN) VALUE(%BIN(&LIBDTA 9 4)) CHGVAR VAR(&OFFSVARRCD) VALUE(17) /* */ /* Initialize our loop counter to the number of variable records... */ /* */ CHGVAR VAR(&CNT) VALUE(&VARRCDRTN) /* */ /* Loop through the structure and extract the variable records. Handle each */ /* record according to the key ID... */ /* */ NXT_VARRCD: CHGVAR VAR(&VARRCDLEN) VALUE(%BIN(&LIBDTA + &OFFSVARRCD 4)) /* */ /* Extract a variable record according to the length returned... */ /* */ CHGVAR VAR(&VARRCD) VALUE(%SST(&LIBDTA &OFFSVARRCD + &VARRCDLEN)) /* */ /* Extract key ID and data length from this variable record... */ /* */ CHGVAR VAR(&KEYID) VALUE(%BIN(&VARRCD 5 4)) CHGVAR VAR(&SIZFLD) VALUE(%BIN(&VARRCD 9 4)) /* */ /* Bump our offset to the next variable record. We must account for the */ /* three *bin(4) fields at the start of each record (12) and the length */ /* of the data field (&SIZFLD)... */ /* */ CHGVAR VAR(&OFFSVARRCD) VALUE(&OFFSVARRCD + 12 + + &SIZFLD) /* */ /* Process key ID 6... */ /* */ IF COND(&KEYID *EQ 6) THEN(DO) /* Extract library size fields. This includes a base plus a multiplier... */ CHGVAR VAR(&SIZE) VALUE(%BIN(&VARRCD 13 4) * + %BIN(&VARRCD 17 4)) CHGVAR VAR(&SIZE_C) VALUE(&SIZE) /* */ /* Execute the edit... */ /* */ EDTVAROBJ RCVVAR(&RCVVAR) RCVVARLEN(%BIN(&RCVVARLEN)) + SRCVAR(&SIZE_C) SRCPRE(15) + EDTMSK(&EDTMSK) + EDTMSKLEN(%BIN(&EDTMSKLEN)) + ZERBALFIL(&ZERBALFIL) /* */ /* ...and left-justify the value for insertion into a message... */ /* */ CHGVAR VAR(&JSTSTR) VALUE(%SST(&RCVVAR 1 &RVLEN)) JSTLFT STR(&JSTSTR) STRLEN(&JSTLEN) CHGVAR VAR(&SIZE_C) VALUE(&JSTSTR) ENDDO /* */ /* Process key ID 7... */ /* */ ELSE CMD(IF COND(&KEYID *EQ 7) THEN(DO)) /* Extract number of objects... */ CHGVAR VAR(&OBJNBR) VALUE(%BIN(&VARRCD 13 4)) CHGVAR VAR(&OBJNBR_C) VALUE(&OBJNBR) /* */ /* Execute the edit... */ /* */ EDTVAROBJ RCVVAR(&RCVVAR) RCVVARLEN(%BIN(&RCVVARLEN)) + SRCVAR(&OBJNBR_C) SRCPRE(15) + EDTMSK(&EDTMSK) + EDTMSKLEN(%BIN(&EDTMSKLEN)) + ZERBALFIL(&ZERBALFIL) /* */ /* ...and left-justify the value for insertion into a message... */ /* */ CHGVAR VAR(&JSTSTR) VALUE(%SST(&RCVVAR 1 &RVLEN)) JSTLFT STR(&JSTSTR) STRLEN(&JSTLEN) CHGVAR VAR(&OBJNBR_C) VALUE(&JSTSTR) ENDDO /* */ /* Decrement loop counter and test... */ /* */ CHGVAR VAR(&CNT) VALUE(&CNT - 1) IF COND(&CNT *GT 0) THEN(GOTO CMDLBL(NXT_VARRCD)) /* */ /* We also retrieve the size of the *LIB object itself. This is displayed */ /* in the message because the 'library size information' value includes */ /* the size of the *LIB object. The user is supplied this value so that */ /* it can be subtracted if desired... */ /* */ RTVOBJD OBJ(&LIB) OBJTYPE(*LIB) SIZE(&LIBOBJSIZ) /* */ /* Convert to *char to satisfy the EDTVAROBJ command... */ /* */ CHGVAR VAR(&LO_SIZE_C) VALUE(&LIBOBJSIZ) /* */ /* Execute the edit... */ /* */ EDTVAROBJ RCVVAR(&RCVVAR) RCVVARLEN(%BIN(&RCVVARLEN)) + SRCVAR(&LO_SIZE_C) SRCPRE(15) + EDTMSK(&EDTMSK) + EDTMSKLEN(%BIN(&EDTMSKLEN)) + ZERBALFIL(&ZERBALFIL) /* */ /* ...and left-justify the value for insertion into a message... */ /* */ CHGVAR VAR(&JSTSTR) VALUE(%SST(&RCVVAR 1 &RVLEN)) JSTLFT STR(&JSTSTR) STRLEN(&JSTLEN) CHGVAR VAR(&LO_SIZE_C) VALUE(&JSTSTR) /* */ /* Display the message with the info... */ /* */ SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) + MSGDTA('Library' *BCAT &LIB *BCAT 'size + is' *BCAT &SIZE_C *TCAT '. (*LIB size:' + *BCAT &LO_SIZE_C *TCAT ' Object count:' + *BCAT &OBJNBR_C *TCAT ')') TOPGMQ(*EXT) /* */ /* ...and get out of this program... */ /* */ RETURN ENDPGM