QWCRJBLK - Retrieve Job Lock

Retrieve Job Lock ** Program . . : CBX504 ** Description : List job's object locks ** Author . . : Carsten Flensburg ** Published . : Club Tech iSeries Programming Tips Newsletter ** Date . . . : July 15, 2004 ** ** ** Program description: ** ** This program is intended to ease the process of retrieving the ** current job's list of object locks. The information returned is ** object name, library and type as well as object lock state, similar ** to some of the information that is displayed by the DSPJOB or ** WRKJOB commands' Job Locks panel. Running the command DSPJOB ** OPTION( *JOBLCK ) will show the information referred to above. ** ** Program CBX504T is provided to give an example of how to call ** this program. ** ** Parameters: ** ** PxEntNbr BOTH The maximum number of job object lock entries ** to return in the output array. A maximum ** of 128 job object lock entries can be returned. ** ** On return this parameter specifies the ** actual number of job object locks loaded ** in the second parameter. ** ** PxLckEnt OUTPUT The list of job object lock entries are returned ** in this parameter. The object name, library and ** type as well as object lock state is returned ** for each job object lock entry as illustrated ** below: ** ** 1 41 81 ** | -------- entry 1 -------- | -------- entry 2 -------- | ** ** 1 11 21 31 41 51 61 71 81 ** | obj | lib | type | lock | obj | lib | type | lock | ** ** **-- Compilation specification: ** ** CrtBndRpg Pgm( 'library'/CBX504 ) ** SrcFile( 'library'/QRPGLESRC ) ** DbgView( *LIST ) ** ** **-- Header specifications: --------------------------------------------** H Option( *SrcStmt ) **-- Api error data structure: -----------------------------------------** D ERRC0100 Ds Qualified D BytPro 10i 0 Inz( %Size( ERRC0100 )) D BytAvl 10i 0 Inz D MsgId 7a D 1a D MsgDta 256a **-- Global variables: -------------------------------------------------** D Eix s 10i 0 D ApiRcvSiz s 10u 0 **-- Job lock information: ---------------------------------------------** D JBLK0100 Ds Qualified Based( pLstHdr ) D BytRtn 10i 0 D BytAvl 10i 0 D NbrObjLck 10i 0 D OfsObjLck 10i 0 D NbrLckObjRtn 10i 0 D LckObjEntLen 10i 0 ** D JBLK0100E Ds Qualified Based( pLstEnt ) D ObjNam 10a D ObjLib 10a D ObjTyp 10a D ObjExtAtr 10a D LckStt 10a D 2a D LckSts 10i 0 D MbrLcks 10i 0 D LckCnt 10i 0 D LckScp 1a D 3a D ThrId 8a D ThrHdl 10u 0 ** V5R2: D LckSpcId 20a D ObjAspNam 10a D ObjLibAspNam 10a D ObjAspNbr 10i 0 D ObjLibAspNbr 10i 0 **-- Job id: -----------------------------------------------------------** D JlJobId Ds D JiJobNam 10a Inz( '*' ) D JiUsrNam 10a D JiJobNbr 6a D JiIntJobId 16a Inz( *Blanks ) D 2a Inz( *Allx'00' ) D JlThrInd 10i 0 Inz( 3 ) D JlThrId 8a **-- Retrieve job locks: -----------------------------------------------** D RtvJobLck Pr ExtPgm( 'QWCRJBLK' ) D JlRcvVar 65535a Options( *VarSize ) D JlRcvVarLen 10i 0 Const D JlFmtNam 8a Const D JlJobId 56a Const D JlFmtJobId 8a Const D JlError 32767a Options( *VarSize ) ** D JlLckFlr 53a Const Options( *NoPass ) D JlFlrFmt 8a Const Options( *NoPass ) **-- Parameters: -------------------------------------------------------** D PxEntNbr s 5p 0 D PxLckEnt s 40a Dim( 128 ) ** C *Entry Plist C Parm PxEntNbr C Parm PxLckEnt ** ** **-- Mainline: ---------------------------------------------------------** ** C Eval ApiRcvSiz = 10240 C Eval pLstHdr = %Alloc( ApiRcvSiz ) ** C DoU JBLK0100.BytAvl <= ApiRcvSiz Or C ERRC0100.BytAvl > *Zero ** C If ApiRcvSiz < JBLK0100.BytAvl ** C Eval ApiRcvSiz = JBLK0100.BytAvl C Eval pLstHdr = %ReAlloc( pLstHdr: ApiRcvSiz ) C EndIf ** C CallP RtvJobLck( JBLK0100 C : ApiRcvSiz C : 'JBLK0100' C : JlJobId C : 'JIDF0100' C : ERRC0100 C ) ** C EndDo ** C If JBLK0100.NbrLckObjRtn > *Zero And C ERRC0100.BytAvl = *Zero ** C ExSr PrcJobLcks C Else ** C Eval PxEntNbr = *Zero C EndIf ** C DeAlloc pLstHdr ** C Eval *InLr = *On C Return ** **-- Process job locks: ------------------------------------------------** C PrcJobLcks BegSr ** C Eval pLstEnt = pLstHdr + JBLK0100.OfsObjLck ** C For Eix = 1 to JBLK0100.NbrLckObjRtn ** C Eval PxLckEnt(Eix) = JBLK0100E.ObjNam + C JBLK0100E.ObjLib + C JBLK0100E.ObjTyp + C JBLK0100E.LckStt ** **-- Specific exit point for this example: C If Eix = PxEntNbr Or C Eix = %Elem( PxLckEnt ) Or C Eix = JBLK0100.NbrLckObjRtn ** C Leave C EndIf ** **-- General logic to keep entry pointer within list size: C If Eix < JBLK0100.NbrLckObjRtn C Eval pLstEnt = pLstEnt + JBLK0100.LckObjEntLen C EndIf C EndFor ** C Eval PxEntNbr = Eix ** C EndSr And the calling program: **-- Compilation specification: ----------------------------------------** ** ** CrtBndRpg Pgm( 'library'/CBX504T ) ** SrcFile( 'library'/QRPGLESRC ) ** DbgView( *LIST ) ** **-- Header specifications: --------------------------------------------** H Option( *SrcStmt ) **-- Global variables: -------------------------------------------------** D Eix s 10i 0 **-- File information----------------------------------------------------** D LckInf Ds D LiObjNam 10a D LiObjLib 10a D LiObjTyp 10a D LiLckStt 10a **-- Parameters: -------------------------------------------------------** D PxEntNbr s 5p 0 Inz( %Elem( PxLckEnt )) D PxLckEnt s 40a Dim( 64 ) ** C Call 'CBX504' C Parm PxEntNbr C Parm PxLckEnt ** C For Eix = 1 to PxEntNbr ** C Eval LckInf = PxLckEnt(Eix) C LckInf Dsply ** C EndFor ** C Return Thanks to Carsten Flensburg and Club Tech iSeries Programming Tips Newsletter