List system objects using QUSLOBJ

[jamief]

Simple example of creating a list of system objects...
This example lists outqueues on the system.

   H Option(*SrcStmt: *NoDebugIO) DftActGRP(*No)                                                  
      *                                                                                             
      *  Field Definitions.                                                                         
      * ~~~~~~~~~~~~~~~~~~~~~~~~                                                                    
     D ObjNam          s             10a                                                            
     D ObjLib          s             10a                                                            
     D ObjTyp          s             10a                                                            
     **-- Api error data structure:  ----------------------------------                             
     D ApiError        Ds                                                                           
     D  AeBytPro                     10i 0 Inz( %Size( ApiError ))                                  
     D  AeBytAvl                     10i 0 Inz                                                      
     D  AeMsgId                       7a                                                            
     D                                1a                                                            
     D  AeMsgDta                    128a                                                            
     **-- Object description structure OBJD0200:  ---------------------                             
     D RoData          Ds                                                                           
     D  RoBytRtn                     10i 0                                                          
     D  RoBytAvl                     10i 0                                                          
     D  RoObjNam                     10a                                                            
     D  RoObjLib                     10a                                                            
     D  RoObjTypRt                   10a                                                            
     D  RoObjLibRt                   10a                                                            
     D  RoObjASP                     10i 0                                                          
     D  RoObjOwn                     10a                                                            
     D  RoObjDmn                      2a                                                            
     D  RoObjCrtDts                  13a                                                            
     D  RoObjChgDts                  13a                                                            
     D  RoExtAtr                     10a                                                            
     D  RoTxtDsc                     50a                                                            
     D  RoSrcF                       10a                                                            
     D  RoSrcLib                     10a                                                            
     D  RoSrcMbr                     10a                                                            
                                                                                                    
     dTheData          DS                                                                           
     d QUSBR05                       10i 0                                                          
     d QUSBA05                       10i 0                                                          
     d QUSJN08                       10                                                             
     d QUSUN07                       10                                                             
     d QUSJNBR07                     06                                                             
     d QUSIJID05                     16                                                             
     d QUSJS14                       10                                                             
     d QUSJT08                       01                                                             
     d QUSJS15                       01                                                             
     d QUSJS16                       08                                                             
     d QUSES00                       01                                                             
     d QUSSN00                       10                                                             
     d QUSSL06                       10                                                             
     d QUSCUN                        10                                                             
     d QUSDE                         01                                                             
     d QUSEK                         01                                                             
     d QUSCK00                       01                                                             
     d QUSPRC                        10i 0                                                          
     d QUSURC                        10i 0                                                          
     d QUSPGMRC                      10i 0                                                          
     d QUSSE02                       10                                                             
     d QUSDN                         10                                                             
     d QUSGPN                        10                                                             
     d QUSGRP                        10    DIM(00015)                                               
     d  QUSGN00                      10    OVERLAY(QUSGRP:00001)                                    
     d QUSJUID                       10                                                             
     d QUSJUIDS                      01                                                             
      *                                                                                             
      *  Field Definitions.                                                                         
      *                                                                                             
     d AllText         s             10    Inz('*ALL')                                              
     d CmdString       s            256                                                             
     d CmdLength       s             15  5                                                          
     d Count           s              4  0                                                          
     d Format          s              8                                                             
     d GenLen          s              8                                                             
     d InLibrary       s             10                                                             
     d InType          s             10                                                             
     d ObjectLib       s             20                                                             
     d SpaceVal        s              1    inz(*BLANKS)                                             
     d SpaceAuth       s             10    inz('*CHANGE')                                           
     d SpaceText       s             50    inz(*BLANKS)                                             
     d SpaceRepl       s             10    inz('*YES')                                              
     d SpaceAttr       s             10    inz(*BLANKS)                                             
     d UserSpaceOut    s             20                                                             
     d Worktype        s             10    inz('*OUTQ')                                             
      *                                                                                            ?
      * GenHdr                                                                                     ?
      *                                                                                            ?
     d GenHdr          ds                  inz                                                      
     d  OffSet                       10i 0                                                          
     d  OffSet2                      10i 0                                                          
     d  NumEnt                       10i 0                                                          
     d  Lstsiz                       10i 0                                                          
      *                                                                                            ?
      *  Data structures                                                                           ?
      *                                                                                            ?
     d GENDS           ds                                                                           
     d  OffsetHdr                    10i 0                                                          
     d  OffsetHdr2                   10i 0                                                          
     d  NbrInList                    10i 0                                                          
     d  SizeEntry                    10i 0                                                          
      *                                                                                             
     d HeaderDs        ds                                                                           
     d  OutFileNam                   10                                                             
     d  OutLibName                   10                                                             
     d  OutType                      05                                                             
     d  Outfiller                    05                                                             
     d  OutFormat                    10                                                             
     d  RecordLen                    10i 0                                                          
      *                                                                                             
      * API Error Data Structure                                                                    
      *                                                                                             
     d ErrorDs         DS                  INZ                                                      
     d  BytesPrv                     10i 0                                                          
     d  BytesAvl                     10i 0                                                          
     d  MessageId                    07                                                             
     d  ERR###                       01                                                             
     d  MessageDta                   99                                                             
      *                                                                                             
     d                 DS                                                                           
     d  StartPosit                   10i 0                                                          
     d  StartLen                     10i 0                                                          
     d  SpaceLen                     10i 0                                                          
     d  ReceiveLen                   10i 0                                                          
     d  MessageKey                   10i 0                                                          
     d  MsgDtaLen                    10i 0                                                          
     d  MsgQueNbr                    10i 0                                                          
      *                                                                                             
      * Date structure for retriving userspace info                                                 
      *                                                                                             
     d InputDs         DS                                                                           
     d  UserSpace              1     20                                                             
     d  SpaceName              1     10                                                             
     d  SpaceLib              11     20                                                             
     d  InpFileLib            29     48                                                             
     d  InpFFilNam            29     38                                                             
     d  InpFFilLib            39     48                                                             
     d  InpRcdFmt             49     58                                                             
      *                                                                                             
     d ObjectDs        ds                                                                           
     d  Object                       10                                                             
     d  Library                      10                                                             
     d  ObjectType                   10                                                             
     d  InfoStatus                    1                                                             
     d  ExtObjAttrib                 10                                                             
     d  Description                  50                                                             
                                                                                                    
     **-- Retrieve object description:  -------------------------------                             
     d RtvObjD         Pr                  ExtPgm( 'QUSROBJD' )                                     
     d  RoRcvVar                  32767a         Options( *VarSize )                                
     d  RoRcvVarLen                  10i 0 Const                                                    
     d  RoFmtNam                      8a   Const                                                    
     d  RoObjNamQ                    20a   Const                                                    
     d  RoObjTyp                     10a   Const                                                    
     d  RoError                   32767a         Options( *VarSize )                                
     **-- List objects:   ---------------------------------------------                             
     d $ListObjects    Pr                  ExtPgm( 'QUSLOBJ' )                                      
     d  userspace                    20a   Const                                                    
     d  format                        8a   Const                                                    
     d  objectlib                    20a   Const                                                    
     d  type                         10a   Const                                                    
     **-- Userspace pointer: ------------------------------------------                             
     d $Userspace      Pr                  ExtPgm( 'QUSRTVUS' )                                     
     d  userspace                    20a   Const                                                    
     d  start                        10i 0 Const                                                    
     d  Length                       10i 0 Const                                                    
     d  Returned                  32767a         Options( *VarSize )                                
     **-- Create Space:   ---------------------------------------------                             
     d $CreateSpace    Pr                  ExtPgm( 'QUSCRTUS' )                                     
     d  UserSpaceOut                 20a   Const                                                    
     d  SpaceAttr                    10    Const                                                    
     d  SpaceLen                     10i 0 Const                                                    
     d  SpaceVal                      1a   Const                                                    
     d  SpaceAuth                    10a   Const                                                    
     d  SpaceText                    50a   Const                                                    
     d  SpaceRepl                    10a   Const                                                    
     d  ErrorDs                   32767a         Options( *VarSize )                                
                                                                                                    
      /free                                                                                         
                 exsr $QUSCRTUS;                                                                    
                 ObjectLib =  '*ALL      ' + '*LIBL';                                               
         //                                                                                         
         // List all the outqueues to the user space                                                
         //                                                                                         
                 Format = 'OBJL0200';                                                               
                 $ListObjects( Userspace : Format : ObjectLib : WorkType);                          
         //                                                                                         
         // Retrive header entry and process the user space                                         
         //                                                                                         
                 StartPosit = 125;                                                                  
                 StartLen   = 16;                                                                   
                 $UserSpace( Userspace : StartPosit : StartLen : GENDS);                            
                                                                                                    
                 StartPosit = OffsetHdr + 1;                                                        
                 StartLen = %size(ObjectDS);                                                        
         //                                                                                         
         // Do for number of outqueues in the userspace                            ?                
         //                                                                                         
                                                                                                    
