如何檢查 Subsystem 及 Job Queue 的狀態？（利用 API "QWDRSBSD" 及 "QSPRJOBQ"）
File : QRPGLESRC
Member: CHKSBSJOBQ
Type : RPGLE
Usage : CRTBNDRPG CHKSBSJOBQ
SBMJOB CMD(CALL CHKSBSJOBQ) JOB(CHKSBSJOBQ)
這程式將檢查子系統 QGPL/QBATCH 及 工作佇列 QGPL/QBATCH 狀態,
如果 Subsystem 的狀態不是 ACTIVE 或 JOB Queue 狀態不是 Release，此程式會
發送訊息至 QSYSOPR 訊息佇列，下指令 DSPMSG QSYSOPR 可檢視此程式所指定的子
系統或工作佇列是否正常運作。
下指令 WRKACTJOB 選取工作CHKSBSJOBQ 及輸入選項 4 結束測試工作。
* Purpose: Monitor QGPL/QBATCH Subsystem and if QGPL/QBATCH JOBQ are
* held.
* The program check every 5 seconds and never end.
* SBMJOB CMD(CALL CHKCBCJOBQ) JOB(CHKSBSJOBQ)
* ENDJOB with WRKACTJOB select option 4
*
*
**********************************************************
H DEBUG OPTION(*SRCSTMT:*NODEBUGIO) DFTACTGRP(*NO) ACTGRP(*CALLER)
** Times (in seconds) to pause
d Initial c 3
d Normal c 60
** Use Unix API to pause processing for a while
D sleep PR 10I 0 EXTPROC('sleep')
D seconds 10U 0 VALUE
** Procedure prototypes
D CheckSbs PR N
D Subsystem 10A CONST
D Library 10A CONST
D CheckJobQ PR N
D JobQueue 10A CONST
D Library 10A CONST
D SendMessage PR
D Name 10A CONST
D Type 10A CONST
* API error structure
D APIERR DS
D ERRPRV 10I 0 INZ(272)
D ERRLEN 10I 0
D EXCPID 7A
D RSRVD2 1A
D EXCPDT 256A
D APILEN S 10I 0 INZ(0)
D APIFMT S 8
* API format JOBQ0100: Job queue information
D JOBQ01 DS
D JQINAM 9 18
D JQILIB 19 28
D JQIOPR 29 38
D JQIAUT 39 48
D JQINBR 49 52B 0
D JQISTS 53 62
D JQISBS 63 72
D JQITXT 73 122
* API format SBSI0100: Subsystem information
D SBSI01 DS
D SBINAM 9 18
D SBILIB 19 28
D SBISTS 29 38
D SBIMAX 69 72B 0
D SBIACT 73 76B 0
d Ok s 1n
** Sleep for 5 mins on startup to give the subsystems time to wake up
c CallP Sleep(Initial)
** Loop forever
c DoW 1 = 1
** Check QBATCH first (NB - is QBATCH in QGPL not QSYS)
c Eval Ok = CheckSBS('QBATCH':'QGPL')
c If Not Ok
c CallP SendMessage('QBatch':'Subsystem')
c Else
c Eval Ok = CheckJOBQ('QBATCH':'QGPL')
c If Not Ok
c CallP SendMessage('QBatch':'Job Queue')
c EndIf
c EndIf
** Check QEOM next
c Eval Ok = CheckSBS('QEOM':'QSYS')
c If Not Ok
c CallP SendMessage('QEOM':'Subsystem')
c Else
c Eval Ok = CheckJOBQ('QEOM':'QSYS')
c If Not Ok
c CallP SendMessage('QEOM':'Job Queue')
c EndIf
c EndIf
c CallP Sleep(Normal)
c EndDo
c Seton Lr
** ----------------------------------------------------------
** CheckSbs - Check susbsystem is up
P CheckSbs B
D CheckSbs PI N
D Subsystem 10A CONST
D Library 10A CONST
c Eval SbsiNm = Subsystem + Library
C RESET APIERR
C CALL 'QWDRSBSD'
C PARM SBSI01
C PARM 76 APILEN
C PARM 'SBSI0100' APIFMT
C PARM SBSINM 20
C PARM APIERR
c If SbiSts = '*ACTIVE'
C RETURN *On
C Else
C Return *Off
C EndIf
P CheckSbs E
** ----------------------------------------------------------
** CheckJobQ - Check Job queue is released
P CheckJobQ B
D CheckJobQ PI N
D JobQueue 10A CONST
D Library 10A CONST
c Eval JobQNm = JobQueue + Library
C RESET APIERR
C CALL 'QSPRJOBQ'
C PARM JOBQ01
C PARM 122 APILEN
C PARM 'JOBQ0100' APIFMT
C PARM JOBQNM 20
C PARM APIERR
c If JqISts = 'RELEASED'
C RETURN *On
C Else
C Return *Off
C EndIf
P CheckJobQ E
** ----------------------------------------------------------
** SendMessage - Send message to QSysOpr
P SendMessage B
D SendMessage PI
D Name 10A CONST
D Type 10A CONST
D mh_msgid s 7 Inz('CPF9898')
D mh_msgfile s 20 inz('QCPFMSG QSYS')
D mh_msgdta s 256 inz(*blanks)
D mh_msgdtalen s 9b 0
D mh_msgtype s 10 Inz('*INQ')
D mh_msgq s 20 inz('*SYSOPR')
D mh_msgq# s 9b 0 inz(1)
D mh_replymsgq s 20 inz('QSYSOPR *LIBL')
D mh_msgkey s 4
c If Type = 'Subsystem'
c Eval Mh_MsgDta = '!!Warning - ' +
c %TrimR(Type) + ' ' +
c %TrimR(Name) + ' is not running'
c Else
c Eval Mh_MsgDta = '!!Warning - ' +
c %TrimR(Type) + ' ' +
c %TrimR(Name) + ' is HELD.'
c EndIf
C Eval mh_msgdtalen = %Len(%TrimR(Mh_MsgDta))
C Call 'QMHSNDM'
C parm mh_msgid
C parm mh_msgfile
C parm mh_msgdta
C parm mh_msgdtalen
C parm mh_msgtype
C parm mh_msgq
C parm mh_msgq#
C parm mh_replymsgq
C parm mh_msgkey
C parm ApiErr
C RETURN
P SendMessage E
星期四, 11月 02, 2023
2002-06-18 如何檢查 Subsystem 及 Job Queue 的狀態？（利用 API "QWDRSBSD" 及 "QSPRJOBQ"）
訂閱：
張貼留言 (Atom)
沒有留言:
張貼留言