				Wiki
	updated on 2004.06.23

6.17.DSPFD *MBRLIST のAPI (CLP)

[ Previous ] [ HOME ] [ Upper ] [ Next ]

いきなり、ぽんとソースですが、DSPDBRのAPIです。パラメータで、渡したファイル名とそのライブラリー名から、入っているメンバーリストを取り出します。(1)の部分で可能です。 ※SNDPGMMSGは、内容確認のために行っています。このかわりに、利用したいコマンドを指定してください。

/*---------------------------------------------------------*/
/*                                                         */
/*     指定ファイル名のMEMBER LIST                         */
/*                                                         */
/*          PROGRAMMER . . . . . KAKEFUDA                  */
/*          CREATION . . . . . . 1998/05/20                */
/*          MODIFICATION . . . .                           */
/*                                                         */
/*       ^= : *NE                                          */
/*                                                         */
/*---------------------------------------------------------*/

 PGM   (&FILE &FLIB)

  DCL  &FILE 　　　  *CHAR   10
  DCL  &FLIB   　　  *CHAR   10

  DCL &USRSPC       *CHAR    20   'MBRLIST   QTEMP     '
  DCL &FILLIB       *CHAR    20
  DCL &SIZE         *CHAR     4
  DCL &MBR          *CHAR    10  '*ALL'

  DCL &HEADER       *CHAR    16
  DCL &MBRLDTA      *CHAR   100 .... (1)
  DCL &MBRNAME      *CHAR    10

  DCL &LSTCNT       *DEC     (9 0)
  DCL &WRKCNT       *DEC     (9 0)

  DCL &RTVSTRB      *CHAR     4
  DCL &RTVLENB      *CHAR     4

  DCL &ERR_BYT      *CHAR     4
  DCL &ERR_AVA      *CHAR     4
  DCL &ERR_ID       *CHAR     7
  DCL &ERR_RSV      *CHAR     1
  DCL &ERR_MSG      *CHAR   100
  DCL &ERRDTA       *CHAR   116

  CHGVAR &FILLIB  (&FILE   || &FLIB )

/*--------------------------------------*/
/* CREATE USER SPACE                    */
/*--------------------------------------*/

  CHGVAR %BIN(&SIZE) 1024
      CHKOBJ %SST(&USRSPC 11 10)/%SST(&USRSPC 1 10) *USRSPC
    MONMSG CPF9801 *N +
      CALL QUSCRTUS (&USRSPC 'WRK       ' &SIZE ' ' '*ALL' ' ')

/*--------------------------------------*/
/* MAKE AN ERROR STRUCTURE             */
/*--------------------------------------*/

  CHGVAR %BIN(&ERR_BYT) 116
  CHGVAR %BIN(&ERR_AVA) 0
  CHGVAR &ERRDTA (&ERR_BYT||&ERR_AVA||&ERR_ID||&ERR_RSV||&ERR_MSG)

/*--------------------------------------*/
/* SPREAD DATA BY API                   */
/*--------------------------------------*/

   CALL QUSLMBR (&USRSPC 'MBRL0100' &FILLIB &MBR '0' &ERRDTA)

IF (%BIN(&ERRDTA  5  4) *NE 0) DO
      CHGVAR &ERR_BYT  %SST(&ERRDTA  1    4)
      CHGVAR &ERR_ID   %SST(&ERRDTA  9    7)
      CHGVAR &ERR_MSG  %SST(&ERRDTA 17  100)

      SNDPGMMSG  MSGID(&ERR_ID) MSGF(QCPFMSG) +
                                MSGDTA(&ERR_MSG) MSGTYPE(*ESCAPE)
      MONMSG CPF0000
      GOTO \END
ENDDO

/*--------------------------------------*/
/* RETRIEVE HEADER FROM USER SPACE      */
/*--------------------------------------*/

      CHGVAR %BIN(&RTVSTRB) 125
      CHGVAR %BIN(&RTVLENB) 16

      CALL   QUSRTVUS (&USRSPC &RTVSTRB &RTVLENB &HEADER)

      CHGVAR &LSTCNT %BIN(&HEADER  9  4)
      IF (&LSTCNT = 0 ) GOTO \END

/*--------------------------------------*/
/* PREPARATION OF RETRIEVE LIST DATA    */
/*--------------------------------------*/

      CHGVAR &WRKCNT         0
      CHGVAR %BIN(&RTVSTRB) (%BIN(&HEADER  1  4) + 1)
      CHGVAR &RTVLENB        %SST(&HEADER 13  4)

/*--------------------------------------*/
/* RETRIEVE LIST DATA FORM USER SPACE   */
/*--------------------------------------*/

 \RTVMBRL:

     CHGVAR &WRKCNT  (&WRKCNT + 1)
     CALL   QUSRTVUS (&USRSPC &RTVSTRB &RTVLENB &MBRLDTA)

/*--------------------------------------*/
/* RETRIEVE MBRNAME LIST                */
/*--------------------------------------*/

     CHGVAR &MBRNAME  %SST(&MBRLDTA  1 10) ... (a)
     SNDPGMMSG  MSG(&MBRNAME) ....(1)

/*--------------------------------------*/
/* PREPARATION FOR NEXT LIST ITME       */
/*--------------------------------------*/

 IF (&LSTCNT = &WRKCNT) GOTO \END

     CHGVAR %BIN(&RTVSTRB) (%BIN(&RTVSTRB) + %BIN(&RTVLENB))

 GOTO \RTVMBRL

\END:

     IF (%SST(&USRSPC 11 10)='QTEMP') DO
         DLTUSRSPC %SST(&USRSPC 11 10)/%SST(&USRSPC 1 10)
     ENDDO

RETURN
ENDPGM

AS/400 システム API 解説書上巻バージョン 3 資料番号 SC88-5345-00

8.26.2.4.3 MBRL0100 データ・リスト・セクション

オフセット		タイプ	フィールド
10 進数	16 進数
0	0	CHAR(10)	使用したメンバー名(a)

(1)は予備で取りました。１０バイトでも問題ありません。（V3R1,V4R1)

[ Previous ] [ HOME ] [ Upper ] [ Next ]

You are at K's tips-n-kicks of AS/400

SEO		[PR] 爆速!無料ブログ無料ホームページ開設無料ライブ放送

6.17.DSPFD *MBRLIST のAPI (CLP)

AS/400 システム API 解説書 上巻 バージョン 3 資料番号 SC88-5345-00

AS/400 システム API 解説書上巻バージョン 3 資料番号 SC88-5345-00