2003-08-26 如何於 CLP 中列出 PF 的 Member ? (API QUSLMBR)

如何於 CLP 中列出 PF 的 Member ? (API QUSLMBR)

有二種方式：

1.  
PGM
DCLF QAFDMBRL
DSPFD FILE(lib/file) TYPE(*MBRLIST) OUTPUT(*OUTFILE) OUTFILE(lib/MBRLIST)
OVRDBF FILE(QAFDMBRL) TOFILE(lib/MBRLIST)

LOOP:
      RCVF
      MONMSG  CPF0864 EXEC(GOTO END)
      SNDPGMMSG MSG(&MLNAME)
      GOTO LOOP
END:
     DLTOVR FILE(*ALL)
     ENDPGM

2. API QUSLMBR
   Usage: CRTCLPGM LSTMBRC
          CALL LSTMBRC('lib' 'file')

/*-------------------------------------------------------------------*/
/* LSTMBRC - List processing for file members - Example Pgm          */
/*                                                                   */
/* 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   (&LIB &FILE)

    DCL  &LIB    *CHAR 10
    DCL  &FILE   *CHAR 10

/*-------------------------------------------------------------------*/
/* $POSIT -  binary fields to control calls to APIs.                 */
/* #START -  get initial offset, # of elements, length of element.   */
/*-------------------------------------------------------------------*/
    DCL  &STARTC *CHAR 4       /* $POSIT  */
    DCL  &LENGTC *CHAR 4       /* $POSIT  */

    DCL  &STARTN *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  &FORMAT *CHAR 8     ('MBRL0200')       /* QUSLMBR  */
    DCL  &FIELD  *CHAR 30                       /* QUSRTVUS */
    DCL  &MEMBR  *CHAR 10
    DCL  &FILLB  *CHAR 20    ('QCLSRC    QGPL     ')
    DCL  &MBRNM  *CHAR 10    ('*ALL   ')
    DCL  &MTYPE  *CHAR 10
    DCL  &COUNT   *DEC (5 0)

    CHGVAR %SST(&FILLB 1  10) &FILE
    CHGVAR %SST(&FILLB 11 10) &LIB
/*-------------------------------------------------------------------*/
/* Initialize Binary fields and build error return code variable     */
/*-------------------------------------------------------------------*/
    CHGVAR %BIN(&STARTC) 0
    CHGVAR %BIN(&LENGTC) 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 +
    &LENGTC &AUTHT &APITX &REPLA &DSERR)


/*-------------------------------------------------------------------*/
/* Call API to load the member names to the user space.              */
/*-------------------------------------------------------------------*/
 A:   CALL PGM(QUSLMBR) PARM(&SPACE &FORMAT &FILLB +
    &MBRNM '0' &DSERR)

    CHGVAR %BIN(&STARTC) 125
    CHGVAR %BIN(&LENGTC) 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 &STARTC &LENGTC +
    &STARTN &DSERR)

    CHGVAR &ELEMS   %BIN(&STARTN 9 4)   /* # OF ENTRIES   */
    IF (&ELEMS = 0) GOTO C  /* NO OBJECTS                 */

    CHGVAR &OFSET   %BIN(&STARTN 1 4)   /* TO 1ST OFFSET  */
    CHGVAR &LENGT   %BIN(&STARTN 13 4)  /* LEN OF ENTRIES */

    CHGVAR %BIN(&STARTC) (&OFSET + 1)
    CHGVAR %BIN(&LENGTC)  &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 &STARTC &LENGTC +
    &FIELD &DSERR)

    CHGVAR &MTYPE   %SST(&FIELD 11 10) /* MEMBER TYPE         */
    CHGVAR &MBRNM   %SST(&FIELD 1 10) /* EXTRACT MEMBER NAME */

   /* IF (&MTYPE = 'PRTF  ') DO                         */
   /* DO YOUR CODE HERE                                  */
             SNDPGMMSG  MSG(&MBRNM)
   /* ENDDO                                              */
    CHGVAR &OFSET   %BIN(&STARTC)
    CHGVAR %BIN(&STARTC) (&OFSET + &LENGT)
    GOTO B
    ENDDO

  C:
    DLTUSRSPC  USRSPC(QTEMP/LSTOBJR)
    ENDPGM