|
|
 |
|
Wiki | |
|
updated on 2004.06.23 |
||||
6.17.DSPFD *MBRLIST のAPI (CLP) | |||||||||
|
いきなり、ぽんとソースですが、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-008.26.2.4.3 MBRL0100 データ・リスト・セクション
(1)は予備で取りました。１０バイトでも問題ありません。（V3R1,V4R1)
| ||||||||||
|
You are at K's tips-n-kicks of AS/400
|
|
|||
|
|