B1               for count = 1 to  NbrInList;                                                       
                  $UserSpace( Userspace : StartPosit : StartLen : ObjectDs);                        
                  StartPosit += SizeEntry;                                                          
                 endfor;                                                                            
                 *INLR = *On;                                                                       
                                                                                                    
        //--------------------------------------------------------                                  
        // $QUSCRTUS - create userspace                                                             
        //--------------------------------------------------------                                  
                 begsr $QUSCRTUS;                                                                   
                                                                                                    
                  BytesPrv = 116;                                                                   
                  Spacename = 'LISTOUTQS';                                                          
                  SpaceLib = 'QTEMP';                                                               
                                                                                                    
               //                                                                                   
               // Create the user space                                                             
               //                                                                                   
                  $CreateSpace( Userspace : SpaceAttr : 4096 :                                      
                                SpaceVal : SpaceAuth : SpaceText : SpaceRepl:                       
                                ErrorDs);                                                           
                 endsr;                                                                             
      /End-Free 

[tomholden]

Re: List system objects using QUSLOBJ

i prefer to use the Open List of Objects (QGYOLOBJ) API that way you don't have to worry about ever hitting the 16MB user space limitation...

[MichaelCatalani]

Re: List system objects using QUSLOBJ

i prefer to use the Open List of Objects (QGYOLOBJ) API that way you don't have to worry about ever hitting the 16MB user space limitation...

Dayam! That would be a lot of outq's!

[tomholden]

Re: List system objects using QUSLOBJ

Dayam! That would be a lot of outq's!

