|
|
 |
|
Wiki | |
|
updated on 2004.06.23 |
||||
6.23 ILEプログラム情報リスト | |||||||||
作成手順1.LSTILEPGMCをコンパイル（LOG(*NO)のほうが実行結果を見やすいです。）2.CRTCMD CMD(XXX/LSTILEPGM) PGM(*LIBL/LSTILEPGMC) SRCFILE(XXX/QCMDSRC) 実行結果
改造のポイント
SNDPGMMSG MSG(&ILE_PGM |< ',' |< &ILE_PGMLIB |< ',' |< +
&ILE_MOD |< ',' |< &ILE_MODLIB |< ',' |< +
&ILE_SRCF |< ',' |< &ILE_SRCFLB |< ',' |< +
&ILE_SRCMBR |< ',' |< &ILE_MODA |< ',' |< +
&ILE_MODCDT |< ',' |< &ILE_SRCUDT )
-------------------------------------------------------------------- コマンド名;LSTILEPGMCMD ('LIST ILE PROGRAM INFORMATION')
PARM KWD(PGM) TYPE(PGM) MIN(1) PROMPT('ILE +
PROGRAM NAME')
PGM: QUAL TYPE(*GENERIC) LEN(10) SPCVAL((*ALL))
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) SPCVAL((*ALL) +
(*ALLUSR) (*CURLIB) (*LIBL) (*USRLIBL)) +
PROMPT('LIBRARY')
-------------------------------------------------------------------- CPP名(CLP); LSTILEPGMCPGM (&PGMLIB)
DCL &USRSPC *CHAR 20 'QBNLPGMI QTEMP '
DCL &PGMLIB *CHAR 20
DCL &SIZE *CHAR 4
DCL &HEADER *CHAR 16
DCL &ILEDTA *CHAR 500
DCL &ILE_PGM *CHAR 10
DCL &ILE_PGMLIB *CHAR 10
DCL &ILE_MOD *CHAR 10
DCL &ILE_MODLIB *CHAR 10
DCL &ILE_SRCF *CHAR 10
DCL &ILE_SRCFLB *CHAR 10
DCL &ILE_SRCMBR *CHAR 10
DCL &ILE_MODA *CHAR 10
DCL &ILE_MODCDT *CHAR 13
DCL &ILE_SRCUDT *CHAR 13
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
/*--------------------------------------*/
/* CREATE USER SPACE */
/*--------------------------------------*/
CHGVAR %BIN(&SIZE) 2048
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 QBNLPGMI (&USRSPC 'PGML0100' &PGMLIB &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 */
/*--------------------------------------*/
RTVILEPGM:
CHGVAR &WRKCNT (&WRKCNT + 1) /* COUNT UP */
CALL QUSRTVUS (&USRSPC &RTVSTRB &RTVLENB &ILEDTA)
/*--------------------------------------*/
/* RETRIEVE LF INFORMATION */
/*--------------------------------------*/
CHGVAR &ILE_PGM %SST(&ILEDTA 1 10)
CHGVAR &ILE_PGMLIB %SST(&ILEDTA 11 10)
CHGVAR &ILE_MOD %SST(&ILEDTA 21 10)
CHGVAR &ILE_SRCF %SST(&ILEDTA 41 10)
CHGVAR &ILE_SRCFLB %SST(&ILEDTA 51 10)
CHGVAR &ILE_SRCMBR %SST(&ILEDTA 61 10)
CHGVAR &ILE_MODA %SST(&ILEDTA 71 10)
CHGVAR &ILE_MODCDT %SST(&ILEDTA 81 13)
CHGVAR &ILE_SRCUDT %SST(&ILEDTA 94 10)
SNDPGMMSG MSG(&ILE_PGM |< ',' |< &ILE_PGMLIB |< ',' |< +
&ILE_MOD |< ',' |< &ILE_MODLIB |< ',' |< +
&ILE_SRCF |< ',' |< &ILE_SRCFLB |< ',' |< +
&ILE_SRCMBR |< ',' |< &ILE_MODA |< ',' |< +
&ILE_MODCDT |< ',' |< &ILE_SRCUDT )
/*--------------------------------------*/
/* PREPARATION FOR NEXT LIST ITME */
/*--------------------------------------*/
IF (&LSTCNT = &WRKCNT) GOTO END
CHGVAR %BIN(&RTVSTRB) (%BIN(&RTVSTRB) + %BIN(&RTVLENB))
GOTO RTVILEPGM
END:
IF (%SST(&USRSPC 11 10)='QTEMP') DO
DLTUSRSPC %SST(&USRSPC 11 10)/%SST(&USRSPC 1 10)
ENDDO
RETURN
ENDPGM
|
|
You are at K's tips-n-kicks of AS/400
|
|
|||
|
|
