2015-06-01 如何取得系統正在執行中的子系統(Active subsystem)？(Retrieve active subsystems with List Active Subsystems (QWCLASBS) API)
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 &pospos *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
沒有留言:
張貼留言