curtisflynvv的部落格

2015-06-01 如何取得系統正在執行中的子系統(Active subsystem)？(Retrieve active subsystems with List Active Subsystems (QWCLASBS) API)


pos
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   &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

pos
參照: List Active Subsystems (QWCLASBS) API