如何擷取某一個子系統(Subsystem)的狀態？(RTVSBSSTS with API QWDRSBSD)
於系統管理上，常會有需要限定某些工作(Job)只能執行於限定的子系統(subsystem)，
如利用工作站名稱分類的子系統，依批次工作分類的批次子系統等等。建立子系統有助
於系統管理及系統效能的提升，然而有時就會需要檢查某一個子系統是否已在系統中執
行？可利用 API QWDRSBSD(Retrieve subsystem information) 來擷取子系統的狀態
及有幾個 job 正在該仔細統中執行等資訊。
File : QCLSRC
Member: RTVSBSSTSC
Type : CLP
Usage : CRTCLPGM RTVSBSSTSC
PGM PARM(&RTVSBS &SBSSTS &JOBCNTC)
DCL VAR(&RTVSBS) TYPE(*CHAR) LEN(20)
DCL VAR(&SBSSTS) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBCNTC) TYPE(*CHAR) LEN(3)
DCL VAR(&RCVDTA) TYPE(*CHAR) LEN(360)
DCL VAR(&RCVLEN) TYPE(*DEC) LEN(3 0) VALUE(360)
DCL VAR(&RCVLENB) TYPE(*CHAR) LEN(4)
DCL VAR(&FMTNAM) TYPE(*CHAR) LEN(8) VALUE('SBSI0100')
DCL VAR(&JOBCNT#) TYPE(*DEC) LEN(3 0)
DCL &ERRCOD *CHAR 8 (X'0000000000000000')
dcl &error *lgl /* std err */
dcl &msgid *char 7 /* std err */
dcl &msgkey *char 4 /* std err */
dcl &msgdta *char 100 /* std err */
dcl &msgf *char 10 /* std err */
dcl &msgflib *char 10 /* std err */
dcl &msgtyp *char 10 '*DIAG' /* std err */
dcl &msgtypctr *char 4 X'00000001' /* std err */
dcl &pgmmsgq *char 10 '*' /* std err */
dcl &stkctr *char 4 X'00000001' /* std err */
dcl &errbytes *char 4 X'00000000' /* std err */
monmsg msgid(cpf0000) exec(goto error)
CHGVAR VAR(%BIN(&RCVLENB)) VALUE(&RCVLEN)
/* RETRIEVE SUBSYSTEM INFORMATION */
CALL PGM(QWDRSBSD) PARM( &RCVDTA +
&RCVLENB +
&FMTNAM +
&RTVSBS +
&ERRCOD )
CHGVAR &SBSSTS %SST(&RCVDTA 29 10)
CHGVAR VAR(&JOBCNT#) VALUE(%BIN(&RCVDTA 73 4))
CHGVAR VAR(&JOBCNTC) VALUE(&JOBCNT#)
/*--------------------------------------------------------*/
/* error routine: */
/*--------------------------------------------------------*/
error:
if &error (goto errordone)
else chgvar &error '1'
/*----------------------------------------------*/
/* move all *DIAG message to *PRV program queue*/
/*----------------------------------------------*/
call QMHMOVPM (&msgkey +
&msgtyp +
&msgtypctr +
&pgmmsgq +
&stkctr +
&errbytes)
/*----------------------------------------------*/
/* resend the last *ESCAPE message */
/*----------------------------------------------*/
errordone:
call QMHRSNEM (&msgkey +
&errbytes)
monmsg cpf0000 exec(do)
sndpgmmsg msgid(cpf3cf2) msgf(QCFPMSG) +
msgdta('QMHRSNEM') msgtype(*escape)
monmsg cpf0000
enddo
end: endpgm
File : QCMDSRC
Member: RTVSBSSTS
Type : CMD
Usage : CRTCMD CMD(RTVSBSSTS) PGM(RTVSBSSTSC) ALLOW(*IPGM *BPGM)
/********************************************************************/
/* Title: RTVSBSSTS: RETRIEVE SUBSYSTEM STATUS */
/* */
/* Description - This command retrieve subsystem satatus */
/* */
/* The Create Command command should include the following: */
/* */
/* CRTCMD CMD(RTVSBSSTS) PGM(RTVSBSSTSC) */
/* RETURN SBSSTS : *ACTIVE OR *INACTIVE */
/* JOBCNT : HOW MANY JOBS CURRENTLY RUNNING IN SUBSYSTEM */
/********************************************************************/
/*------------------------------------------------*/
/* Command Definition */
/*------------------------------------------------*/
CMD PROMPT('Retrieve Subsystem Status')
PARM KWD(SBSD) TYPE(SBSD) MIN(1) +
PROMPT('Subsystem Description')
PARM KWD(SBSSTS) TYPE(*CHAR) LEN(10) RTNVAL(*YES) +
PROMPT('Return Subsystem Status')
PARM KWD(JOBCNT) TYPE(*CHAR) LEN(3) +
RTNVAL(*YES) PROMPT('Return Jobs count in +
Sybsystem')
SBSD: QUAL TYPE(*NAME) LEN(10) MIN(1) EXPR(*YES)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL) (*CURLIB)) EXPR(*YES) +
PROMPT('Library')
File : QCLSRC
Member: RTVSBSSTST
Type : CLP
Usage : CRTCLPGM RTVSBSSTST
測試程式
CALL RTVSBSSTST ('subsystem-name' 'library')
或
CALL RTVSBSSTST ('QINTER' '*LIBL')
PGM PARM(&SBSNAME &SBSLIB)
DCL VAR(&SBSNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&SBSLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&SBSSTS) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBCNTC) TYPE(*CHAR) LEN(3)
DCL VAR(&ERROR) TYPE(*LGL) /* std err */
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) /* std err */
DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4) /* std err */
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(100) /* std err */
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10) /* std err */
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10) /* std err */
DCL VAR(&MSGTYP) TYPE(*CHAR) LEN(10) +
VALUE('*DIAG') /* std err */
DCL VAR(&MSGTYPCTR) TYPE(*CHAR) LEN(4) +
VALUE(X'00000001') /* std err */
DCL VAR(&PGMMSGQ) TYPE(*CHAR) LEN(10) VALUE('*') +
/* std err */
DCL VAR(&STKCTR) TYPE(*CHAR) LEN(4) +
VALUE(X'00000001') /* std err */
DCL VAR(&ERRBYTES) TYPE(*CHAR) LEN(4) +
VALUE(X'00000000') /* std err */
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
RTVSBSSTS SBSD(&SBSLIB/&SBSNAME) SBSSTS(&SBSSTS) +
JOBCNT(&JOBCNTC)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('THE +
NUMBER OF JOBS ACTIVE IN ' || &SBSNAME *BCAT +
'IS ' || &JOBCNTC || ' & THE SBS IS ' || &SBSSTS)
/*--------------------------------------------------------*/
ERROR:
IF COND(&ERROR) THEN(GOTO CMDLBL(ERRORDONE))
ELSE CMD(CHGVAR VAR(&ERROR) VALUE('1'))
/*----------------------------------------------*/
/* move all *DIAG message to *PRV program queue*/
/*----------------------------------------------*/
CALL PGM(QMHMOVPM) PARM(&MSGKEY &MSGTYP +
&MSGTYPCTR &PGMMSGQ &STKCTR &ERRBYTES)
/*----------------------------------------------*/
/* resend the last *ESCAPE message */
/*----------------------------------------------*/
ERRORDONE:
CALL PGM(QMHRSNEM) PARM(&MSGKEY &ERRBYTES)
MONMSG MSGID(CPF0000) EXEC(DO)
SNDPGMMSG MSGID(CPF3CF2) MSGF(QCFPMSG) +
MSGDTA('QMHRSNEM') MSGTYPE(*ESCAPE)
MONMSG MSGID(CPF0000)
ENDDO
END: ENDPGM
星期一, 11月 06, 2023
2003-10-28 如何擷取某一個子系統(Subsystem)的狀態？(RTVSBSSTS with API QWDRSBSD)
訂閱：
張貼留言 (Atom)
沒有留言:
張貼留言