we have 567 outqs (i didn't set this garbage up i inherited it ). plus that code could be changed to list any other type of object. so...imo it's better to use the open list APIs.

[jamief]

Re: List system objects using QUSLOBJ

Tommy --- post a sample with QGYOLOBJ. (please)

Jamie

[tomholden]

Re: List system objects using QUSLOBJ

Tommy --- post a sample with QGYOLOBJ. (please)

Jamie

when i get a chance, etc maybe i will...

[jamief]

Re: List system objects using QUSLOBJ

you have and will always be, my hero

[K2r400]

Re: List system objects using QUSLOBJ

      /TITLE ObjLst - Procedures to work with object lists.
      **********************************************************************************************
      * Copyright (C) 2001  David M. Morris                                                        *
      * This file is part of the iSeries-toolkit                                                   *
      * The iSeries-toolkit is free software; you can redistribute it and/or                       *
      * modify it under the terms of the GNU General Public License version 2,                     *
      * as published by the Free Software Foundation.                                              *
      * The iseries toolkit is distributed in the hope that it will be useful,                     *
      * but WITHOUT ANY WARRANTY; without even the implied warranty of                             *
      * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                                       *
      * See the GNU General Public License for more details.                                       *
      *                                                                                            *
      * You should have received a copy of the GNU General Public License                          *
      * along with this file; if not, write to the Free Software Foundation,                       *
      * Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.                             *
      * You might find a version at http://www.gnu.org/licenses/gpl.txt                            *
      *                                                                                            *
      * Module  - ObjLst                                                                           *
      * Purpose - Procedures to work with object lists.                                            *
      **********************************************************************************************
     H COPYRIGHT('+
     H Copyright (C) 2001  David M. Morris +
     H This module is part of the iSeries-toolkit and is free software; you +
     H can redistribute it and/or modify it under the terms of the GNU General +
     H Public License version 2 as published by the Free Software Foundation.')
     H NoMain
      /COPY QPROTOSRC,CEEDOD
      /COPY QPROTOSRC,CEETstA
      /COPY QPROTOSRC,MsgTkt
      /COPY QPROTOSRC,ObjLst
      *********************************
      * Open List of Objects API call *
      *********************************
     DAPIQGYOLObj      PR                  EXTPGM('QGY/QGYOLOBJ')               List objects.
     D PR_ObjLst                  32767A   OPTIONS(*VARSIZE)                    Object list.
     D PR_ObjLstSiz                  10I 0 CONST                                Available size.
     D PR_LstInf                     80A                                        List information.
     D PR_RtnObjCnt                  10I 0 CONST                                Return object count.
     D PR_SrtInf                   1024A   CONST OPTIONS(*VARSIZE)              Sort object info.
     D PR_ObjLib                     20A   CONST                                Object & Library.
     D PR_ObjTyp                     10A   CONST                                Object type.
     D PR_AutCtl                    256A   CONST OPTIONS(*VARSIZE)              Authority control.
     D PR_SelCtl                    128A   CONST OPTIONS(*VARSIZE)              Selection control.
     D PR_RtnFldCnt                  10I 0 CONST                                Return field count.
     D PR_RtnFldKey                  10I 0 CONST DIM(64) OPTIONS(*VARSIZE)      Return field keys.
     D PR_APIErr                           LIKE(APIERR) OPTIONS(*VARSIZE)       Error structure.
      *************************
      * Key information table *
      *************************
     DKeyArr           S              4A   CTDATA DIM(47)
     DKeyTypLenArr     S              4A   DIM(47) ALT(KeyArr)
     DKeyTypLenDS      DS
     D KeyTyp                         1A
     D KeyLen                         3S 0

      /COPY QRPGLESRC,APIErrDef
      /COPY QSYSINC/QRPGLESRC,QGYOLOBJ

      /TITLE OpnObjLst - Open an object list.
      **********************************************************************************************
      * *ObjObjLst     Open an object list.                                                        *
      **********************************************************************************************
     POpnObjLst        B                   EXPORT
     DOpnObjLst        PI                  LIKE(LstInf) OPDESC                  Return error flag.
     D ObjLst                     32767A   OPTIONS(*VARSIZE)                    Return information.
     D FldKey                        10I 0 CONST DIM(64) OPTIONS(*VARSIZE)      Field keys.
     D FldCnt                        10I 0 CONST                                Field count.
     D Obj                           10A   CONST                                Object.
     D OptLib                        10A   CONST OPTIONS(*OMIT)                 Object Library.
     D RtnObjCnt                     10I 0 CONST                                Objects to return.
     D OptObjTyp                     10A   CONST OPTIONS(*OMIT :*NOPASS)        Object type.
     D OptSrtKey                     10I 0 CONST DIM(8) OPTIONS(*OMIT :*NOPASS) Sort on field keys.
     D OptSrtKeyCnt                  10I 0 CONST OPTIONS(*OMIT :*NOPASS)        Sort field count.
     D OptSts                         1A   CONST DIM(5) OPTIONS(*OMIT :*NOPASS) Select statuses.
     D OptStsSO                        N   CONST OPTIONS(*OMIT :*NOPASS)        Select or Omit.
     D OptStsCnt                     10I 0 CONST OPTIONS(*NOPASS)               Select status count.
      *******************************
      * Define local work variables *
      *******************************
     DErr              S               N   INZ(*OFF)
     DRem              S              5U 0                                      Remainder.
     DChrFldKey        S                   LIKE(KeyArr)                         Character key value.
     DSI               S              5U 0                                      Sort index.
     DFKI              S              5U 0                                      Field key index.
     DFI               S              5U 0                                      Field array index.
     DKI               S              5U 0                                      Key attributes idx.
      *************************
      * Define API Parameters *
      *************************
     DObjLstSiz        S             10I 0                                      Object list size.
     DObjLib           S             20A                                        Qualified name.
     DObjTyp           S                   LIKE(OptObjTyp) INZ('*ALL')          Object type.
      ******************************************************************
      * Definition for the Sort Information Format including bug fixes *
      ******************************************************************
     DSrtInf           DS
     D SICnt                               LIKE(QGYNBRK) INZ(*ZEROS)            Key count.
     D SIKeyInf                      12A                 DIM(8)                 Key information.
     D*                                    LIKE(QGYOSKI)
     D  SIKIPos                            LIKE(QGYFSP)  OVERLAY(SIKeyInf)      Start position.
V4R3 D  SIKILen                            LIKE(QGYFL02) OVERLAY(SIKeyInf:5)    Key length.
V4R4 D* SIKILen                            LIKE(QGYFL02) OVERLAY(SIKeyInf:*NEXT)Key length.
V4R3 D  SIKITyp                       5I 0               OVERLAY(SIKeyInf:9)    Field type.
V4R4 D* SIKITyp                       5I 0               OVERLAY(SIKeyInf:*NEXT)Field type.
     D*                                    LIKE(QGYFDT)  Invalid size.
V4R3 D  SIKIOrd                            LIKE(QGYSO)   OVERLAY(SIKeyInf:11)   Sort order.
V4R4 D* SIKIOrd                            LIKE(QGYSO)   OVERLAY(SIKeyInf:*NEXT)Sort order.
     D  SIKIReserved                       LIKE(QGYERVED02)                     Reserved.
V4R3 D                                     OVERLAY(SIKeyInf:12)    INZ(*LOVAL)
V4R4 D*                                    OVERLAY(SIKeyInf:*NEXT) INZ(*LOVAL)
      ******************
      * Field key info *
      ******************
     DFldDS            DS                                                       Expanded fields.
     D FldArr                         9A   DIM(64)
     D Fld                                 LIKE(KeyArr) OVERLAY(FldArr)
V4R3 D Typ                            1A   OVERLAY(FldArr: 5)
V4R3 D Len                            5U 0 OVERLAY(FldArr: 6)
V4R3 D Pos                            5U 0 OVERLAY(FldArr: 8)
V4R4 D*Typ                            1A   OVERLAY(FldArr: *NEXT)
V4R4 D*Len                            5U 0 OVERLAY(FldArr: *NEXT)
V4R4 D*Pos                            5U 0 OVERLAY(FldArr: *NEXT)
      *******************************
      * Authority control structure *
      *******************************
     DAutCtl           DS
     D ACSiz                               LIKE(QGYFL04)     INZ(%SIZE(AutCtl)) Auth control size.
     D ACLvl                               LIKE(QGYCL)       INZ(*ZEROS)        Call level.
     D ACObjOff                            LIKE(QGYOAO)      INZ(28)            Object auth offset.
     D ACObjCnt                            LIKE(QGYNbrOA)    INZ(1)             Object auth count.
     D ACLibOff                            LIKE(QGYLAO)      INZ(128)           Library auth offset.
     D ACLibCnt                            LIKE(QGYNbrLA)    INZ(1)             Library auth count.
     D Reserved03                          LIKE(QGYerved04)  INZ(*ZEROS)        Reserved.
     D ACObjAut                      10A   DIM(10)                              Object authorities.
     D  ACObjAutInz                        LIKE(ACObjAut)
     D                                     OVERLAY(ACObjAut) INZ('*ANY      ')
     D ACLibAut                      10A   DIM(10)                              LIbrary authorities.
     D  ACLibAutInz                        LIKE(ACLibAut)
     D                                     OVERLAY(ACLibAut) INZ('*USE      ')
      *******************************
      * Selection control structure *
      *******************************
     DSelCtl           DS
     D SCSiz                               LIKE(QGYFL05)    INZ(%SIZE(SelCtl))  Status control size.
     D SCStsSO                             LIKE(QGYSOOS)    INZ(*ZEROS)         0=Select or 1=omit.
     D SCStsOff                            LIKE(QGYSO01)    INZ(20)             Status offset.
     D SCStsCnt                            LIKE(QGYNbrS)    INZ(1)              Status count.
     D Reserved04                          LIKE(QGYerved05) INZ(*ZEROS)         Reserved.
     D SCSts                          1A   DIM(5)                               Sts */ /A/D/L/P.
     D SCStsInz                            LIKE(ScSts)
     D                                     OVERLAY(SCSts)   INZ('*')
      ******************************
      * Define fixed key constants *
      ******************************
     DFixKeyLen        C                   CONST(52)
     C                   EXSR      SubSetPrm                                    Set API parms.
     C*
     C                   IF        Err
     C                   CLEAR                   LstInf
     C                   EVAL      LISts       = '3'                            Error
     C                   ELSE
     C                   CALLP     APIQGYOLObj(
     C                               ObjLst:
     C                               ObjLstSiz:
     C                               LstInf:
     C                               RtnObjCnt:
     C                               SrtInf:
     C                               ObjLib:
     C                               ObjTyp:
     C                               AutCtl:
     C                               SelCtl:
     C                               FldCnt:
     C                               FldKey:
     C                               APIErr)
     C                   IF        *ON         = SndAPIErr(APIErr)
     C                   EVAL      LISts       = '3'                            Error
     C                   ENDIF                                                  *ON=SndAPIErr
     C                   ENDIF                                                  NOT Err
     C*
     C                   RETURN    LstInf
      /SPACE 3
     C**************************************************************************
     C* *SubSetPrm - Set parameters for API call.                              *
     C**************************************************************************
     C     SubSetPrm     BEGSR
     C                   CALLP     CEEDOD(
     C                               1:
     C                               DscTyp:
     C                               DtaTyp:
     C                               DscInf1:
     C                               DscInf2:
     C                               ObjLstSiz:
     C                               *OMIT)
     C*
     C* Optional library
     C                   CALLP     CEETstA(ArgPas :5 :*OMIT)                    Omitted?
     C*
     C                   SELECT
     C                   WHEN      ArgPas      = 1                              No.
     C                   EVAL      ObjLib      = Obj + OptLib
     C                   WHEN      RtnObjCnt   = -1                             Synchronous list.
     C                   EVAL      ObjLib      = Obj + '*LIBL'
     C                   OTHER
     C                   EVAL      Err         = *ON
     C                   CALLP     SndMsg(
     C                               *OMIT:
     C                               'A library must be specified when +
     C                                 building a list asyncronously')
     C                   ENDSL
     C*
     C* Optional object type
     C                   IF        %PARMS     >= 7
     C                   CALLP     CEETstA(ArgPas :7 :*OMIT)                    Omitted?
     C                   IF        ArgPas      = 1                              No.
     C                   EVAL      ObjTyp      = OptObjTyp
     C                   ENDIF                                                  ArgPas=1
     C*
     C* Optional sort key.
     C                   IF        %PARMS     >= 9
     C                   CALLP     CEETstA(ArgPas :8 :*OMIT)                    Omitted?
     C                   IF        ArgPas      = 1                              No.
     C                   CALLP     CEETstA(ArgPas :9 :*OMIT)                    Omitted?
     C                   IF        ArgPas      = 1                              No.
     C                   EVAL      SICnt       = OptSrtKeyCnt
     C* Convert keys to character and extract component parts of high level keys.
     C                   DO        FldCnt        FKI
     C     FldKey(FKI)   DIV       100           Rem
     C                   MVR                     Rem
     C* High level key 200/300, etc.
     C                   IF        Rem         = *ZEROS
     C                   EVAL      KI          = 1
     C                   DOW       KI         <= %ELEM(KeyArr) AND
V4R3 C                             KeyArr(KI)  < %TRIML(
V4R3 C                                             %EDITW(
V4R3 C                                               FldKey(FKI) + 100:
V4R3 C                                               '     0    '))
V4R4 C*                            KeyArr(KI)  < '0' + %CHAR(FldKey(FKI) + 100)
     C                   EVAL      KeyTypLenDS = KeyTypLenArr(KI)               Extract fields.
     C*
     C                   EVAL      FI          = FI + 1
     C                   EVAL      Fld(FI)     = KeyArr(KI)
     C                   EVAL      Typ(FI)     = KeyTyp
     C                   EVAL      Len(FI)     = KeyLen
     C* Set start position.
     C                   IF        FI          = 1
     C                   EVAL      Pos(FI)     = 1
     C                   ELSE
     C                   EVAL      Pos(FI)     = Pos(FI - 1) + Len(FI - 1)
     C                   ENDIF
     C*
     C                   EVAL      KI          = KI + 1
     C                   ENDDO
     C* Low level key 201/202, etc.
     C                   ELSE
     C                   EVAL      KI          = 1
V4R3 C                   EVAL      ChrFldKey   = %TRIML(
V4R3 C                                             %EDITW(
V4R3 C                                               FldKey(FKI):
V4R3 C                                               '     0    '))
V4R4 C*                  EVAL      ChrFldKey   = '0' + %CHAR(FldKey(FKI))
     C     ChrFldKey     LOOKUP    KeyArr(KI)                             01
     C                   IF        NOT *IN01
     C                   EVAL      Err         = *ON
     C                   CALLP     SndMsg(
     C                               *OMIT:
     C                               'Invalid field key ' + ChrFldKey +
     C                                 ' specified.')
     C                   ELSE
     C                   EVAL      FI          = FI + 1
     C                   EVAL      Fld(FI)     = KeyArr(KI)
     C                   EVAL      KeyTypLenDS = KeyTypLenArr(KI)
     C                   EVAL      Typ(FI)     = KeyTyp
     C                   EVAL      Len(FI)     = KeyLen
     C* Set start position.
     C                   IF        FI          = 1
     C                   EVAL      Pos(FI)     = 1
     C                   ELSE
     C                   EVAL      Pos(FI)     = Pos(FI - 1) + Len(FI - 1)
     C                   ENDIF
     C                   ENDIF                                                  NOT *IN01
     C                   ENDIF                                                  Rem=*ZEROS
     C                   ENDDO
     C*
     c* Set sort information structure using sort keys passed.
     C                   DO        SICnt         SI
V4R3 C                   EVAL      ChrFldKey   = %TRIML(
V4R3 C                                             %EDITW(
V4R3 C                                               OptSrtKey(SI):
V4R3 C                                               '     0    '))
V4R4 C*                  EVAL      ChrFldKey   = '0' + %CHAR(OptSrtKey(SI))
     C*
     C                   SELECT
     C                   WHEN      ChrFldKey   = '0101'                         Object.
     C                   EVAL      SIKIPos(SI) = 1
     C                   EVAL      SIKILen(SI) = 10
     C                   EVAL      SIKITyp(SI) = 4                              Char Nat Lang.
     C                   EVAL      SIKIOrd(SI) = '1'                            Ascending
     C                   WHEN      ChrFldKey   = '0102'                         Library.
     C                   EVAL      SIKIPos(SI) = 11
     C                   EVAL      SIKILen(SI) = 10
     C                   EVAL      SIKITyp(SI) = 4                              Char Nat Lang.
     C                   EVAL      SIKIOrd(SI) = '1'                            Ascending
     C                   WHEN      ChrFldKey   = '0103'                         Object type.
     C                   EVAL      SIKIPos(SI) = 21
     C                   EVAL      SIKILen(SI) = 10
     C                   EVAL      SIKITyp(SI) = 4                              Char Nat Lang.
     C                   EVAL      SIKIOrd(SI) = '1'                            Ascending
     C* Key in variable part of list.
     C                   OTHER
     C                   EVAL      FI          = 1
     C     ChrFldKey     LOOKUP    Fld(FI)                                01
     C                   IF        NOT *IN01
     C                   EVAL      Err         = *ON
     C                   CALLP     SndMsg(
     C                               *OMIT:
     C                               'Invalid sort field key ' + ChrFldKey +
     C                                 ' specified.')
     C                   ELSE
     C                   EVAL      SIKIPos(SI) = Pos(FI) + FixKeyLen
     C                   EVAL      SIKILen(SI) = Len(FI)
     C* Set sort field type for QLGSORT API.
     C                   SELECT
     C                   WHEN      Typ(FI)     = 'A'
     C                   EVAL      SIKITyp(SI) = 4                              Char Nat Lang.
     C                   WHEN      Typ(FI)     = 'I'
     C                   EVAL      SIKITyp(SI) = *ZEROS                         Signed binary.
     C                   ENDSL
     C                   EVAL      SIKIOrd(SI) = '1'                            Ascending
     C                   ENDIF                                                  NOT *IN01
     C                   ENDSL
     C                   ENDDO
     C                   ENDIF                                                  ArgPas=1
     C                   ENDIF                                                  ArgPas=1
     C*
     C* Optional status.
     C                   IF        %PARMS     >= 12
     C                   CALLP     CEETstA(ArgPas :10 :*OMIT)                   Omitted?
     C                   IF        ArgPas      = 1                              No.
     C                   CALLP     CEETstA(ArgPas :11 :*OMIT)                   Omitted?
     C                   IF        ArgPas      = 1                              No.
     C                   EVAL      SCSts       = OptSts
     C                   IF        NOT OptStsSO
     C                   EVAL      SCStsSO     = 1                              Omit statuses.
     C                   ENDIF                                                  NOT OptSCStsSO
     C                   EVAL      SCStsCnt    = OptStsCnt
     C                   ENDIF                                                  ArgPas=1
     C                   ENDIF                                                  ArgPas=1
     C                   ENDIF                                                  %PARMS>=12
     C                   ENDIF                                                  %PARMS>=9
     C                   ENDIF                                                  %PARMS>=7
     C                   ENDSR
     POpnObjLst        E
**CTDATA KeyArr
0201A001
0202A010
0203A050
0204A010
0301I004
0302A010
0303A002
0304A008
0305A008
0306A010
0307A001
0308A001
0309A001
0310A010
0401A010
0402A010
0403A010
0404A013
0405A010
0406A008
0407A009
0408A016
0409A008
0410A001
0411A016
0412A010
0413A010
0414A010
0501A008
0502A008
0503I004
0504I004
0505I004
0506A010
0507A071
0508A010
0509A010
0510A010
0511A017
0512A008
0601A008
0602A008
0603I004
0604A001
0701I004
0702I004
0703A001

[jamief]

Re: List system objects using QUSLOBJ

Thanks Patrick,

I think I need a bunch more objects to make this monster run...
(bunch of copybooks)

I found this one out there, Ill hit it with a stick for a while tonight

     **
     **  Program . . : CBX102
     **  Description : Finds interactive CPU hogs and notifies caller
     **  Author  . . : Carsten Flensburg
     **  Published . : Club Tech iSeries Programming Tips Newsletter
     **  Date  . . . : June 19, 2003
     **
     **
     **  Program summary
     **  ---------------
     **
     **  Work management APIs:
     **    QGYOLJOB      Open list of jobs     Lists jobs on the system based on
     **                                        the specified selection criteria.
     **
     **                                        Optionally a sort order for the
     **                                        returned jobs can be specified -
     **                                        in this case the processor unit
     **                                        time percentage in descending
     **                                        order - listing the jobs having
     **                                        the highest CPU usage first.
     **
     **                                        The CPU processor time is measured
     **                                        for an interval of 10 seconds in
     **                                        this example.
     **
     **                                        The QGYOLJOB API is found in the
     **                                        QGY library as are all other open
     **                                        list APIs.
     **
     **    QWVRCSTK      Retrieve Call Stack   Lists the program call stack for
     **                                        the specified job or thread.
     **                                        The current invocation level is
     **                                        returned first.
     **
     **  Message handling API:
     **    QMHSNDM       Send message          Sends a message to the specified
     **                                        non-program message queue - here
     **                                        an informational message is sent
     **                                        to the current user running this
     **                                        program.
     **
     **  Open list APIs:
     **    QGYGTLE       Get list entries      To retrieve open lists entries
     **                                        from an already open list the
     **                                        QGYGTLE (Get List Entries) API
     **                                        is available.
     **
     **    QGYCLST       Close list            This API closes the previously
     **                                        opened list identified by the
     **                                        request handle parameter.
     **                                        Storage allocated is freed.
     **
     **  MI builtins:
     **    _MATRMD       Materialize resource  Retrieves processor utilization
     **                  management data       data - interactive processor time
     **                                        limit.
     **
     **    _MEMMOVE      Copy memory           Copies a string from one pointer
     **                                        specified location to another.
     **
     **  Unix Type - Signal APIs:
     **    Sleep                               Suspends program processing for
     **                                        the specified number of seconds.
     **
     **
     **  Sequence of events:
     **    1. The interactive processor time limit percentage is retrieved
     **
     **    2. The list jobs API input parameters are initialized
     **
     **    3. The open list of jobs API is called to reset the job
     **       statistics.
     **
     **    4. Program is suspended for 10 seconds
     **
     **    5. The open list of jobs API is called to list the interactive
     **       jobs on the system returning the most CPU intensive jobs
     **       for the elapsed period first.
     **
     **    6. For each job having used more than 50 % of the available
     **       interactive processor resources a message is sent to the
     **       message queue of the user currently running the program.
     **
     **       If no jobs are exceeding the above CPU limit a completion
     **       message is sent, specifying the interactive job having the
     **       highest CPU utilization.
     **
     **    7. The job list resources are cleaned up.
     **
     **
     **  Programmer's notes:
     **    Earliest release program will run:  V5R1
     **
     **    As mentioned above library QGY must be in the job library list
     **    to succesfully run this program.
     **
     **    To retrieve another job's call stack *JOBCTL special authority is
     **    required.
     **
     **
     **  Compile options:
     **
     **    CrtRpgMod Module( CBX102 )  DbgView( *LIST )
     **
     **    CrtPgm    Pgm( CBX102 )
     **              Module( CBX102 )
     **
     **
     **-- Control spec:  -----------------------------------------------------**
     H Option( *SrcStmt )  DecEdit( *JobRun )  BndDir( 'QC2LE' )
     **-- System information:  -----------------------------------------------**
     D PgmSts         SDs
     D  PsPgmNam         *Proc
     D  PsSts                         5a   Overlay( PgmSts:  11 )
     D  PsCurJob                     10a   Overlay( PgmSts: 244 )
     D  PsUsrPrf                     10a   Overlay( PgmSts: 254 )
     D  PsJobNbr                      6a   Overlay( PgmSts: 264 )
     D  PsCurUsr                     10a   Overlay( PgmSts: 358 )
     **-- API error data structure:  -----------------------------------------**
     D ApiError        Ds
     D  AeBytPrv                     10i 0 Inz( %Size( ApiError ))
     D  AeBytAvl                     10i 0
     D  AeExcpId                      7a
     D                                1a
     D  AeExcpDta                   128a
     **-- API parameters:  ---------------------------------------------------**
     D JlRtnRcdNbr     s             10i 0 Inz( 1 )
     D JlNbrFldRtn     s             10i 0 Inz( %Elem( JlKeyFld ))
     D JlKeyFld        s             10i 0 Dim( 3 )
     **-- Job information:
     D JlJobInf        Ds           512
     D  JbJobId                      26a
     D   JbJobUsd                    10a   Overlay( JbJobId: 1 )
     D   JbUsrUsd                    10a   Overlay( JbJobId: *Next )
     D   JbNbrUsd                     6a   Overlay( JbJobId: *Next )
     D  JbActSts                      4a
     D  JbJobTyp                      1a
     D  JbJobSubTyp                   1a
     D  JbDtaLen                     10i 0
     D                                4a
     D  JbDta                       256a
     **-- Key information:
     D JlKeyInf        Ds
     D  KiFldNbrRtn                  10i 0
     D  KiKeyInf                     20a   Dim( %Elem( JlKeyFld ))
     D   KiFldInfLen                 10i 0 Overlay( KiKeyInf :  1 )
     D   KiKeyFld                    10i 0 Overlay( KiKeyInf :  5 )
     D   KiDtaTyp                     1a   Overlay( KiKeyInf :  9 )
     D                                3a   Overlay( KiKeyInf : 10 )
     D   KiDtaLen                    10i 0 Overlay( KiKeyInf : 13 )
     D   KiDtaOfs                    10i 0 Overlay( KiKeyInf : 17 )
     **-- Sort information:
     D JlSrtInf        Ds
     D  SiNbrKeys                    10i 0 Inz( 1 )
     D  SiSrtInf                     12a   Dim( 10 )
     D   SiKeyFldOfs                 10i 0 Overlay( SiSrtInf :  1 )
     D   SiKeyFldLen                 10i 0 Overlay( SiSrtInf :  5 )
     D   SiKeyFldTyp                  5i 0 Overlay( SiSrtInf :  9 )
     D   SiSrtOrd                     1a   Overlay( SiSrtInf : 11 )
     D   SiRsv                        1a   Overlay( SiSrtInf : 12 )
     **-- List information:
     D JlLstInf        Ds
     D  LiRcdNbrTot                  10i 0
     D  LiRcdNbrRtn                  10i 0
     D  LiHandle                      4a
     D  LiRcdLen                     10i 0
     D  LiInfSts                      1a
     D  LiDts                        13a
     D  LiLstSts                      1a
     D                                1a
     D  LiInfLen                     10i 0
     D  LiRcd1                       10i 0
     D                               40a
     **-- Selection information:
     D JlSltInf        Ds
     D  SiJobNam                     10a   Inz( '*ALL' )
     D  SiUsrNam                     10a   Inz( '*ALL' )
     D  SiJobNbr                      6a   Inz( '*ALL' )
     D  SiJobTyp                      1a   Inz( 'I' )
     D                                1a
     D  SiOfsPriSts                  10i 0 Inz( 60 )
     D  SiNbrPriSts                  10i 0 Inz( 0 )
     D  SiOfsActSts                  10i 0 Inz( 70 )
     D  SiNbrActSts                  10i 0 Inz( 0 )
     D  SiOfsJbqSts                  10i 0 Inz( 78 )
     D  SiNbrJbqSts                  10i 0 Inz( 0 )
     D  SiOfsJbqNam                  10i 0 Inz( 88 )
     D  SiNbrJbqNam                  10i 0 Inz( 0 )
     **
     D  SiPriSts                     10a   Dim( 1 )
     D  SiActSts                      4a   Dim( 2 )
     D  SiJbqSts                     10a   Dim( 1 )
     D  SiJbqNam                     20a   Dim( 1 )
     **-- Job information key fields:
     D JbKeyDta        Ds
     D  JbPrcUniTim                  20u 0
     D  JbPrcUniPct                   9b 1
     D  JbPrcUniTimE                 20u 0
     **-- General return data:
     D JlGenDta        Ds
     D  GdBytRtn                     10i 0
     D  GdBytAvl                     10i 0
     D  GdElpTim                     20u 0
     D                               16a
     **-- MatRmd parameters:  ------------------------------------------------**
     D MatRscMgDt      Ds
     D  RdBytPrv                     10i 0 Inz( %Size( MatRscMgDt ))
     D  RdBytAvl                     10i 0
     D  RdTimDay                      8a
     D  RdData
     D   RdPrcTimIpl                 20u 0 Overlay( RdData: 1 )
     D   RdPrcTimScWl                20u 0 Overlay( RdData: *Next )
     D   RdPrcTimDb                  20u 0 Overlay( RdData: *Next )
     D   RdPrcTimDbTh                 5u 0 Overlay( RdData: *Next )
     D   RdPrcTimDbLm                 5u 0 Overlay( RdData: *Next )
     D   RdRsv1                      10u 0 Inz( x'00' )
     D                                     Overlay( RdData: *Next )
     D   RdPrcTimInt                 20u 0 Overlay( RdData: *Next )
     D   RdPrcTimIntT                 4b 1 Overlay( RdData: *Next )
     D   RdPrcTimIntL                 4b 1 Overlay( RdData: *Next )
     D   RdRsv2                      10u 0 Inz( x'00' )
     D                                     Overlay( RdData: *Next )
     **
     D MatCtlDta       Ds
     D  CdSltOpt                      1a   Inz( x'01' )
     D  CdRsv                         7a   Inz( *Allx'00' )
     **-- Global variables:  -------------------------------------------------**
     D Ix              s              5i 0
     D CpuLvl          s              5i 0
     D PgmNam          s             10a
     D MsgDta          s            256a   Varying
     D MsgKey          s              4a
     **-- API constants:  ----------------------------------------------------**
     D JOB_RESET_STAT  c                   '1'
     D JOB_KEEP_STAT   c                   '0'
     **-- Open list of jobs:  ------------------------------------------------**
     D LstJobs         Pr                  ExtPgm( 'QGYOLJOB' )
     D  LjRcvVar                  65535a          Options( *VarSize )
     D  LjRcvVarLen                  10i 0 Const
     D  LjFmtNam                      8a   Const
     D  LjRcvVarDfn               65535a          Options( *VarSize )
     D  LjRcvDfnLen                  10i 0 Const
     D  LjLstInf                     80a
     D  LjNbrRcdRtn                  10i 0 Const
     D  LjSrtInf                   1024a   Const  Options( *VarSize )
     D  LjJobSltInf                1024a   Const  Options( *VarSize )
     D  LjJobSltLen                  10i 0 Const
     D  LjNbrFldRtn                  10i 0 Const
     D  LjKeyFldRtn                  10i 0 Const  Options( *VarSize )  Dim( 32 )
     D  LjError                    1024a          Options( *VarSize )
     **
     D  LjJobSltFmt                   8a   Const  Options( *NoPass )
     **
     D  LjResStc                      1a   Const  Options( *NoPass )
     D  LjGenRtnDta                  32a          Options( *NoPass: *VarSize )
     D  LjGenRtnDtaLn                10i 0 Const  Options( *NoPass )
     **-- Get list entry:  ---------------------------------------------------**
     D GetLstEnt       Pr                  ExtPgm( 'QGYGTLE' )
     D  GlRcvVar                  65535a          Options( *VarSize )
     D  GlRcvVarLen                  10i 0 Const
     D  GlHandle                      4a   Const
     D  GlLstInf                     80a
     D  GlNbrRcdRtn                  10i 0 Const
     D  GlRtnRcdNbr                  10i 0 Const
     D  GlError                    1024a          Options( *VarSize )
     **-- Close list:  -------------------------------------------------------**
     D CloseLst        Pr                  ExtPgm( 'QGYCLST' )
     D  ClHandle                      4a   Const
     D  ClError                    1024a          Options( *VarSize )
     **-- Send message:  -----------------------------------------------------**
     D SndMsg          Pr                  ExtPgm( 'QMHSNDM' )
     D  SmMsgId                       7a   Const
     D  SmMsgFq                      20a   Const
     D  SmMsgDta                    512a   Const Options( *VarSize )
     D  SmMsgDtaLen                  10i 0 Const
     D  SmMsgTyp                     10a   Const
     D  SmMsgQq                    1000a   Const Options( *VarSize )
     D  SmMsgQnbr                    10i 0 Const
     D  SmMsgQrpy                    20a   Const
     D  SmMsgKey                      4a
     D  SmError                      10i 0 Const
     **
     D  SmCcsId                      10i 0 Const Options( *NoPass )
     **-- Copy memory:  ------------------------------------------------------**
     D memcpy          Pr              *   ExtProc( '_MEMMOVE' )
     D  outmem                         *   Value
     D  inpmem                         *   Value
     D  memsiz                       10u 0 Value
     **-- Delay job:  --------------------------------------------------------**
     D sleep           Pr            10i 0 ExtProc( 'sleep' )
     D  seconds                      10u 0 Value
     **-- Get top stack entry:  ----------------------------------------------**
     D GetTopStkE      Pr            20a
     D  GtJobId                      26a   Const
     **-- Materialize resource management data:  -----------------------------**
     D MatRmd          Pr                  ExtProc( '_MATRMD' )
     D  Rcv                                Like( MatRscMgDt )
     D  Ctl                                Like( MatCtlDta )
     **
     **-- Mainline:  ---------------------------------------------------------**
     **
     **-- Get interactive processor time limit:
     C                   Callp(e)  MatRmd( MatRscMgDt: MatCtlDta )
     **
     C                   If        %Error
     C                   Eval      RdPrcTimIntL= 100
     C                   EndIf
     **
     **-- Job information return fields:
     C                   Eval      JlKeyFld(1) = 312
     C                   Eval      JlKeyFld(2) = 314
     C                   Eval      JlKeyFld(3) = 315
     **
     **-- Sort field specification:
     C                   Eval      SiNbrKeys      = 1
     C                   Eval      SiKeyFldOfs(1) = 49
     C                   Eval      SiKeyFldLen(1) = 4
     C                   Eval      SiKeyFldTyp(1) = 0
     C                   Eval      SiSrtOrd(1)    = '2'
     C                   Eval      SiRsv(1)       = x'00'
     **
     **-- Initialize job CPU measurement:
     **-- NOTE: Statistics only reset if return records are requested
     **
     C                   CallP     LstJobs( JlJobInf
     C                                    : %Size( JlJobInf )
     C                                    : 'OLJB0300'
     C                                    : JlKeyInf
     C                                    : %Size( JlKeyInf )
     C                                    : JlLstInf
     C                                    : 1
     C                                    : JlSrtInf
     C                                    : JlSltInf
     C                                    : %Size( JlSltInf )
     C                                    : JlNbrFldRtn
     C                                    : JlKeyFld
     C                                    : ApiError
     C                                    : 'OLJS0100'
     C                                    : JOB_RESET_STAT
     C                                    : JlGenDta
     C                                    : %Size( JlGenDta )
     C                                    )
     **
     **-- Wait 10 seconds:
     C                   CallP     sleep( 10 )
     **
     **-- Retrieve job list:
     C                   CallP     LstJobs( JlJobInf
     C                                    : %Size( JlJobInf )
     C                                    : 'OLJB0300'
     C                                    : JlKeyInf
     C                                    : %Size( JlKeyInf )
     C                                    : JlLstInf
     C                                    : 1
     C                                    : JlSrtInf
     C                                    : JlSltInf
     C                                    : %Size( JlSltInf )
     C                                    : JlNbrFldRtn
     C                                    : JlKeyFld
     C                                    : ApiError
     C                                    : 'OLJS0100'
     C                                    : JOB_KEEP_STAT
     C                                    : JlGenDta
     C                                    : %Size( JlGenDta )
     C                                    )
     **
     C                   If        AeBytAvl    =  *Zero
     **
     C                   DoW       LiLstSts    <> '2'           Or
     C                             LiRcdNbrTot >  JlRtnRcdNbr
     **
     C                   ExSr      GetCpuDta
     C                   ExSr      ChkCpuPct
     **
     C                   If        CpuLvl      = 2
     C                   ExSr      SndCmpMsg
     C                   EndIf
     **
     C                   If        CpuLvl     >= 2
     C                   Leave
     C                   EndIf
     **
     C                   Eval      JlRtnRcdNbr = JlRtnRcdNbr + 1
     **
     C                   CallP     GetLstEnt( JlJobInf
     C                                      : %Size( JlJobInf )
     C                                      : LiHandle
     C                                      : JlLstInf
     C                                      : 1
     C                                      : JlRtnRcdNbr
     C                                      : ApiError
     C                                      )
     **
     C                   If        AeBytAvl    > *Zero
     C                   Leave
     C                   EndIf
     **
     C                   EndDo
     **
     C                   CallP     CloseLst( LiHandle
     C                                     : ApiError
     C                                     )
     **
     C                   EndIf
     **
     C                   Eval      *InLr       = *On
     **
     C                   Return
     **
     **-- Get CPU data:  -----------------------------------------------------**
     C     GetCpuDta     BegSr
     **
     C                   Clear                   JbKeyDta
     **
     C                   For       Ix = 1  To KiFldNbrRtn
     **
     C                   Select
     C                   When      KiKeyFld(Ix) = 312
     C                   CallP     memcpy( %Addr( JbPrcUniTim )
     C                                   : %Addr( JlJobInf ) +
     C                                     KiDtaOfs(Ix)
     C                                   : KiDtaLen(Ix)
     C                                   )
     **
     C                   When      KiKeyFld(Ix) = 314
     C                   CallP     memcpy( %Addr( JbPrcUniPct )
     C                                   : %Addr( JlJobInf ) +
     C                                     KiDtaOfs(Ix)
     C                                   : KiDtaLen(Ix)
     C                                   )
     **
     C                   When      KiKeyFld(Ix) = 315
     C                   CallP     memcpy( %Addr( JbPrcUniTimE )
     C                                   : %Addr( JlJobInf ) +
     C                                     KiDtaOfs(Ix)
     C                                   : KiDtaLen(Ix)
     C                                   )
     C                   EndSl
     C                   EndFor
     **
     C                   EndSr
     **-- Check CPU percent:  ------------------------------------------------**
     C     ChkCpuPct     BegSr
     **
     C                   If        JbPrcUniPct > RdPrcTimIntL / 2
     **
     C                   Eval      CpuLvl      = 1
     C                   Eval      PgmNam      = GetTopStkE( JbJobId )
     **
     C                   Eval      MsgDta      = 'CPU alert - program '       +
     C                                           %Trim( PgmNam )              +
     C                                           ' in job '                   +
     C                                           %Trim( JbJobUsd )            +
     C                                           ' is currently using '       +
     C                                           %Char( JbPrcUniPct )         +
     C                                           ' CPU % of '                 +
     C                                           %Char( RdPrcTimIntL )        +
     C                                           ' interactive CPU % available.'
     **
     C                   CallP(e)  SndMsg( *Blanks
     C                                   : *Blanks
     C                                   : MsgDta
     C                                   : %Len( MsgDta )
     C                                   : '*INFO'
     C                                   : PsCurUsr + '*LIBL'
     C                                   : 1
     C                                   : *Blanks
     C                                   : MsgKey
     C                                   : 0
     C                                   )
     **
     C                   Else
     C                   Eval      CpuLvl      = CpuLvl + 2
     C                   EndIf
     **
     C                   EndSr
     **-- Send completion message:  ------------------------------------------**
     C     SndCmpMsg     BegSr
     **
     C                   Eval      MsgDta      = 'CPU monitor completed '     +
     C                                           '- max utilization by job '  +
     C                                           %Trim( JbJobUsd )            +
     C                                           ' using '                    +
     C                                           %Char( JbPrcUniPct )         +
     C                                           ' CPU % of '                 +
     C                                           %Char( RdPrcTimIntL )        +
     C                                           ' interactive CPU % available.'
     **
     C                   CallP(e)  SndMsg( *Blanks
     C                                   : *Blanks
     C                                   : MsgDta
     C                                   : %Len( MsgDta )
     C                                   : '*COMP'
     C                                   : PsCurUsr + '*LIBL'
     C                                   : 1
     C                                   : *Blanks
     C                                   : MsgKey
     C                                   : 0
     C                                   )
     **
     C                   EndSr
     **-- Get top stack entry:  ----------------------------------------------**
     P GetTopStkE      B                   Export
     D                 Pi            20a
     D  GtJobId                      26a   Const
     **-- API parameters:
     D CsRcvVar        Ds
     D  CsBytRtn                     10i 0
     D  CsBytAvl                     10i 0
     D  CsNbrStkE                    10i 0
     D  CsOfsStkE                    10i 0
     D  CsNbrEntRtn                  10i 0
     D  CsThrId                       8a
     D  CsInfSts                      1a
     D  CsCalStk                  32767a
     **
     D CsCalStkE       Ds                  Based( pCalStkE )
     D  CsStkEntLen                  10i 0
     D  CsOfsStmIds                  10i 0
     D  CsNbrStmIds                  10i 0
     D  CsOfsPrcNam                  10i 0
     D  CsLenPrcNam                  10i 0
     D  CsRqsLvl                     10i 0
     D  CsPgmNam                     10a
     D  CsPgmLib                     10a
     D  CsMiInst                     10i 0
     D  CsModNam                     10a
     D  CsModLib                     10a
     D  CsCtlBdy                      1a
     D  CsRsv                         3a
     D  CsActGrpNbr                  10u 0
     D  CsActGrpNam                  10a
     D  CsAddInf                   4096a
     **
     D  CsStmIds                     10a   Dim( 16 )
     D  CsPrcNam                    512a
     **
     D CsJobId         Ds
     D  JiJobId                      26a
     D   JiJobNam                    10a   Overlay( JiJobId: 1 )
     D   JiUsrNam                    10a   Overlay( JiJobId: *Next )
     D   JiJobNbr                     6a   Overlay( JiJobId: *Next )
     D  JiIntId                      16a
     D  JiRsv                         2a   Inz( *Allx'00' )
     D  JiThrInd                     10i 0 Inz( 2 )
     D  JiThrId                       8a   Inz( *Allx'00' )
     **-- Retrieve call stack:
     D RtvCalStk       Pr                  ExtPgm( 'QWVRCSTK' )
     D  RcRcvVar                  32767a
     D  RcRcvVarLen                  10i 0 Const
     D  RcRcvInfFmt                   8a   Const
     D  RcJobId                      56a   Const
     D  RcJobIdFmt                    8a   Const
     D  RcError                   32767a          Options( *VarSize )
     **
     D EntNbr          s              5u 0
     **-- Get stack entries:  ------------------------------------------------**
     **
     C                   Eval      JiJobId     =  GtJobId
     **
     C                   CallP     RtvCalStk( CsRcvVar
     C                                      : %Size( CsRcvVar )
     C                                      : 'CSTK0100'
     C                                      : CsJobId
     C                                      : 'JIDF0100'
     C                                      : ApiError
     C                                      )
     **
     C                   If        AeBytAvl    = *Zero
     C                   Eval      pCalStkE    = %Addr( CsRcvVar ) + CsOfsStkE
     **
     C                   For       EntNbr = 1  to CsNbrEntRtn
     **
     C                   If        EntNbr      = 1
     **
     C                   Eval      CsStmIds    = *Blanks
     C                   Eval      CsPrcNam    = *Blanks
     **
     C                   If        CsOfsStmIds > *Zero
     C                   CallP     MemCpy( %Addr( CsStmIds )
     C                                   : %Addr( CsCalStkE ) +
     C                                     CsOfsStmIds
     C                                   : CsNbrStmIds * %Size( CsStmIds )
     C                                   )
     C                   EndIf
     **
     C                   If        CsOfsPrcNam > *Zero
     C                   CallP     MemCpy( %Addr( CsPrcNam )
     C                                   : %Addr( CsCalStkE ) +
     C                                     CsOfsPrcNam
     C                                   : CsLenPrcNam
     C                                   )
     C                   EndIf
     **
     C                   Leave
     C                   EndIf
     **
     C                   If        EntNbr      < CsNbrEntRtn
     C                   Eval      pCalStkE    = PCalStkE    + CsStkEntLen
     C                   EndIf
     C                   EndFor
     **
     C                   Return    CsPgmNam + CsPgmLib
     **
     C                   Else
     C                   Return    *Blanks
     C                   EndIf
     **
     P GetTopStkE      E 

[K2r400]

Re: List system objects using QUSLOBJ

Thanks Patrick,
I think I need a bunch more objects to make this monster run...
(bunch of copybooks)

Oups, sorry, below the link to download David Moris's Framework

http://iseries-toolkit.sourceforge.net/

[jamief]

Re: List system objects using QUSLOBJ

No need to be sorry -- you were trying to help me.. Thanks

Jamie

[tomholden]

Re: List system objects using QUSLOBJ

if don't have one for the open list of objects but the WRKSPL command i have on my website uses the open list of spooled files API (it's free-format if you prefer /free)
http://tommyholden.com/downloads/save files/wrkspl.savf

[jamief]

Re: List system objects using QUSLOBJ

Thanks Tom.... Looks like it may be a few days till I get back to this.