|
|
 |
|
Wiki | |
|
updated on 2004.06.23 |
||||
6.16.DSPDBRのAPI(CLP) | |||||||||
|
いきなり、ぽんとソースですが、DSPDBRのAPIです。パラメータで、渡したファイル名とそのライブラリー名から、従属するファイルを取り出します。(1)の部分で可能です。 ※SNDPGMMSGは、内容確認のために行っています。このかわりに、利用したいコマンドを指定してください。 /*---------------------------------------------------------*/ /* 指定ファイル名のDSPDBR BY API */ /* */ /* PROGRAMMER . . . . . KAKEFUDA */ /* CREATION . . . . . . 1998/05/18 */ /* MODIFICATION . . . . */ /* */ /* */ /*---------------------------------------------------------*/ PGM (&FILE &FLIB) DCL &USRSPC *CHAR 20 'DSPDBR QTEMP ' DCL &FILLIB *CHAR 20 DCL &FILE *CHAR 10 DCL &FLIB *CHAR 10 DCL &SIZE *CHAR 4 DCL &MBR *CHAR 10 '*ALL' DCL &RCDFMT *CHAR 10 '*ALL' DCL &HEADER *CHAR 16 DCL &DBRDTA *CHAR 500 ... (3) DCL &LF_NAME *CHAR 10 DCL &LF_LIB *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 ANE 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 QDBLDBR (&USRSPC 'DBRL0100' &FILLIB &MBR &RCDFMT &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) ... (4) /*--------------------------------------*/ /* RETRIEVE LIST DATA FORM USER SPACE */ /*--------------------------------------*/ \RTVDBR: CHGVAR &WRKCNT (&WRKCNT + 1) /* COUNT UP */
CALL QUSRTVUS (&USRSPC &RTVSTRB &RTVLENB &DBRDTA) /*--------------------------------------*/ /* RETRIEVE LF INFORMATION */ /*--------------------------------------*/ CHGVAR &LF_NAME %SST(&DBRDTA 21 10) .... (a) CHGVAR &LF_LIB %SST(&DBRDTA 31 10) .....(b) IF (&LF_NAME='*NONE') GOTO \END SNDPGMMSG MSG(&LF_LIB |< '/' |< &LF_NAME) ....(1) /*--------------------------------------*/ /* PREPARATION FOR NEXT LIST ITME */ /*--------------------------------------*/ IF (&LSTCNT = &WRKCNT) GOTO \END CHGVAR %BIN(&RTVSTRB) (%BIN(&RTVSTRB) + %BIN(&RTVLENB)) GOTO \RTVDBR \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.3.3.2 DBRL0100 形式（ファイル）
注意Ｖ２では、このDBRl0100は全体で40数バイトくらいでした。でも、V3では、全体で320です。これに絡んで、エラーが起きるととすれば、(3)の&DBRDTAのフィールドサイズです。最初、V2のマニュアルを見て、作ってしまい、&DBRDTAを50バイトくらいにしたため、エラーがでまくり、不思議がっていました。DEBUGして、初めて、320バイトに気づき、V3のCD-ROMで、変更されていることに気づきました。ペーパーのマニュアルの方がわかりやすい反面、情報が、激に変更されています。気をつけましょう。尚、V4R1でも、上記の(5)で、&RTVLENBの内容が、320になっているので、V4R1までは問題ありません。
| ||||||||||||||||||||||||||||||||||||||||||||||
|
You are at K's tips-n-kicks of AS/400
|
|
|||
|
|
