2015-06-01 如何取得系統正在執行中的子系統(Active subsystem)?(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

pos
參照: List Active Subsystems (QWCLASBS) API

pos
arrow
arrow

    puranjandrm0 發表在 痞客邦 留言(0) 人氣()