Craig Rutledge posting the following examples to the group:
/*-------------------------------------------------------------------*/
/* LSTMBRC - List processing for file members - Example Pgm */
/* */
/* By Craig Rutledge, 1/14/95, Version 1.0 */
/* */
/* This program was done as an example of working with APIs in */
/* a CL program. */
/* */
/*-------------------------------------------------------------------*/
/* Program Summary: */
/* */
/* Initialize binary values */
/* Create user space (API CALL) */
/* Load user space with member names (API CALL) */
/* Extract entries from user space (API CALL) */
/* Loop until all entries have been processed */
/* */
/*-------------------------------------------------------------------*/
/* API (application program interfaces) used: */
/* */
/* QUSCRTUS create user space */
/* QUSLMBR list file members */
/* QUSRTVUS retrieve user space */
/* See SYSTEM PROGRAMMER'S INTERFACE REFERENCE for API detail. */
/* */
/*-------------------------------------------------------------------*/
PGM
/*-------------------------------------------------------------------*/
/* $POSIT - binary fields to control calls to APIs. */
/* #START - get initial offset, # of elements, length of element. */
/*-------------------------------------------------------------------*/
DCL &$START *CHAR 4 /* $POSIT */
DCL &$LENGT *CHAR 4 /* $POSIT */
DCL &#START *CHAR 16
DCL &#OFSET *DEC (7 0)
DCL &#ELEMS *DEC (7 0)
DCL &#LENGT *DEC (7 0)
/*-------------------------------------------------------------------*/
/* Error return code parameter for the APIs */
/*-------------------------------------------------------------------*/
DCL &$DSERR *CHAR 256
DCL &$BYTPV *CHAR 4
DCL &$BYTAV *CHAR 4
DCL &$MSGID *CHAR 7
DCL &$RESVD *CHAR 1
DCL &$EXDTA *CHAR 240
/*-------------------------------------------------------------------*/
/* Define the fields used by the create user space API. */
/*-------------------------------------------------------------------*/
DCL &$SPACE *CHAR 20 ('LSTOBJR QTEMP ')
DCL &$EXTEN *CHAR 10 ('TEST')
DCL &$INIT *CHAR 1 (X'00')
DCL &$AUTHT *CHAR 10 ('*ALL')
DCL &$APITX *CHAR 50
DCL &$REPLA *CHAR 10 ('*NO')
/*-------------------------------------------------------------------*/
/* various other fields */
/*-------------------------------------------------------------------*/
DCL &$FORNM *CHAR 8 ('MBRL0200') /* QUSLMBR */
DCL &$FIELD *CHAR 30 /* QUSRTVUS */
DCL &$MEMBR *CHAR 10
DCL &$FILLB *CHAR 20 ('QDDSSRC JCRCMDS ')
DCL &$MBRNM *CHAR 10 ('*ALL ')
DCL &$MTYPE *CHAR 10
DCL &COUNT *DEC (5 0)
/*-------------------------------------------------------------------*/
/* Initialize Binary fields and build error return code variable */
/*-------------------------------------------------------------------*/
CHGVAR %BIN(&$START) 0
CHGVAR %BIN(&$LENGT) 50000
CHGVAR %BIN(&$BYTPV) 8
CHGVAR %BIN(&$BYTAV) 0
CHGVAR &$DSERR +
( &$BYTPV || &$BYTAV || &$MSGID || &$RESVD || &$EXDTA)
/*-- Create user space. ---------------------------------------------*/
CALL PGM(QUSCRTUS) PARM(&$SPACE &$EXTEN &$INIT +
&$LENGT &$AUTHT &$APITX &$REPLA &$DSERR)
/*-------------------------------------------------------------------*/
/* Call API to load the member names to the user space. */
/*-------------------------------------------------------------------*/
A: CALL PGM(QUSLMBR) PARM(&$SPACE &$FORNM &$FILLB +
&$MBRNM '0' &$DSERR)
CHGVAR %BIN(&$START) 125
CHGVAR %BIN(&$LENGT) 16
/*-------------------------------------------------------------------*/
/* Call API to return the starting position of the first block, the */
/* length of each data block, and the number of blocks are returned. */
/*-------------------------------------------------------------------*/
CALL PGM(QUSRTVUS) PARM(&$SPACE &$START &$LENGT +
&#START &$DSERR)
CHGVAR &#ELEMS %BIN(&#START 9 4) /* # OF ENTRIES */
IF (&#ELEMS = 0) GOTO C /* NO OBJECTS */
CHGVAR &#OFSET %BIN(&#START 1 4) /* TO 1ST OFFSET */
CHGVAR &#LENGT %BIN(&#START 13 4) /* LEN OF ENTRIES */
CHGVAR %BIN(&$START) (&#OFSET + 1)
CHGVAR %BIN(&$LENGT) &#LENGT
/*-------------------------------------------------------------------*/
/* Call API to retrieve the data from the user space. &#ELEMS */
/* is the number of data blocks to retrieve. Each block contains a */
/* the name of a member. */
/*-------------------------------------------------------------------*/
CHGVAR &COUNT 0
B: CHGVAR &COUNT (&COUNT + 1)
IF (&COUNT *LE &#ELEMS) DO
CALL PGM(QUSRTVUS) PARM(&$SPACE &$START &$LENGT +
&$FIELD &$DSERR)
CHGVAR &$MTYPE %SST(&$FIELD 11 10) /* MEMBER TYPE */
CHGVAR &$MBRNM %SST(&$FIELD 1 10) /* EXTRACT MEMBER NAME */
IF (&$MTYPE = 'PRTF ') DO
/* ANZPRTFF PRTF(&$MBRNM) SRCFILE(JCRCMDS/QDDSSRC) */
ENDDO
CHGVAR &#OFSET %BIN(&$START)
CHGVAR %BIN(&$START) (&#OFSET + &#LENGT)
GOTO B
ENDDO
C: ENDPGM
/*-------------------------------------------------------------------*/
/* LSTOBJC - List processing for OBJECTS - Example Pgm */
/* */
/* By Craig Rutledge, 1/03/94, Version 1.0 */
/* */
/* This program was done as an example of working with APIs in */
/* a CL program. */
/* */
/*-------------------------------------------------------------------*/
/* Program Summary: */
/* */
/* Initialize binary values */
/* Create user space (API CALL) */
/* Load user space with object names (API CALL) */
/* Extract entries from user space (API CALL) */
/* Loop until all entries have been processed */
/* */
/*-------------------------------------------------------------------*/
/* API (application program interfaces) used: */
/* */
/* QUSCRTUS create user space */
/* QUSLOBJ list objects */
/* QUSRTVUS retrieve user space */
/* See SYSTEM PROGRAMMER'S INTERFACE REFERENCE for API detail. */
/* */
/*-------------------------------------------------------------------*/
PGM
/*-------------------------------------------------------------------*/
/* $POSIT - binary fields to control calls to APIs. */
/* #START - get initial offset, # of elements, length of element. */
/*-------------------------------------------------------------------*/
DCL &$START *CHAR 4 /* $POSIT */
DCL &$LENGT *CHAR 4 /* $POSIT */
DCL &#START *CHAR 16
DCL &#OFSET *DEC (5 0)
DCL &#ELEMS *DEC (5 0)
DCL &#LENGT *DEC (5 0)
/*-------------------------------------------------------------------*/
/* Error return code parameter for the APIs */
/*-------------------------------------------------------------------*/
DCL &$DSERR *CHAR 256
DCL &$BYTPV *CHAR 4
DCL &$BYTAV *CHAR 4
DCL &$MSGID *CHAR 7
DCL &$RESVD *CHAR 1
DCL &$EXDTA *CHAR 240
/*-------------------------------------------------------------------*/
/* Define the fields used by the create user space API. */
/*-------------------------------------------------------------------*/
DCL &$SPACE *CHAR 20 ('LSTOBJR QTEMP ')
DCL &$EXTEN *CHAR 10 ('TEST')
DCL &$INIT *CHAR 1 (X'00')
DCL &$AUTHT *CHAR 10 ('*ALL')
DCL &$APITX *CHAR 50
DCL &$REPLA *CHAR 10 ('*NO')
/*-------------------------------------------------------------------*/
/* various other fields */
/*-------------------------------------------------------------------*/
DCL &$FORNM *CHAR 8 ('OBJL0100') /* QUSLOBJ */
DCL &$FIELD *CHAR 30 /* QUSRTVUS */
DCL &$DEVNM *CHAR 10 /* RMT002P */
DCL &$OBJLB *CHAR 20 ('*ALL QSYS ')
DCL &$OBJTY *CHAR 10 ('*LIB ')
DCL &COUNT *DEC (5 0)
/*-------------------------------------------------------------------*/
/* Initialize Binary fields and build error return code variable */
/*-------------------------------------------------------------------*/
CHGVAR %BIN(&$START) 0
CHGVAR %BIN(&$LENGT) 5000
CHGVAR %BIN(&$BYTPV) 8
CHGVAR %BIN(&$BYTAV) 0
CHGVAR &$DSERR +
( &$BYTPV || &$BYTAV || &$MSGID || &$RESVD || &$EXDTA)
/*-- Create user space. ---------------------------------------------*/
CALL PGM(QUSCRTUS) PARM(&$SPACE &$EXTEN &$INIT +
&$LENGT &$AUTHT &$APITX &$REPLA &$DSERR)
/*-------------------------------------------------------------------*/
/* Call API to load the object names to the user space. */
/*-------------------------------------------------------------------*/
A: CALL PGM(QUSLOBJ) PARM(&$SPACE &$FORNM &$OBJLB +
&$OBJTY &$DSERR)
CHGVAR %BIN(&$START) 125
CHGVAR %BIN(&$LENGT) 16
/*-------------------------------------------------------------------*/
/* Call API to return the starting position of the first block, the */
/* length of each data block, and the number of blocks are returned. */
/*-------------------------------------------------------------------*/
CALL PGM(QUSRTVUS) PARM(&$SPACE &$START &$LENGT +
&#START &$DSERR)
CHGVAR &#ELEMS %BIN(&#START 9 4) /* # OF ENTRIES */
IF (&#ELEMS = 0) GOTO C /* NO OBJECTS */
CHGVAR &#OFSET %BIN(&#START 1 4) /* TO 1ST OFFSET */
CHGVAR &#LENGT %BIN(&#START 13 4) /* LEN OF ENTRIES */
CHGVAR %BIN(&$START) (&#OFSET + 1)
CHGVAR %BIN(&$LENGT) &#LENGT
/*-------------------------------------------------------------------*/
/* Call API to retrieve the data from the user space. &#ELEMS */
/* is the number of data blocks to retrieve. Each block contains a */
/* the name of a object and information about that object. */
/*-------------------------------------------------------------------*/
CHGVAR &COUNT 0
B: CHGVAR &COUNT (&COUNT + 1)
IF (&COUNT *LE &#ELEMS) DO
CALL PGM(QUSRTVUS) PARM(&$SPACE &$START &$LENGT +
&$FIELD &$DSERR)
CHGVAR &$DEVNM %SST(&$FIELD 1 10) /* EXTRACT DEVICE NAME */
/* INSERT CODE HERE */
CHGVAR &#OFSET %BIN(&$START)
CHGVAR %BIN(&$START) (&#OFSET + &#LENGT)
GOTO B
ENDDO
C: ENDPGM
