如何取得系統正在執行中的子系統(Active subsystem)？(Command RTVACTSBS Retrieve active subsystems with List Active Subsystems (QWCLASBS) API)
File : QCLSRC
Member: RTVACTSBS
Usage : CRTCLPGM PGM(RTVACTSBS)
/*-------------------------------------------------------------------*/
/* */
/* Program . . : RTVACTSBS */
/* Description : Retrieve active subsystems CPP */
/* Author . . : Vengoal Chang */
/* Published . : AS400ePaper */
/* Date . . . : June 1, 2015 */
/* */
/* Program function: Retrieve active subsystems */
/* */
/* */
/* Compile options: */
/* CrtClPgm Pgm( RTVACTSBS ) */
/* SrcFile( QCLSRC ) */
/* SrcMbr( *PGM ) */
/* */
/*-------------------------------------------------------------------*/
Pgm (&RtnSbs &NbrSbs)
Dcl &RtnSbs *char 9800
Dcl &NbrSbs *dec (5 0)
/* API User Space Variables */
Dcl &a_inl *char 1 value( x'00' ) /* Initializer */
Dcl &a_siz *int value( 16384 ) /* Initial size */
Dcl &offslst *int value( 1 ) /* Initial offset */
Dcl &nbrlste *int
Dcl &sizlste *int value( 150 ) /* Init entry sz */
/* General fields... */
Dcl &i *int /* Loop counter */
Dcl &us_hdr *char 150 /* Retrieved Hdr */
Dcl &SBSENT *char 20 /* Retrieved Ent */
Dcl &usrspc *char 10 value( 'ACTSBSD' )
Dcl &usrspclib *char 10 value( 'QTEMP' )
Dcl &qusrspc *char 20
Dcl &sbsd *char 10
Dcl &sbsdlib *char 10 value( '*LIBL' )
Dcl &pos *dec (5 0)
MonMsg ( Cpf0000 Mch0000 ) Exec( Goto Error )
Dltusrspc &usrspclib/&usrspc
MonMsg Cpf0000
/* Create *usrspc for the SBS info APIs... */
/* Active subsystems will be listed into the space. Basic info will be */
/* retrieved from the space header and used to loop through entries... */
/* Set the qualified *usrspc name... */
Chgvar &qusrspc ( &usrspc *cat &usrspclib )
Call QUSCRTUS ( +
&qusrspc +
'ACTSBSD' +
&a_siz +
&a_inl +
'*ALL ' +
'List active SBSDs ' +
'*YES ' +
x'0000000000000000' +
)
/* List the active SBSDs into our *usrspc... */
Call QWCLASBS ( +
&qusrspc +
'SBSL0100' +
x'00000000' +
)
/* Set our loop control from the *usrspc headers... */
Call QUSRTVUS ( +
&qusrspc +
&offslst +
&sizlste +
&us_hdr +
)
/* Get the offset to the list within the space, the number */
/* of list entries and size of each entry from the header. */
Chgvar &offslst %Bin( &us_hdr 125 4 )
Chgvar &nbrlste %Bin( &us_hdr 133 4 )
Chgvar &sizlste %Bin( &us_hdr 137 4 )
/* If no entries, then get out of here... */
If ( &nbrlste *eq 0 ) do
sndpgmmsg msgid( CPF9897 ) msgf( QCPFMSG ) +
msgdta( 'No active subsystems found.' )
goto Return
Enddo
/* Set the offset to the list within the space... */
Chgvar &offslst ( &offslst + 1 )
If (&Nbrlste > 490) Do
SndPgmMsg MsgId(CPF9898) +
MsgF(QCPFMSG) +
MsgDta('More than 490 active subsystems exist') +
MsgType(*Escape)
EndDo
Chgvar &NbrSbs (&Nbrlste)
DoFor &i From( 1 ) To( &Nbrlste )
/* Retrieve a list entry... */
Call QUSRTVUS ( +
&qusrspc +
&offslst +
&sizlste +
&SBSENT +
)
Chgvar &Pos (((&i-1) * 20) + 1)
Chgvar %SST(&RtnSbs &Pos 20) &SBSENT
Chgvar &SBSD %sst( &SBSENT 1 10 )
Chgvar &SBSDLIB %sst( &SBSENT 11 10 )
Chgvar &offslst ( &offslst + &sizlste )
EndDo
Return:
Dltusrspc &usrspclib/&usrspc
Return
/*-- Error processor ------------------------------------------------*/
Error:
Call QMHMOVPM ( ' ' +
'*DIAG' +
x'00000001' +
'*PGMBDY ' +
x'00000001' +
x'0000000800000000' +
)
Call QMHRSNEM ( ' ' +
x'0000000800000000' +
)
EndPgm:
EndPgm
File : QCMDSRC
Member: RTVACTSBS
Usage : CrtCmd Cmd( RtvActSbs )
Pgm( RtvActSbs )
SrcFile( YourSourceFile )
Allow ( *Ipgm *Bpgm )
/* =============================================================== */
/* = Command....... RTVACTSBS = */
/* = CPP........... RTVACTSBS CLP = */
/* = = */
/* = Description... = */
/* = Retrieve active subsystems = */
/* = = */
/* = CrtCmd Cmd( RtvActSbs ) = */
/* = Pgm( RtvActSbs ) = */
/* = SrcFile( YourSourceFile ) = */
/* = Allow ( *Ipgm *Bpgm ) = */
/* =============================================================== */
/* = Date : 2015/06/01 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
Cmd Prompt( 'Retrieve Active Subsystems' )
Parm Kwd( RtnSbs ) +
Type( *Char ) +
Len( 9800 ) +
Rtnval( *Yes ) +
Prompt( 'CL var for RTNSBS (9800) .')
Parm Kwd( NbrSbs ) +
Type( *Dec ) +
Len( 5 0 ) +
Rtnval( *Yes ) +
Prompt( 'CL var for NBRSBS (5 0) .' )
File : QCLSRC
Member: RTVACTSBST
Usage : CrtClPgm Pgm( RTVACTSBS )
SrcFile( YourSourceFile )
Pgm
Dcl &RtnSbs *Char 9800
Dcl &NbrSbs *Dec (5 0)
Dcl &Idx *Dec (5 0)
Dcl &QualSbs *Char 20
Dcl &Sbsd *Char 10
Dcl &SbsdL *Char 10
RtvActSbs RtnSbs(&RtnSbs) NbrSbs(&NbrSbs)
ChgVar &Idx -19
Loop: ChgVar &Idx (&Idx + 20)
If (&Idx *LT 9781) Do /* Within area */
ChgVar &QualSbs %SST(&RtnSbs &Idx 20)
If (&QualSbs *NE ' ') Do /* Active sbs */
ChgVar &SBSD %SST(&QualSbs 1 10)
ChgVar &SBSDL %SST(&QualSbs 11 10)
SndPgmMsg Msgid( CPF9897 ) Msgf( QCPFMSG ) +
MsgDta( 'Found' *bcat &SBSDL *tcat '/' *cat +
&SBSD ) +
ToPgmq( *EXT ) MsgType( *STATUS )
DlyJob (1)
GoTo Loop
EndDo /* Active sbs */
EndDo /* Within area */
DMPCLPGM
EndPgm
參照: List Active Subsystems (QWCLASBS) API
星期四, 11月 09, 2023
2015-06-01 如何取得系統正在執行中的子系統(Active subsystem)？(Command RTVACTSBS with List Active Subsystems (QWCLASBS) API)
星期四, 11月 02, 2023
2002-06-18 如何檢查 Subsystem 及 Job Queue 的狀態？（利用 API "QWDRSBSD" 及 "QSPRJOBQ"）
如何檢查 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
訂閱：
文章 (Atom)