2023-12-22 Get top cpu usage percentage job (TOPCPUPCT)
File : QRPGLESRC
Member: TOPCPUPCT
Type : RPGLE
**
** Program . . : TopCpuPct
** Description : Finds CPU Top and notifies caller
** Author . . : Vengoal Chang
** Published . : AS400 ePaper
** Date . . . : November 21, 2023
**
**
** 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:
** _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 act jobs 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 some 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 top cpu percent job a message is sent to the
** message queue.
**
** 7. The job list resources are cleaned up.
**
** 8. The program will loop 1 to 7, until manual job.
**
** Programmer's notes:
**
** 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( TOPCPUPCT ) DbgView( *LIST )
**
** CrtPgm Pgm( TOPCPUPCT )
** Module( TOPCPUPCT )
**
** Usage sample:
** Get top first CPU% job per 60 secs with following:
** SBMJOB
** CMD(TOPCPUPCT TOPCOUNT(001) INTERVAL(00060)
** TOMSGQ(*SYSOPR))
** Job(TOPPCTPCT)
**
** Get top 5 CPU% job per 60 secs with following:
** SBMJOB
** CMD(TOPCPUPCT TOPCOUNT(005) INTERVAL(00060)
** TOMSGQ(*SYSOPR))
** Job(TOPPCTPCT)
**
**-- Control spec: -----------------------------------------------------**
H Option( *SrcStmt ) DecEdit( *JobRun ) BndDir( 'QC2LE' )
H DftActGrp(*NO)
**-- 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( '*' )
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 Count s 5i 0
D Interval s 10u 0
D TopCount s 3S 0
D PgmNam s 10a
D MsgDta s 256a Varying
D MsgKey s 4a
D SysTime s z inz(*sys)
**-- 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: ---------------------------------------------------------**
**
C *Entry Plist
C Parm TopCount_p 3
C Parm Interval_p 5
C Parm ToMsgQ 10
**
C Eval TopCount = %Int(TopCount_p)
C Eval Interval = %Int(Interval_p)
C Select
C When ToMsgQ = '*SYSOPR'
C Eval ToMsgQ = 'QSYSOPR'
C When ToMsgQ = '*CURUSR'
C Eval ToMsgQ = PsCurUsr
C EndSl
**
**-- 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 DoW 1 = 1
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( Interval )
**
**-- 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 Eval Count = 0
C DoW LiLstSts <> '2' Or
C LiRcdNbrTot > JlRtnRcdNbr
**
C ExSr GetCpuDta
C ExSr ChkCpuPct
**
C* ExSr SndCmpMsg
**
C If Count >= TopCount
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 EndDo
**
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 Eval Count = Count + 1
C Eval PgmNam = GetTopStkE( JbJobId )
**
C Eval SysTime = %Timestamp()
C Eval MsgDta =
C '{ "CPUPCTMSG": { ' +
C '"QDATETIME" : "' +
C %Char(%Timestamp():*ISO) + '", ' +
C '"JobNam" : "' +
C %Trim(JbJobUsd) + '", ' +
C '"JobUsr" : "' +
C %Trim(JbUsrUsd) + '", ' +
C '"JobNbr" : "' +
C %Trim(JbNbrUsd) + '", ' +
C '"CpuPct" : "' +
C %Char( JbPrcUniPct ) + '", ' +
C '"PgmNam" : "' +
C %Trim( PgmNam ) + '" ' +
C '} }'
**
C CallP(e) SndMsg( *Blanks
C : *Blanks
C : MsgDta
C : %Len( MsgDta )
C : '*INFO'
C : ToMsgQ + '*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
File : QCMDSRC
Member: TOPCPUPCT
Type : CMD
/* =============================================================== */
/* = Command....... TopCpuPct = */
/* = CPP........... TopCpuPct RPGLE = */
/* = Description... Send WRKACTJOB CPUPCT top to user = */
/* = = */
/* = = */
/* = CrtCmd Cmd( TopCpuPct ) = */
/* = Pgm( TopCpuPct ) = */
/* = SrcFile( YourSourceFile ) = */
/* =============================================================== */
/* = Date : 2023/11/21 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
CMD PROMPT('Top Cpu Percent Job')
PARM KWD(TOPCOUNT) TYPE(*CHAR) LEN(3) +
RANGE('001' '999') +
FULL(*YES) +
PROMPT('TOP CPU JOB COUNT')
PARM KWD(INTERVAL) TYPE(*CHAR) LEN(5) +
RANGE('00001' '99999') +
FULL(*YES) +
PROMPT('Interval second')
PARM KWD(TOMSGQ) TYPE(*CHAR) LEN(10) +
DFT(*SYSOPR) +
SPCVAL((*SYSOPR) (*CURUSR)) +
PROMPT('Message To MsgQ')
Program to capture CPU usage over time (with SQL)
星期五, 12月 22, 2023
2023-12-22 Get top cpu usage percentage job (TOPCPUPCT)
星期四, 11月 09, 2023
2018-12-03 Check Daily Batch Jobs started or not
Check Daily Batch Jobs started or not
CHKBCHJOB CLP read file CHKBCHJOBP and check current time >= start time and current time < end time and chkflg ='Y',
then call API get the job active information, If job does not active, then send the job not acticve message to sysopr.
If job active, but status is MSGW, also send message to sysopr.
File : QDDSSRC
Member: CHKBCHJOBP
Type : PF
Usage : CrtPF File(CHKBCHJOBP)
A*****************************************************************
A* FUNCTION : CHKBCHJOB monitor batch job file
A* FILE : CHKBCHJOBP
A* AUTHOR : Vengoal Chang
A* DATE : 2018/12/03
A*****************************************************************
A UNIQUE
A R BCHJOBR TEXT('Batch job record')
A JOBNAME 10A COLHDG(' JOB NAME')
A JOBUSER 10A COLHDG(' USER')
A STRTIME 6S 0 COLHDG('start time')
A ENDTIME 6S 0 COLHDG('end time')
A CHKFLAG 1A COLHDG('check Y/N')
A NOTE 32O COLHDG('note')
A UPDDATE 8S 0 COLHDG('update date')
A UPDTIME 6S 0 COLHDG('update time')
A*----------------------------------------------------------------
A K JOBNAME
File : QCLSRC
Member: CHKBCHJOBC
Type : CLP
OS400 : V5R4 above
Usage : CrtClPgm Pgm(ChkBCHJOBC)
/* =============================================================== */
/* = Program ChkBchJobC = */
/* = ChkBchJob CLP = */
/* = Paramater notes: = */
/* = Read CHKBCHJOBP file to check daily job active or not = */
/* =============================================================== */
/* = Date : 2018/12/03 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
PGM
DCL &CURTIMEC *CHAR 6
DCL &STRTIMEC *CHAR 6
DCL &ENDTIMEC *CHAR 6
DCL &CURTIME *DEC (6 0)
DCL &MSGTEXT *CHAR 256
DCL &USP_NAME *CHAR 10
DCL &USP_LIB *CHAR 10
DCL &USP_QUAL *CHAR 20
DCL &USP_TYPE *CHAR 10
DCL &USP_SIZE *CHAR 4
DCL &USP_FILL *CHAR 1
DCL &USP_AUT *CHAR 10
DCL &USP_TEXT *CHAR 50
DCL &API_USQUAL *CHAR 20
DCL &API_JBQUAL *CHAR 26
DCL &API_JBNAM *CHAR 10
DCL &API_USER *CHAR 10
DCL &API_JOBNR *CHAR 6
DCL &API_STATUS *CHAR 10
DCL &STARTPOS *CHAR 4
DCL &DATALEN *CHAR 4
DCL &HEADER *CHAR 150
DCL &LST_OFFSET *DEC (10 0)
DCL &LST_SIZE *DEC (10 0)
DCL &LST_DATA *CHAR 4096
DCL &LST_NBR *DEC (5 0)
DCL &LST_LEN *DEC (5 0)
DCL &LST_LENBIN *CHAR 4
DCL &LST_POSBIN *CHAR 4
DCL &LST_COUNT *DEC (5 0) VALUE(0)
DCL &EXC_COUNT *DEC (5 0) VALUE(0)
DCL &TYPE *CHAR 1 VALUE('*')
DCL &NBRTORTN *CHAR 4
DCL &KEYSTORTN *CHAR 16
DCL &KEY1 *CHAR 4
DCL &KEY2 *CHAR 4
DCL &KEY3 *CHAR 4
DCL &KEY4 *CHAR 4
DCL &SBSSYS *CHAR 20
DCL &WRKSTS *CHAR 4
DCL &MSGRPLY *CHAR 1
DCL &USER *CHAR 10
DCL &CURUSR *CHAR 10
DCL &JOBNBR *CHAR 6
DCL &STATUS *CHAR 10
DCL &JOBTYPE *CHAR 1
DCL &SUBTYPE *CHAR 1
DCLF CHKBCHJOBP
MONMSG (CPF0000 MCH0000) *NONE GOTO ERROR
READF:
RCVF
MONMSG CPF0864 *N GOTO ENDF
RTVSYSVAL SYSVAL(QTIME) RTNVAR(&CURTIMEC)
CHGVAR &CURTIME &CURTIMEC
IF (&CURTIME >= &STRTIME *AND +
&CURTIME < &ENDTIME *AND +
&CHKFLAG = 'Y') Do
CallSubR SubR(ListJob)
If (&LST_NBR *EQ 0) Do
CHGVAR &STRTIMEC &STRTIME
CHGVAR &ENDTIMEC &ENDTIME
CHGVAR &MSGTEXT +
('* Bctch Job=' *CAT +
&JOBNAME *CAT 'run time : ' *CAT +
&STRTIMEC *BCAT '~' *BCAT &ENDTIMEC *CAT +
', program not started !')
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA(&MSGTEXT) TOMSGQ(*SYSOPR)
EndDo
EndDo
Goto READF
ENDF:
Return
Error:
Call QMHMOVPM ( ' ' +
'*DIAG' +
x'00000001' +
'*PGMBDY' +
x'00000001' +
x'0000000800000000' +
)
Call QMHRSNEM ( ' ' +
x'0000000800000000' +
)
/****************************************************************/
/* Sub routine ListJob */
/****************************************************************/
SUBR SUBR(ListJob)
CHGVAR VAR(%BIN(&NBRTORTN)) VALUE(4)
/* 0101 -- Ststus as WRKACTJOB */
CHGVAR VAR(%BIN(&KEY1 )) VALUE(0101)
/* 1906 -- Subsystem */
CHGVAR VAR(%BIN(&KEY2 )) VALUE(1906)
/* 1307 -- Message Reply */
CHGVAR VAR(%BIN(&KEY3 )) VALUE(1307)
/* 0305 -- Current user profile */
CHGVAR VAR(%BIN(&KEY4 )) VALUE(0305)
CHGVAR VAR(&KEYSTORTN) VALUE(&KEY1 *CAT &KEY2 *CAT +
&KEY3 *CAT &KEY4)
CHGVAR VAR(&USP_NAME) VALUE('CHKJOBNAME')
CHGVAR VAR(&USP_LIB) VALUE('QTEMP')
CHGVAR VAR(&USP_QUAL) VALUE(&USP_NAME *CAT +
&USP_LIB)
CHGVAR VAR(&USP_TYPE) VALUE('MYTYPE')
CHGVAR VAR(%BIN(&USP_SIZE)) VALUE(128000)
CHGVAR VAR(&USP_FILL) VALUE(' ')
CHGVAR VAR(&USP_AUT) VALUE('*USE')
CHGVAR VAR(&USP_TEXT) VALUE('my user space')
DLTUSRSPC USRSPC(&USP_LIB/&USP_NAME)
MONMSG CPF0000
CALL PGM(QUSCRTUS) PARM(&USP_QUAL &USP_TYPE +
&USP_SIZE &USP_FILL &USP_AUT &USP_TEXT)
CHGVAR VAR(&API_USQUAL) VALUE(&USP_QUAL)
CHGVAR VAR(&API_JBNAM) VALUE(&JOBNAME)
CHGVAR VAR(&API_USER) VALUE('*ALL')
/* CHGVAR VAR(&API_USER) VALUE(&JOBUSER) */
CHGVAR VAR(&API_JOBNR) VALUE('*ALL')
CHGVAR VAR(&API_STATUS) VALUE('*ACTIVE')
CHGVAR VAR(&API_JBQUAL) VALUE(&API_JBNAM *CAT +
&API_USER *CAT &API_JOBNR)
CALL PGM(QUSLJOB) PARM(&API_USQUAL 'JOBL0200' +
&API_JBQUAL &API_STATUS X'00000000' +
&TYPE &NBRTORTN &KEYSTORTN)
CHGVAR VAR(%BIN(&STARTPOS)) VALUE(1)
CHGVAR VAR(%BIN(&DATALEN)) VALUE(140)
CALL PGM(QUSRTVUS) PARM(&API_USQUAL &STARTPOS +
&DATALEN &HEADER)
CHGVAR VAR(&LST_OFFSET) VALUE(%BIN(&HEADER 125 4))
CHGVAR VAR(&LST_SIZE) VALUE(%BIN(&HEADER 129 4))
CHGVAR VAR(&LST_NBR) VALUE(%BIN(&HEADER 133 4))
CHGVAR VAR(&LST_LEN) VALUE(%BIN(&HEADER 137 4))
CHGVAR VAR(%BIN(&LST_POSBIN)) VALUE(&LST_OFFSET + 1)
CHGVAR VAR(&LST_LENBIN) VALUE(%SST(&HEADER 137 4))
CHGVAR VAR(&LST_COUNT) VALUE(0)
IF (&LST_NBR *EQ 0) DO
/* Job not found */
Goto Lst_End
ENDDO
LST_LOOP: IF COND(&LST_COUNT *EQ &LST_NBR) THEN(GOTO +
CMDLBL(LST_END))
CALL PGM(QUSRTVUS) PARM(&API_USQUAL &LST_POSBIN +
&LST_LENBIN &LST_DATA)
CHGVAR VAR(&JOBNAME) VALUE(%SST(&LST_DATA 1 10))
CHGVAR VAR(&USER) VALUE(%SST(&LST_DATA 11 10))
CHGVAR VAR(&JOBNBR) VALUE(%SST(&LST_DATA 21 6))
CHGVAR VAR(&STATUS) VALUE(%SST(&LST_DATA 43 10))
CHGVAR VAR(&JOBTYPE) VALUE(%SST(&LST_DATA 53 1))
CHGVAR VAR(&SUBTYPE) VALUE(%SST(&LST_DATA 54 1))
/* for status */
CHGVAR VAR(&WRKSTS ) VALUE(%SST(&LST_DATA 81 4))
/* for subsystem */
CHGVAR VAR(&SBSSYS ) VALUE(%SST(&LST_DATA 101 20))
/* for msgrply */
CHGVAR VAR(&MSGRPLY) VALUE(%SST(&LST_DATA 137 1))
/* for current user */
CHGVAR VAR(&CURUSR ) VALUE(%SST(&LST_DATA 157 10))
IF (&WRKSTS *EQ 'MSGW' *AND &MSGRPLY *EQ '1') DO
CHGVAR &MSGTEXT ('* Job' *BCAT +
&JOBNBR *TCAT '/' *CAT +
&USER *TCAT '/' *CAT +
&JOBNAME *BCAT 'status is' *BCAT +
&WRKSTS *TCAT '.')
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA(&MSGTEXT) TOMSGQ(*SYSOPR)
EndDo
CHGVAR VAR(&LST_COUNT) VALUE(&LST_COUNT + 1)
CHGVAR VAR(%BIN(&LST_POSBIN)) +
VALUE(%BIN(&LST_POSBIN) + &LST_LEN)
GOTO CMDLBL(LST_LOOP)
LST_END:
DLTUSRSPC USRSPC(&USP_LIB/&USP_NAME)
ENDSUBR
EndPgm:
EndPgm
File : QCLSRC
Member: CHKBCHJOB
Type : CLP
Usage : CRTCLPGM CHKBCHJOB
Insert your batch job which need to be monitored to CHKBCHJOBP
SBMJOB CMD(CALL CHKBCHJOB) JOB(CHKBCHJOB)
PGM
/*-- Global error monitoring: --------------------------------------*/
MonMsg CPF0000 *N GoTo Error
Loop:
Call ChkBchJobC
DlyJob 300
Goto Loop
Return:
Return
/*-- Error handling: -----------------------------------------------*/
Error:
Call QMHMOVPM ( ' ' +
'*DIAG' +
x'00000001' +
'*PGMBDY' +
x'00000001' +
x'0000000800000000' +
)
Call QMHRSNEM ( ' ' +
x'0000000800000000' +
)
EndPgm:
EndPgm
2016-02-02 即時監控工作站錯誤訊息 CPF5140，並終止該工作站
即時監控工作站錯誤訊息 CPF5140，並終止該工作站
Monitor interactive job which got CPF5140 error message and end it
即時監控工作站錯誤訊息 CPF5140，並終止該工作站。
因為使用者有時會因等待輸入暫停過久，直接將5250工作站直接點擊右上角關閉方塊，
此時系統會拋出 CPF5140 錯誤，此時若該工作站正執行大量資料的存取，系統仍會繼續
執行，但最終仍無法傳回資訊，導致系統浪費資源，要防止此狀況發生，就須即時監控並
終止該工作站 JOB。
File : QCLSRC
Member: WCHCPF5140
Type : CLP
Usage : CRTCLPGM PGM(QGPL/WCHCPF5140)
Start
STRWCH SSNID(WCHCPF5140) WCHPGM(QGPL/WCHCPF5140)
WCHMSG((CPF5140))
WCHMSGQ((*JOBLOG))
WCHJOB((*ALL/*ALL/*ALL))
End
WRKWCH *ALL use option 2 to End Watch
/* ================================================================ */
/* */
/* Program : WCHCPF5140 */
/* */
/* Description: Monitor interactive job which got CPF5410 */
/* and end it to prevent system from high CPU usage */
/* */
/* Date : 2016/02/01 */
/* */
/* Author : Vengoal Chang */
/* ================================================================ */
/* */
/* */
/* CRTCLPGM PGM(WCHCPF5140) */
/* */
/* */
/* STRWCH SSNID(WCHCPF5140) WCHPGM(QGPL/WCHCPF5140) */
/* WCHMSG((CPF5140)) */
/* WCHMSGQ((*JOBLOG)) */
/* WCHJOB((*ALL/*ALL/*ALL)) */
/* */
/* ================================================================ */
Pgm Parm(&Type &Session &Error &Data)
Dcl Var(&Type) Type(*Char) Len(10)
Dcl Var(&Session) Type(*Char) Len(10)
Dcl Var(&Error) Type(*Char) Len(10)
Dcl Var(&Data) Type(*Char) Len(2000)
Dcl Var(&LenEvtDta) Type(*Int) Len(4) +
Stg(*Defined) DefVar(&Data 1)
Dcl Var(&Job) Type(*Char) Len(10) +
Stg(*Defined) DefVar(&Data 33)
Dcl Var(&User) Type(*Char) Len(10) +
Stg(*Defined) DefVar(&Data 43)
Dcl Var(&Nbr ) Type(*Char) Len( 6) +
Stg(*Defined) DefVar(&Data 53)
Dcl Var(&MSGID) Type(*Char) Len(7) +
Stg(*Defined) DefVar(&Data 5)
Dcl Var(&MsgF) Type(*Char) Len(10) +
Stg(*Defined) DefVar(&Data 391)
Dcl Var(&MsgFLib) Type(*Char) Len(10) +
Stg(*Defined) DefVar(&Data 401)
Dcl Var(&OffRplDta) Type(*Int) Len(4) +
Stg(*Defined) DefVar(&Data 441)
Dcl Var(&LenRplDta) Type(*Int) Len(4) +
Stg(*Defined) DefVar(&Data 445)
Dcl Var(&OrgLenRpl) Type(*Int) Len(4) +
Stg(*Defined) DefVar(&Data 59)
Dcl Var(&MsgDtaPtr) Type(*Ptr)
Dcl Var(&MsgDta) Type(*Char) Len(1010) +
Stg(*Based) BasPtr(&MsgDtaPtr)
/* CPF5140 char data */
Dcl Var(&MsgUser ) Type(*Char) Len(10) +
Stg(*Defined) DefVar(&MsgDta 1)
Dcl Var(&Host ) Type(*Char) Len(255) +
Stg(*Defined) DefVar(&MsgDta 11)
Dcl Var(&QualMsgf) Type(*Char) Len(20)
Dcl Var(&MsgTxt ) Type(*Char) Len(1024)
Dcl Var(&Rtvm0100 ) Type(*Char) Len(1024)
Dcl Var(&RplDta ) Type(*Char) Len(1024)
Dcl Var(&SysValTo) Type(*Char) Len(500)
Dcl VAR(&MsgTxtLenC) Type(*Char) Len(4)
Dcl VAR(&MsgTxtLen ) Type(*Dec ) Len(5 0)
Dcl VAR(&RplDtaLenC) Type(*Char) Len(4)
Dcl VAR(&ErrCode) Type(*Char) Len(15) /* Error Code */
/* Check to make sure this is a *MSGID watch */
If Cond(&Type = '*MSGID') Then(Do)
/* Check to make sure this is for CPF5140 */
If Cond(&MsgID = 'CPF5140') Then(Do)
ChgVar Var(&MsgDtaPtr) Value(%Addr(&Data))
Chgvar Var(%Offset(&MsgDtaPtr)) +
Value(%Offset(&MsgDtaPtr) + &OffRplDta)
ChgVar &RplDta %sst(&MsgDta 1 &LenRplDta)
ChgVar &QualMsgf (&MsgF *Cat &MsgFLib)
ChgVar %BIN(&MSGTXTLENC) 1024
ChgVar %BIN(&RplDtaLenC) &LenRplDta
ChgVar %BIN(&ErrCode 1 4) 15
Call QMHRTVM ( +
&Rtvm0100 +
&MsgTxtLenC +
'RTVM0100' +
&MSGID +
&QUALMSGF +
&RplDta +
&RplDtaLenC +
'*YES ' +
'*NO ' +
&Errcode)
ChgVar &MsgTxtLenC %SST(&Rtvm0100 9 4)
ChgVar &MsgTxtLen %BIN(&MsgTxtLenC)
ChgVar &MsgTxt (&MSGID *CAT ':' *BCAT +
%SST(&Rtvm0100 25 &MsgTxtLen) *BCAT +
'Job ' *BCAT +
&Nbr *CAT '/' *CAT &User *Tcat '/' *CAT &Job +
*BCAT 'was ended by watch program')
EndJob Job(&NBR/&USER/&JOB) Option(*IMMED)
MonMsg CPF0000
SndPgmMsg MsgId(CPF9898) Msgf(QCPFMSG) MsgDta(&MsgTxt) +
ToUsr(*SYSOPR)
EndDo
EndDo /* End If &Type = *MSGID */
ChgVar Var(&Error) Value(' ')
EndPgm
參照: STRWCH - Watch Exit Programs Explained with CL Example
2015-07-02 Get AS400 Subsystem jobs with java( Open List of Jobs (QGYOLJOB) API format OLJB0300)
Get AS400 Subsystem jobs with java( Open List of Jobs (QGYOLJOB) API format OLJB0300)
(SubsystemJobOpenListTest.java, SubsystemJobListItem.java, SubsystemJobOpenList.java)
File : SubsystemJobListItem.java
///////////////////////////////////////////////////////////////////////////////
//
//
// Filename: SubsystemJobListItem.java
//
// Author : Vengoal Chang
//
// Date : 2015/07/01
//
//
///////////////////////////////////////////////////////////////////////////////
package com.vengoal.as400.list;
import java.util.Iterator;
import java.util.Map;
import java.util.Set;
import java.util.TreeMap;
import com.ibm.as400.access.BinaryConverter;
public class SubsystemJobListItem {
public static final int ACTIVE_JOB_STATUS_FOR_JOBS_ENDING = 103; // Active job status for jobs ending
public static final int CURRENT_USER = 305; // Current user profile
public static final int CPU_TIME_USED_LARGE = 312; // Processing unit time used - total for the job
public static final int CPU_TIME_USED_FOR_DATABASE = 313; // Processing unit time used for database - total for the job (Deprecated)
public static final int ELAPSED_CPU_PERCENT_USED = 314; // Processing unit used - percent during the elapsed time (job)
public static final int ELAPSED_CPU_TIME_USED = 315; // Processing unit used - time during the elapsed time (job)
public static final int ELAPSED_CPU_PERCENT_USED_FOR_DATABASE = 316; // Processing unit used for database - percent during the elapsed time (job) (Deprecated)
public static final int ELAPSED_CPU_TIME_USED_FOR_DATABASE = 317; // Processing unit used for database - time during the elapsed time (job) (Deprecated)
public static final int DATE_ENTERED_SYSTEM = 402; // Date and time job entered system
public static final int ELAPSED_DISK_IO = 414; // Disk I/O count during the elapsed time (job)
public static final int DISK_IO = 415; // Disk I/O count - total for the job
public static final int ELAPSED_DISK_IO_ASYNCH = 416; // Disk I/O count during the elapsed time - asynchronous I/O (job)
public static final int ELAPSED_DISK_IO_SYNCH = 417; // Disk I/O count during the elapsed time - synchronous I/O (job)
public static final int CONTROLLED_END_REQUESTED = 502; // End status
public static final int FUNCTION_NAME = 601; // Function name
public static final int FUNCTION_TYPE = 602; // Function type
public static final int INTERNAL_JOB_IDENTIFIER = 902; // Internal job identifier
public static final int ELAPSED_INTERACTIVE_RESPONSE_TIME = 904; // Interactive response time - total during the elapsed time
public static final int ELAPSED_INTERACTIVE_TRANSACTIONS = 905; // Interactive transactions - count during the elapsed time
public static final int JOB_USER_IDENTITY = 1012; // Job user identity
public static final int JOB_END_REASON = 1014; // Job end reason
public static final int JOB_LOG_PENDING = 1015; // Job log pending
public static final int JOB_TYPE_ENHANCED = 1016; // Job type - enhanced
public static final int MEMORY_POOL = 1306; // Memory pool name
public static final int MESSAGE_REPLY = 1307; // Message reply
public static final int MESSAGE_KEY = 1308; // Message key, when active job waiting for a message
public static final int MESSAGE_QUEUE = 1309; // Message queue name - qualified, when active job waiting for a message
public static final int MESSAGE_QUEUE_ASP = 1310; // Message queue library ASP device name, when active job waiting for a message
public static final int ELAPSED_PAGE_FAULTS = 1609; // Page fault count during the elapsed time (job)
public static final int RUN_PRIORITY = 1802; // Run priority (job)
public static final int SUBSYSTEM = 1906; // Subsystem description name - qualified
public static final int SERVER_TYPE = 1911; // Server type
public static final int SPOOLED_FILE_ACTION = 1982; // Spooled file action
public static final int THREAD_COUNT = 2008; // Thread count
public static final int TEMP_STORAGE_USED_LARGE = 2009; // Temporary storage used, in megabytes(from V7R2)
private String jobName;
private String jobUser;
private String jobNumber;
private String status;
private String jobType;
private String jobSubtype;
private String currentUser; // key 305
private String functionName; // key 601
private String functionType; // key 602
private String messageReply; // key 1307
private byte[] messageKey; // key 1308
private String qualMessageQueue; // key 1309
private String qualSubsystem; // key 1906
private TreeMap keyValues = new TreeMap(); // key others
public SubsystemJobListItem(String jobName, String jobUser, String jobNumber,
String status, String jobType,String jobSubtype, String currentUser, String functionName,
String functionType,
String messageReply, byte[] messageKey, String qualMessageQueue, String qualSubsystem) {
this.jobName = jobName;
this.jobUser = jobUser;
this.jobNumber = jobNumber;
this.status = status;
this.jobType = jobType;
this.jobSubtype = jobSubtype;
this.currentUser = currentUser;
this.functionName = functionName;
this.functionType = functionType;
this.messageReply = messageReply;
this.messageKey = messageKey;
this.qualMessageQueue = qualMessageQueue;
this.qualSubsystem = qualSubsystem;
}
public Object getObject(int key){
return keyValues.get(key);
}
public void setKeyValues(TreeMap keyValues){
this.keyValues = keyValues;
}
public String getJobName() {
return jobName;
}
public String getJobUser() {
return jobUser;
}
public String getJobNumber() {
return jobNumber;
}
public String getStatus() {
return status;
}
public String getJobType() {
return jobType;
}
public String getJobSubtype() {
return jobSubtype;
}
public String getCurrentUser() {
return currentUser;
}
public String getFunctionName() {
return functionName;
}
public String getFunctionType() {
return functionType;
}
public String getMessageReply() {
return messageReply;
}
public byte[] getMessageKey() {
return messageKey;
}
public String getQualMessageQueue() {
return qualMessageQueue;
}
public String getQualSubsystem() {
return qualSubsystem;
}
public String toString(){
StringBuffer strBuf = new StringBuffer();
strBuf.append(jobName).append("/");
strBuf.append(jobUser).append("/");
strBuf.append(jobNumber).append(",");
strBuf.append(status).append(",");
strBuf.append(jobType).append(",");
strBuf.append(jobSubtype).append(",");
strBuf.append("305=" + currentUser).append(",");
strBuf.append("601=" + functionName).append(",");
strBuf.append("602=" + functionType).append(",");
strBuf.append("1307=" + messageReply).append(",");
strBuf.append("1308(MSGKEY 4 bytes hex string)=" + BinaryConverter.bytesToHexString(messageKey)).append(",");
strBuf.append("1309=" + qualMessageQueue).append(",");
strBuf.append("1906=" + qualSubsystem);
if(keyValues.size() > 0){
Set set = keyValues.entrySet();
Iterator i = set.iterator();
while(i.hasNext()) {
Map.Entry me = (Map.Entry)i.next();
strBuf.append("," + me.getKey() + "=" + me.getValue());
}
}
return strBuf.toString();
}
}
File : SubsystemJobOpenList.java
///////////////////////////////////////////////////////////////////////////////
//
//
// Filename: SubsystemJobOpenList.java
//
// Author : Vengoal Chang
//
// Date : 2015/07/01
//
//
///////////////////////////////////////////////////////////////////////////////
package com.vengoal.as400.list;
import java.io.IOException;
import java.util.TreeMap;
import com.ibm.as400.access.AS400;
import com.ibm.as400.access.AS400Exception;
import com.ibm.as400.access.AS400SecurityException;
import com.ibm.as400.access.AS400Text;
import com.ibm.as400.access.BinaryConverter;
import com.ibm.as400.access.CharConverter;
import com.ibm.as400.access.ErrorCodeParameter;
import com.ibm.as400.access.ErrorCompletingRequestException;
import com.ibm.as400.access.Job;
import com.ibm.as400.access.ObjectDoesNotExistException;
import com.ibm.as400.access.ProgramCall;
import com.ibm.as400.access.ProgramParameter;
import com.ibm.as400.access.Trace;
import com.ibm.as400.access.list.OpenList;
/**
* Represents a list of subsystem jobs on the system with Open List of Jobs (QGYOLJOB) API.
* By default, following keys retrieved:
* keys_[0] = 305;
* keys_[1] = 601;
* keys_[2] = 602;
* keys_[3] = 1307;
* keys_[4] = 1308;
* keys_[5] = 1309;
* keys_[6] = 1906;
*
* List of Keys Supported for Format OLJB0300 reference:
* http://www-01.ibm.com/support/knowledgecenter/ssw_ibm_i_72/apis/qgyoljob.htm?lang=en
*
*/
public class SubsystemJobOpenList extends OpenList {
private String subsystem_;
private Job[] subsystemJobs_;
// Sort keys.
private int currentSortKey_ = 1;
// Info saved between calls to load() and getJobs().
private int numKeysReturned_;
private int[] keyFieldsReturned_;
private char[] keyTypesReturned_;
private int[] keyLengthsReturned_;
private int[] keyOffsetsReturned_;
// Keys to pre-load.
private int currentKey_ = 7;
private int[] keys_ = new int[currentKey_];
public SubsystemJobOpenList(AS400 system, String subsystem) {
super(system);
this.subsystem_ = subsystem;
// Figure out Job information default return key fields
keys_[0] = 305;
keys_[1] = 601;
keys_[2] = 602;
keys_[3] = 1307;
keys_[4] = 1308;
keys_[5] = 1309;
keys_[6] = 1906;
}
public void addJobAttributeToRetrieve(int attribute){
if (currentKey_ >= keys_.length){
// Resize.
int[] temp = keys_;
keys_ = new int[temp.length * 2];
System.arraycopy(temp, 0, keys_, 0, temp.length);
}
keys_[currentKey_++] = attribute;
}
public Job[] getSubsystemJobs(){
return subsystemJobs_;
}
@Override
protected byte[] callOpenListAPI() throws AS400SecurityException,
ErrorCompletingRequestException, InterruptedException, IOException,
ObjectDoesNotExistException {
if (Trace.isTraceOn()) Trace.log(Trace.DIAGNOSTIC, "Opening spooled file list.");
int lengthOfReceiverVariableDefinitionInformation = 4 + 20 * currentKey_;
byte[] keyOfFieldsToBeReturned = new byte[4 * currentKey_];
for (int i = 0; i < currentKey_; ++i)
{
BinaryConverter.intToByteArray(keys_[i], keyOfFieldsToBeReturned, i * 4);
}
// Figure out our sort information
byte[] sortInformation = new byte[4 + currentSortKey_ * 12];
BinaryConverter.intToByteArray(currentSortKey_, sortInformation, 0);
int fieldStartingPosition = 1;
int fieldLength = 10;
short dataType = (short)4;
BinaryConverter.intToByteArray(fieldStartingPosition, sortInformation, 4 );
BinaryConverter.intToByteArray(fieldLength, sortInformation, 8);
BinaryConverter.shortToByteArray(dataType, sortInformation, 12);
// Sort order 0xF1 = ascending, 0xF2 = descending.
sortInformation[14] = (byte)0xF1;
// Figure out our selection criteria.
byte[] jobSelectionInformation = new byte[206];
// Generate text objects based on system CCSID.
CharConverter conv = new CharConverter(system_.getCcsid(), system_);
for (int i = 0; i < 26; ++i) jobSelectionInformation[i] = 0x40;
String selectionJobName_ = "*ALL";
String selectionUserName_= "*ALL";
String selectionJobNumber_= "*ALL";
String selectionJobType_= "*";
conv.stringToByteArray(selectionJobName_.toUpperCase(), jobSelectionInformation, 0);
conv.stringToByteArray(selectionUserName_.toUpperCase(), jobSelectionInformation, 10);
conv.stringToByteArray(selectionJobNumber_, jobSelectionInformation, 20);
conv.stringToByteArray(selectionJobType_, jobSelectionInformation, 26);
int offset = 195;
int numberOfSubsystem = 1;
BinaryConverter.intToByteArray(offset, jobSelectionInformation, 76);
BinaryConverter.intToByteArray(numberOfSubsystem, jobSelectionInformation, 80);
// Subsystem name
AS400Text subsystemText = new AS400Text(10, system_);
byte[] subSystemBytes = subsystemText.toBytes(subsystem_);
System.arraycopy(subSystemBytes, 0, jobSelectionInformation, offset, 10);
offset += 10;
// Setup program parameters.
ProgramParameter[] parameters = new ProgramParameter[]
{
// Receiver variable, output, char(*).
new ProgramParameter(0),
// Length of receiver variable, input, binary(4).
new ProgramParameter(new byte[] { 0x00, 0x00, 0x00, 0x00 } ),
// Format name, input, char(8), EBCDIC 'OLJB0300'.
new ProgramParameter(new byte[] { (byte)0xD6, (byte)0xD3, (byte)0xD1, (byte)0xC2, (byte)0xF0, (byte)0xF3, (byte)0xF0, (byte)0xF0 } ),
// Receiver variable definition information, output, char(*).
new ProgramParameter(lengthOfReceiverVariableDefinitionInformation),
// Length of receiver variable definition information, input, binary(4).
new ProgramParameter(BinaryConverter.intToByteArray(lengthOfReceiverVariableDefinitionInformation)),
// List information, output, char(80).
new ProgramParameter(80),
// Number of records to return, input, binary(4).
// Special value '-1' indicates that "all records are built synchronously in the list".
new ProgramParameter(new byte[] { (byte)0xFF, (byte)0xFF, (byte)0xFF, (byte)0xFF } ),
// Sort information, input, char(*).
new ProgramParameter(sortInformation),
// Job selection information, input, char(*).
new ProgramParameter(jobSelectionInformation),
// Size of job selection information, input, binary(4).
new ProgramParameter(BinaryConverter.intToByteArray(jobSelectionInformation.length)),
// Number of fields to return, input, binary(4).
new ProgramParameter(BinaryConverter.intToByteArray(currentKey_)),
// Key of fields to be returned, input, array(*) of binary(4).
new ProgramParameter(keyOfFieldsToBeReturned),
// Error code, I/0, char(*).
new ErrorCodeParameter(),
// Job selection format name, input, char(8), EBCDIC 'OLJS0200'.
new ProgramParameter(new byte[] { (byte)0xD6, (byte)0xD3, (byte)0xD1, (byte)0xE2, (byte)0xF0, (byte)0xF2, (byte)0xF0, (byte)0xF0 } )
};
// Call the program.
ProgramCall pc = new ProgramCall(system_, "/QSYS.LIB/QGY.LIB/QGYOLJOB.PGM", parameters);
if (!pc.run())
{
throw new AS400Exception(pc.getMessageList());
}
// Key information returned.
byte[] defInfo = parameters[3].getOutputData();
numKeysReturned_ = BinaryConverter.byteArrayToInt(defInfo, 0);
keyFieldsReturned_ = new int[numKeysReturned_];
keyTypesReturned_ = new char[numKeysReturned_];
keyLengthsReturned_ = new int[numKeysReturned_];
keyOffsetsReturned_ = new int[numKeysReturned_];
offset = 4;
for (int i = 0; i < numKeysReturned_; ++i)
{
keyFieldsReturned_[i] = BinaryConverter.byteArrayToInt(defInfo, offset + 4);
keyTypesReturned_[i] = conv.byteArrayToString(defInfo, offset + 8, 1).charAt(0); // 'C' or 'B'
keyLengthsReturned_[i] = BinaryConverter.byteArrayToInt(defInfo, offset + 12);
keyOffsetsReturned_[i] = BinaryConverter.byteArrayToInt(defInfo, offset + 16);
offset += 20;
}
// List information returned.
return parameters[5].getOutputData();
}
@Override
protected Object[] formatOutputData(byte[] data, int recordsReturned, int recordLength)
throws AS400SecurityException, ErrorCompletingRequestException,
InterruptedException, IOException, ObjectDoesNotExistException {
int number = recordsReturned; // request entire list
CharConverter conv = new CharConverter(system_.getCcsid(), system_);
SubsystemJobListItem[] listItems = new SubsystemJobListItem[number];
subsystemJobs_ = new Job[number];
String currentUser = null;
String functionName = null;
String functionType = null;
String messageReply = null;
byte[] messageKey = null;
String qualMessageQueue = null;
String qualSubsystem = null;
TreeMap keyValues = new TreeMap();
for (int i = 0, offset = 0; i < listItems.length; ++i, offset += recordLength)
{
String jobName = conv.byteArrayToString(data, offset, 10);
String jobUser = conv.byteArrayToString(data, offset + 10, 10);
String jobNumber = conv.byteArrayToString(data, offset + 20, 6);
String status = conv.byteArrayToString(data, offset + 26, 4);
String jobType = conv.byteArrayToString(data, offset + 30, 1);
String jobSubtype = conv.byteArrayToString(data, offset + 31, 1);
for (int j = 0; j < numKeysReturned_; ++j)
{
int keyOffset = keyOffsetsReturned_[j];
if (keyTypesReturned_[j] == 'C')
{
String value = conv.byteArrayToString(data, offset + keyOffset, keyLengthsReturned_[j]);
if(keyFieldsReturned_[j] == 305 ) currentUser = value;
if(keyFieldsReturned_[j] == 601 ) functionName = value;
if(keyFieldsReturned_[j] == 602 ) functionType = value;
if(keyFieldsReturned_[j] == 1307) messageReply = value;
if(keyFieldsReturned_[j] == 1309) qualMessageQueue = value;
if(keyFieldsReturned_[j] == 1906) qualSubsystem = value;
if(keyFieldsReturned_[j] == 1308)
{
byte[] msgKey = new byte[4];
System.arraycopy(data, offset + keyOffset, msgKey, 0, 4);
messageKey = msgKey;
}
if(j > 6){
if(keyFieldsReturned_[j] == 312 || keyFieldsReturned_[j] == 313 ||
keyFieldsReturned_[j] == 315 || keyFieldsReturned_[j] == 317 ||
keyFieldsReturned_[j] == 414 || keyFieldsReturned_[j] == 415 ||
keyFieldsReturned_[j] == 416 || keyFieldsReturned_[j] == 417 ||
keyFieldsReturned_[j] == 1609)
keyValues.put(keyFieldsReturned_[j], new Long(BinaryConverter.byteArrayToLong(data, offset + keyOffset))) ;
else
keyValues.put(keyFieldsReturned_[j], value) ;
}
}
else
{
if ((keyFieldsReturned_[j] == Job.TEMP_STORAGE_USED_LARGE))
keyValues.put(keyFieldsReturned_[j], new Long(BinaryConverter.byteArrayToUnsignedInt(data, offset + keyOffset))) ;
else
keyValues.put(keyFieldsReturned_[j], new Integer(BinaryConverter.byteArrayToInt(data, offset + keyOffset))) ;
}
}
listItems[i] = new SubsystemJobListItem(jobName, jobUser, jobNumber,
status, jobType,jobSubtype, currentUser, functionName, functionType,
messageReply, messageKey, qualMessageQueue, qualSubsystem);
subsystemJobs_[i] = new Job(this.getSystem(), jobName, jobUser, jobNumber);
listItems[i].setKeyValues(keyValues);
}
return listItems;
}
@Override
protected int getBestGuessReceiverSize(int number) {
return 300 * number;
}
}
File : SubsystemJobOpenListTest.java
//////////////////////////////////////////////////////////////////////////////
//
//
// Filename: SubsystemJobOpenListTest.java
//
// Author : Vengoal Chang
//
// Date : 2015/07/01
//
//
///////////////////////////////////////////////////////////////////////////////
package com.vengoal.as400.list;
import java.util.Enumeration;
import com.ibm.as400.access.AS400;
import com.ibm.as400.access.CallStackEntry;
import com.ibm.as400.access.Job;
import com.vengoal.as400.common.MessageUtil;
public class SubsystemJobOpenListTest {
public static void main(String[] args) {
AS400 as400 = new AS400("as400ip", "user", "pass");
String subsystem = "QBATCH";
SubsystemJobOpenList list = new SubsystemJobOpenList(as400, subsystem);
list.addJobAttributeToRetrieve(SubsystemJobListItem.MEMORY_POOL);
list.addJobAttributeToRetrieve(SubsystemJobListItem.RUN_PRIORITY);
list.addJobAttributeToRetrieve(SubsystemJobListItem.DATE_ENTERED_SYSTEM);
list.addJobAttributeToRetrieve(SubsystemJobListItem.JOB_LOG_PENDING);
list.addJobAttributeToRetrieve(SubsystemJobListItem.JOB_TYPE_ENHANCED);
list.addJobAttributeToRetrieve(SubsystemJobListItem.SPOOLED_FILE_ACTION);
list.addJobAttributeToRetrieve(SubsystemJobListItem.THREAD_COUNT);
list.addJobAttributeToRetrieve(SubsystemJobListItem.CPU_TIME_USED_LARGE);
list.addJobAttributeToRetrieve(SubsystemJobListItem.ELAPSED_CPU_PERCENT_USED);
list.addJobAttributeToRetrieve(SubsystemJobListItem.ELAPSED_CPU_TIME_USED);
list.addJobAttributeToRetrieve(SubsystemJobListItem.ELAPSED_PAGE_FAULTS);
list.addJobAttributeToRetrieve(SubsystemJobListItem.DISK_IO);
list.addJobAttributeToRetrieve(SubsystemJobListItem.ELAPSED_DISK_IO_ASYNCH);
list.addJobAttributeToRetrieve(SubsystemJobListItem.ELAPSED_DISK_IO_SYNCH);
try {
list.open();
Enumeration items = list.getItems();
while (items.hasMoreElements())
{
SubsystemJobListItem item = (SubsystemJobListItem)items.nextElement();
System.out.println(item);
if(item.getMessageReply().equalsIgnoreCase(Job.MESSAGE_REPLY_WAITING)){
System.out.println(MessageUtil.getErrMsgTxtWithAPI(as400, item.getMessageKey(), item.getQualMessageQueue()));
Job msgwJob = new Job(as400, item.getJobName(), item.getJobUser(), item.getJobNumber());
CallStackEntry[] callstackEntry = msgwJob.getCallStack(Job.INITIAL_THREAD);
System.out.println("job call stack as following:");
for(int i = 0; i< callstackEntry.length; ++i){
//System.out.println(callstackEntry[i].getProgramLibrary() + "/" + callstackEntry[i].getProgramName() + " " + callstackEntry[i].getProcedureName());
}
}
System.out.println("Spooled file action=" + item.getObject(SubsystemJobListItem.SPOOLED_FILE_ACTION));
System.out.println("====================================");
}
Job[] subsystemJobs = list.getSubsystemJobs();
if(subsystemJobs != null){
for(int i =0; i < subsystemJobs.length; ++i){
// do your work related job
System.out.println(subsystemJobs[i].getNumber() + "/" + subsystemJobs[i].getUser() + "/" + subsystemJobs[i].getName());
}
} else {
System.out.println("Subsystem " + subsystem + " is inactive or not exist");
}
list.close();
} catch (Exception e) {
e.printStackTrace();
}
}
}
參照: Open List of Jobs (QGYOLJOB) API
2015-06-08 如何讓 WRKACTJOB 畫面中欄位 Function 更容易明瞭？(Command CHGFUNCNAM -- Change Function Name with QWCCCJOB Change Current Job API)
如何讓 WRKACTJOB 畫面中欄位 Function 更容易明瞭？(Command CHGFUNCNAM -- Change Function Name with QWCCCJOB Change Current Job API)
File : QCLSRC
Member: CHGFUNCNAM
Type : CLP
Usage : CRTCLPGM PGM(CHGFUNCNAM)
/*-------------------------------------------------------------------*/
/* */
/* Program . . : CHGFUNCNAM */
/* Description : Change function name */
/* with Change Current Job (QWCCCJOB) API */
/* which support change function name from V6R1 */
/* Author . . : Vengoal Chang */
/* Published . : AS400ePaper */
/* Date . . . : June 8, 2015 */
/* */
/* */
/* Program function: Change function name command allows you to */
/* change the description of the Function field */
/* on WRKACTJOB to provide a better description */
/* of what a job is doing. */
/* */
/* The value on WRKACTJOB would appear as */
/* USR-xxxx where xxxx is the 10 bytes specified */
/* on CHGFUNCNAM. */
/* */
/* This program expects a single parameter */
/* specifying the function name. */
/* */
/* */
/* Compile options: */
/* CrtClPgm Pgm( CHGFUNCNAM ) */
/* SrcFile( QCLSRC ) */
/* SrcMbr( *PGM ) */
/* */
/*-------------------------------------------------------------------*/
Pgm &FuncName
Dcl &FuncName *Char 10
Dcl &ChgInf *Char 22
MonMsg CPF0000 *N GoTo Error
ChgVar %Bin( &ChgInf 1 4 ) 1
ChgVar %Bin( &ChgInf 5 4 ) 3 /* Function name */
ChgVar %Bin( &ChgInf 9 4 ) 10 /* 10 byte */
Chgvar %Sst( &ChgInf 13 10 ) &FuncName
Call QWCCCJOB ( &ChgInf x'0000000000000000' )
Return
/*-- Error handling: -----------------------------------------------*/
Error:
Call QMHMOVPM ( ' ' +
'*DIAG' +
x'00000001' +
'*PGMBDY' +
x'00000001' +
x'0000000800000000' +
)
Call QMHRSNEM ( ' ' +
x'0000000800000000' +
)
EndPgm:
EndPgm
File : QCMDSRC
Member: CHGFUNCNAM
Type : CMD
Usage : CrtCmd Cmd( CHGFUNCNAM )
Pgm( CHGFUNCNAM )
SrcFile( YourSourceFile )
Allow( *IPgm *BPgm )
/* =============================================================== */
/* = Command....... ChgFuncNam = */
/* = CPP........... ChgfuncNam CLP = */
/* = Description... Change Function Name = */
/* = = */
/* = = */
/* = CrtCmd Cmd( ChgFuncNam ) = */
/* = Pgm( ChgFuncNam ) = */
/* = SrcFile( YourSourceFile ) = */
/* = Allow( *IPgm *BPgm ) = */
/* =============================================================== */
/* = Date : 2015/06/08 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
Cmd Prompt('Change Function Name')
Parm FuncName *Char 10 +
Prompt('Function name')
File : QCLSRC
Member: CHGFUNCTST
Type : CLLE
Usage : CrtCmd Cmd( CHGFUNCTST )
Pgm( CHGFUNCTST )
SrcFile( YourSourceFile )
SbmJob Cmd( Call CHGFUNCTST)
Job( CHGFUNCTST )
WRKACTJOB press F10 see the job CHGFUNCTST Function name
will change STEP1, STEP2, STEP1, STEP2 ...
/*-------------------------------------------------------------------*/
/* */
/* Program . . : CHGFUNCTST */
/* Description : Change function name Test */
/* Author . . : Vengoal Chang */
/* Published . : AS400ePaper */
/* Date . . . : June 8, 2015 */
/* */
/* */
/* Program function: Change function name command test */
/* */
/* */
/* Compile options: */
/* CrtBndCl Pgm( CHGFUNCTST ) */
/* SrcFile( QCLSRC ) */
/* SrcMbr( *PGM ) */
/* */
/*-------------------------------------------------------------------*/
Pgm
Dcl &SleepSec *Int
ChgVar &SleepSec 1
Loop:
ChgFuncNam FuncName(STEP1)
CallPrc PRC('sleep') Parm((&SleepSec *ByVal))
ChgFuncNam FuncName(STEP2)
CallPrc PRC('sleep') Parm((&SleepSec *ByVal))
Goto Loop
EndPgm
參照: Change Current Job (QWCCCJOB) API
2015-06-05 如何監控系統中執行狀態為 MSGW 的工作，並傳送訊息至 MSGQ 或 Email？(Command CHKJOBMSGW -- Check Job Message Wait with QGYOLJOB Open list of jobs API)
如何監控系統中執行狀態為 MSGW 的工作，並傳送訊息至 MSGQ 或 Email？(Command CHKJOBMSGW -- Check Job Message Wait with QGYOLJOB Open list of jobs API)
File : QRPGLESRC
Member: CHKJOBMSGW
Usage : CRTBNDRPG PGM(CHKJOBMSGW)
**
** Program . . : CHKJOBMSGW
** Description : Check job msgw and send msgw info to msgq or mail
** Author . . : Vengoal Chang
** Published . : AS400ePaper
** Date . . . : June 5, 2015
**
**
** 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 jobname first
**
** 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.
**
** QMHRTVM Retrieve Message Retrieves the message description
** of a predefined message.
**
** 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:
** _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 list jobs API input parameters are initialized
**
** 2. The open list of jobs API is called
**
** 3. For each job get key data
** 101 Active job status
** 305 Current user profile
** 1307 Message reply
** 1308 Message key, when active job waiting for a message
** 1309 Message queue name - qualified, when active job waiting for a message
** 1906 Subsystem description name - qualified
**
** List job name and check whether job waiting message or not.
** If job wait for a reply to a message, send message to user
** which run the CHKJOBMSGW program.
**
** 4. The job list resources are cleaned up.
**
** 5. Sleep wakeup interval, then go to step 2. lsit msgw job
**
**
**
** Programmer's notes:
** To retrieve another job's call stack *JOBCTL special authority is
** required.
**
**
** Compile options:
**
** CrtBndPgm Pgm( CHKJOBMSGW )
**
**-- Control spec: -----------------------------------------------------**
H Option( *SrcStmt ) DecEdit( *JobRun ) BndDir( 'QC2LE' )
H DftActGrp(*NO) Debug
**-- 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( 6 )
**-- Job information OLJB0300:
D*JlJobInf0300 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
**-- Job information OLJB0200:
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 JbJobIntId 16a
D JbJobSts 10a
D JbJobTyp 1a
D JbJobSubTyp 1a
D 2a
D JbJobInfoSts 1a
D 3a
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 SiJobTyp 1a Inz( '*' )
D 1a
D SiOfsPriSts 10i 0 Inz(108 )
D SiNbrPriSts 10i 0 Inz( 1 )
D SiOfsActSts 10i 0 Inz(118 )
D SiNbrActSts 10i 0 Inz( 1 )
D SiOfsJbqSts 10i 0 Inz(126 )
D SiNbrJbqSts 10i 0 Inz( 0 )
D SiOfsJbqNam 10i 0 Inz(136 )
D SiNbrJbqNam 10i 0 Inz( 0 )
D SiOfsCurUsr 10i 0 Inz(156 )
D SiNbrCurUsr 10i 0 Inz( 0 )
D SiOfsSvrTyp 10i 0 Inz(166 )
D SiNbrSvrTyp 10i 0 Inz( 0 )
D SiOfsActSbs 10i 0 Inz(196 )
D SiNbrActSbs 10i 0 Inz( 0 )
D SiOfsMemPol 10i 0 Inz(206 )
D SiNbrMemPol 10i 0 Inz( 0 )
D SiOfsJobTypE 10i 0 Inz(210 )
D SiNbrJobTypE 10i 0 Inz( 0 )
D SiOfsQualJob 10i 0 Inz(214 )
D SiNbrQualJob 10i 0 Inz( 0 )
**
D SiPriSts 10a Dim( 1 )
D SiActSts 4a Dim( 2 )
D SiJbqSts 10a Dim( 1 )
D SiJbqNam 20a Dim( 1 )
D SiCurUsr 10a Dim( 1 )
D SiSvrTyp 30a Dim( 1 )
D SiActSbs 10a Dim( 1 )
D SiMemPol 10i 0 Dim( 1 )
D SiJobTypEn 10i 0 Dim( 1 )
D SiQualJob 26 Dim( 1 )
**-- Job information key fields:
D JbKeyDta Ds
D JbCurUSr 10
D JbMsgRpy 1
D JbMsgKeyRpy 4
D JbMsgQRpy 20
D JbQualSbs 20
**-- General return data:
D JlGenDta Ds
D GdBytRtn 10i 0
D GdBytAvl 10i 0
D GdElpTim 20u 0
D 16a
**-- 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
*** Prototypes for external subprocedures:
D Cmd PR ExtPgm('QCMDEXC')
D command 4096A OPTIONS(*VARSIZE) CONST
D length 15P 5 const
D tmpnam PR * extproc('_C_IFS_tmpnam')
D string 39A options(*omit)
D filename S 40A Varying
D fd S 10I 0
D CRLF S 2 INZ(X'0D25')
**-- Receive non-program message:
D RcvMsg Pr ExtPgm( 'QMHRCVM' )
D RcvVar 65535a Options( *VarSize )
D RcvVarLen 10i 0 Const
D FmtNam 10a Const
D MsgQueQ 20a Const
D MsgTyp 10a Const
D MsgKey 4a Const
D Wait 10i 0 Const
D MsgAct 10a Const
D Error 32767a Options( *VarSize )
D CcsId 10i 0 Const Options( *NoPass )
D AlwDftRpyRjt 10i 0 Const Options( *NoPass )
**-- Message information structure:
D RCVM0200 Ds Qualified
D BytRtn 10i 0
D BytAvl 10i 0
D MsgSev 10i 0
D MsgId 7a
D MsgTyp 2s 0
D MsgKey 4a
D MsgFilNam 10a
D MsgFilLib_s 10a
D MsgFilLib_u 10a
D SndJobNam 10a
D SndJobUsr 10a
D SndJobNbr 6a
D SndPgmNam 12a
D 4a
D DatSnt 7s 0
D TimSnt 6s 0
D TimSntMs 6s 0
D SndUsrPrf 10a
D 1a
D CcsIdStsTxt 10i 0
D CcsIdStsDta 10i 0
D AlrOpt 9a
D CcsIdMsgTxt 10i 0
D CcsIdMsgDta 10i 0
D DtaLenRtn 10i 0
D DtaLenAvl 10i 0
D MsgLenRtn 10i 0
D MsgLenAvl 10i 0
D HlpLenRtn 10i 0
D HlpLenAvl 10i 0
D VarDta 32767a
**
**
D MsqNam_q Ds
D ObjNam 10a
D LibNam 10a
D DateSentC S 19
D DateSent Ds 13
D DateSnt 7s 0
D TimeSnt 6s 0
D SentYY 2 overlay(DateSent:2)
D SentMM 2 overlay(DateSent:4)
D SentDD 2 overlay(DateSent:6)
D SentHH 2 overlay(DateSent:8)
D SentMin 2 overlay(DateSent:10)
D Sentss 2 overlay(DateSent:12)
**-- Global variables: -------------------------------------------------**
D PgmNam s 20a
D MsgDta s 256a Varying
D MsgKey s 4a
D MsgTyp s 10a
D Subject s 60a
D PgmJob s 100a
D MsgTxt s 1024a Varying
D MsgHlpTxt s 1024a Varying
D SecLvlMsgTxt s 2048a Varying
D SecLvl s 4096a Varying
D MailText s 2048a Varying
D tempText s 2048a
D Ix s 5i 0
D Offset s 5i 0
D Pos s 5i 0
D CmdStr S 4096
D QualMsgQ S 20
D SecLvlFmt s 78a Dim( 64 )
D MsgTxtFmt s 78a Dim( 64 )
D NbrLinMsg s 5i 0
D NbrLinSec s 5i 0
D LinIdx s 5i 0
D SysDts s z
D Idx s 5i 0
D IfsCcsid s 10U 0
**-- Global constants:
D OFS_MSGDTA c 16
D JOB_CCSID c 0
D RPY_SENT c '2'
D TYP_INQ c 5
D TYP_RPY c 21
D MSG_TXT c '&N Message . . . . : '
D RPY_DTA c 'Reply . . . . . : '
D NO_WAIT c 0
D KEEP_STS c '*SAME'
D NULL c ''
D WAIT_MAX c -1
D OLD_STS c '*OLD'
D QUOTE C X'7D'
D* Flags for use in open()
D O_RDWR C 4
D* Create File if not exist
D O_CREAT C 8
D* Exclusively create
D O_EXCL C 16
D* Assign a CCSID
D O_CCSID C 32
D* Truncate File to 0 bytes
D O_TRUNC C 64
D* Writing Only
D O_WRONLY C 2
D O_TEXTDATA C 16777216
D* Note: O_TEXT_CREAT requires all of the following flags to work:
D* O_CREAT+O_TEXTDATA+(O_CODEPAGE or O_CCSID)
D O_TEXT_CREAT C 33554432
D* owner authority
D S_IRUSR C 256
D S_IWUSR C 128
D*--------------------------------------------------------------------
D* Open a File
D open PR 10I 0 ExtProc('open')
D filename * value options(*string)
D openflags 10I 0 value
D mode 10U 0 value options(*nopass)
D codepage 10U 0 value options(*nopass)
D txtcreatid 10U 0 value options(*nopass)
D*--------------------------------------------------------------------
D* Close a file
D close PR 10I 0 ExtProc('close')
D handle 10I 0 value
D*--------------------------------------------------------------------
D* Remove Link to File.
D unlink PR 10I 0 ExtProc('unlink')
D path * Value options(*string)
D*--------------------------------------------------------------------
D* Write to a file
D write PR 10I 0 ExtProc('write')
D handle 10I 0 value
D buffer * value
D bytes 10U 0 value
**-- Retrieve message:
D RtvMsg Pr ExtPgm( 'QMHRTVM' )
D RcvVar 32767a Options( *VarSize )
D RcvVarLen 10i 0 Const
D FmtNam 10a Const
D MsgId 7a Const
D MsgFil_q 20a Const
D MsgDta 512a Const Options( *VarSize )
D MsgDtaLen 10i 0 Const
D RplSubVal 10a Const
D RtnFmtChr 10a Const
D Error 32767a Options( *VarSize )
D RtvOpt 10a Const Options( *NoPass )
D CvtCcsId 10i 0 Const Options( *NoPass )
D RplCcsId 10i 0 Const Options( *NoPass )
**-- Retrieve second level help text:
D RtvSecLvl Pr 4096a Varying
D PxMsgFil_q 20a Const
D PxMsgId 7a Const
D PxMsgDta 4096a Const Varying
**-- Format message string:
D FmtMsgStr Pr 78a Dim( 64 )
D PxMsgStr 4096a Value Varying
D PxNbrLin 5i 0
**-- Format message line:
D FmtMsgLin Pr 78a
D PxMsgLin 82a Const Varying
D PxPrcLen 5i 0
D PxInzInd n Options( *NoPass )
**-- Find format instruction:
D FndFmtIns Pr 5u 0
D PxMsgLin 82a Const Varying
D PxOffSet 5u 0 Const Options( *NoPass )
**-- Get indent positions:
D GetIndPos Pr 5u 0
D PxFmtIns 2a Const
D PxInxNxt 5u 0
**-- Scan reverse:
D ScanR Pr 5u 0
D PxArg 128a Const Varying
D PxString 4096a Const Varying
D PxOfs 5u 0 Const Options( *NoPass )
**-- Check AS400 Object exist ?
D As400ObjFound PR N
D QlObjName 20 Value
D ObjType 10 Value
**-- Send escape message:
D SndEscMsg Pr 10i 0
D PxMsgId 7a Const
D PxMsgF 10a Const
D PxMsgDta 512a Const Varying
**-- Send program message:
D SndPgmMsg Pr ExtPgm( 'QMHSNDPM' )
D MsgId 7a Const
D MsgFq 20a Const
D MsgDta 128a Const
D MsgDtaLen 10i 0 Const
D MsgTyp 10a Const
D CalStkE 10a Const Options( *VarSize )
D CalStkCtr 10i 0 Const
D MsgKey 4a
D Error 1024a Options( *VarSize )
**
**-- Mainline: ---------------------------------------------------------**
**
C *Entry Plist
C Parm WakeUp 5 0
C Parm Mail 4
C Parm MsgQ 4
C Parm ToMail 32
C IfsCcsid Parm CltCCSID 5 0
C Parm ToMsgQ 20
C If MsgQ = '*YES'
C CallP As400ObjFound( ToMsgQ : '*MSGQ' )
C EndIf
C Eval SiPriSts(1) = '*ACTIVE'
C Eval SiActSts(1) = 'MSGW'
**-- Job information return fields:
C Eval JlKeyFld(1) = 101
C Eval JlKeyFld(2) = 305
C Eval JlKeyFld(3) = 1307
C Eval JlKeyFld(4) = 1308
C Eval JlKeyFld(5) = 1309
C Eval JlKeyFld(6) = 1906
**
**-- Sort field specification:
C Eval SiNbrKeys = 1
C Eval SiKeyFldOfs(1) = 1
C Eval SiKeyFldLen(1) = 10
C Eval SiKeyFldTyp(1) = 4
C Eval SiSrtOrd(1) = '1'
C Eval SiRsv(1) = x'00'
**
C DoW 1 = 1
**
**-- Retrieve job list:
C CallP LstJobs( JlJobInf
C : %Size( JlJobInf )
C : 'OLJB0200'
C : JlKeyInf
C : %Size( JlKeyInf )
C : JlLstInf
C : 1
C : JlSrtInf
C : JlSltInf
C : %Size( JlSltInf )
C : JlNbrFldRtn
C : JlKeyFld
C : ApiError
C : 'OLJS0200'
C : JOB_KEEP_STAT
C : JlGenDta
C : %Size( JlGenDta )
C )
**
C If AeBytAvl = *Zero
**
C DoW LiLstSts <> '2' Or
C LiRcdNbrTot > JlRtnRcdNbr
**
C ExSr GetKeyDta
**
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 )
**
**-- Wait 10 seconds:
C CallP sleep( WakeUp )
**
C Reset JlLstInf
C Eval JlRtnRcdNbr = 1
C Else
C Leave
C EndIf
C EndDo
C If AeBytAvl > *Zero
C CallP SndEscMsg( AeExcpId
C : 'QCPFMSG'
C : %Subst( AeExcpDta: 1: AeBytAvl- 16 )
C )
C EndIf
**
C Eval *InLr = *On
**
C Return
**
**-- Get KEY data: -----------------------------------------------------**
C GetKeyDta BegSr
**
C Clear JbKeyDta
**
C For Ix = 1 To KiFldNbrRtn
**
C Select
C When KiKeyFld(Ix) = 305
C CallP memcpy( %Addr( JbCurUsr )
C : %Addr( JlJobInf ) +
C KiDtaOfs(Ix)
C : KiDtaLen(Ix)
C )
**
C When KiKeyFld(Ix) = 1307
C CallP memcpy( %Addr( JbMsgRpy )
C : %Addr( JlJobInf ) +
C KiDtaOfs(Ix)
C : KiDtaLen(Ix)
C )
**
C When KiKeyFld(Ix) = 1308
C CallP memcpy( %Addr( JbMsgKeyRpy )
C : %Addr( JlJobInf ) +
C KiDtaOfs(Ix)
C : KiDtaLen(Ix)
C )
**
C When KiKeyFld(Ix) = 1309
C CallP memcpy( %Addr( JbMsgQRpy )
C : %Addr( JlJobInf ) +
C KiDtaOfs(Ix)
C : KiDtaLen(Ix)
C )
**
C When KiKeyFld(Ix) = 1906
C CallP memcpy( %Addr( JbQualSbs )
C : %Addr( JlJobInf ) +
C KiDtaOfs(Ix)
C : KiDtaLen(Ix)
C )
C EndSl
C EndFor
**
C If JbMsgRpy = '1'
C Eval PgmNam = GetTopStkE( JbJobId )
C If MsgQ = '*YES'
C Exsr SndCmpMsg
C EndIf
C If Mail = '*YES'
C Exsr GetMsgTxt
C Exsr SndMailAtch
C EndIf
C EndIf
**
C EndSr
**-- Get Message Text: -------------------------------------------------**
C GetMsgTxt BegSr
**
C Eval MsgTyp = '*INQ'
C Eval MsgKey = JbMsgKeyRpy
C Eval MsqNam_q= JbMsgQRpy
C CallP RcvMsg( RCVM0200
C : %Size( RCVM0200 )
C : 'RCVM0200'
C : MsqNam_q
C : MsgTyp
C : MsgKey
C : NO_WAIT
C : OLD_STS
C : ApiError
C : JOB_CCSID
C )
C If RCVM0200.MsgFilLib_u=*Blanks
C eval RCVM0200.MsgFilLib_u=RCVM0200.MsgFilLib_s
C EndIf
C Eval MsgDta = %Subst( RCVM0200.VarDta
C : 1
C : RCVM0200.DtaLenRtn
C )
C eval MsgTxt = %Subst( RCVM0200.VarDta
C : RCVM0200.DtaLenRtn + 1
C : RCVM0200.MsgLenRtn
C )
C If RCVM0200.MsgId = *Blanks
C eval MsgTxt = MsgDta
C Else
C eval SecLvl = RtvSecLvl( RCVM0200.MsgFilNam +
C RCVM0200.MsgFilLib_u
C : RCVM0200.MsgId
C : MsgDta
C )
C eval SecLvlFmt=FmtMsgStr( SecLvl: NbrLinSec )
C eval SecLvlMsgTxt = *Blanks
C For idx = 1 to 64
C If %len(%trimr(SecLvlFmt(idx))) > 0
C If %Subst(SecLvlFmt(idx):1:2) <> 'Ca' and
C %Subst(SecLvlFmt(idx):1:2) <> 'Re'
C eval %Subst(SecLvlFmt(idx):1:2) = ' '
C EndIf
C eval SecLvlMsgTxt = %trimr(SecLvlMsgTxt) +
C SecLvlFmt(idx) + CRLF
C Else
C leave
C EndIf
C EndFor
C EndIf
C
C EndSr
**-- Send completion message: ------------------------------------------**
C SndCmpMsg BegSr
**
C Eval QualMsgQ = PsCurUsr + '*LIBL'
C If MsgQ <> *Blanks
C Eval QualMsgQ = ToMsgQ
C EndIf
C Eval MsgDta = 'Program ' +
C %Trim(%SubSt(PgmNam:11:10)) +
C '/' +
C %Trim(%SubSt(PgmNam: 1:10)) +
C ' in job ' +
C %Trim( JbNbrUsd ) + '/' +
C %Trim( JbUsrUsd ) + '/' +
C %Trim( JbJobUsd ) +
C ' waiting for a message' +
C ' in Msgq ' +
C %Trim(%SubSt(JbMsgQRpy:11:10))+
C '/' +
C %Trim(%SubSt(JbMsgQRpy:1:10))+
C '.'
**
C CallP(e) SndMsg( *Blanks
C : *Blanks
C : MsgDta
C : %Len( MsgDta )
C : '*COMP'
C : QualMsgQ
C : 1
C : *Blanks
C : MsgKey
C : 0
C )
**
C EndSr
**-- Send mail message with attach file: -------------------------------**
c SndMailAtch BegSr
c Eval DateSnt = RCVM0200.DatSnt
c Eval TimeSnt = RCVM0200.TimSnt
c Eval DateSentC = '20' + SentYY + '-' +
c SentMM + '-' + SentDD + '-' +
c SentHH + ':' + SentMIN+ ':' +
c SentSS
C Eval PgmJob = 'Program ' +
C %Trim(%SubSt(PgmNam:11:10)) +
C '/' +
C %Trim(%SubSt(PgmNam: 1:10)) +
C ' error in job ' +
C %Trim( JbNbrUsd ) + '/' +
C %Trim( JbUsrUsd ) + '/' +
C %Trim( JbJobUsd )
C Eval MailText =
C %trim(PgmJob) + CRLF +
C 'Time sent: '+DateSentc+' '+
C CRLF +
C 'Message ID: ' +
C RCVM0200.MsgId + CRLF +
C 'Message: ' + %trim(MsgTxt) +
C CRLF + CRLF
C* Eval filename = %str(tmpnam(*OMIT))
C Eval filename = '/tmp/' +
C 'Error_'+ %trim(JbJobUsd) +
C '_' + %trim(JbUsrUsd) +
C '_' + %trim(JbNbrUsd) +
C '.TXT'
C callp unlink(filename)
C
C Eval fd = open( filename
C : O_CREAT + O_CCSID+ O_WRONLY
C + O_TEXT_CREAT + O_TEXTDATA
C : S_IRUSR + S_IWUSR
C : IfsCcsid
C : 0 )
C
C if fd = -1
C* open failed, check errno for the reason why.
C endif
C callp write(fd: %addr(MailText)+2
C : %len(%trim(MailText)))
C
C If %len(SecLvlMsgTxt) > 0
C callp write(fd: %addr(SecLvlMsgTxt)+2
C : %len(%trim(SecLvlMsgTxt)))
C EndIf
C callp close(fd)
C
C Eval Subject = 'AS400 program ' +
C %Trim(%SubSt(PgmNam:11:10)) +
C '/' +
C %Trim(%SubSt(PgmNam: 1:10)) +
C ' exception occurred.'
C EVAL cmdSTR = 'SNDSMTPEMM RCP(' +
C %trim(ToMail) +
C ') SUBJECT(' + QUOTE +
C %trim(Subject) +
C QUOTE + ') NOTE(' +
C QUOTE +
C %trim( MailText) +
C QUOTE + ') ATTACH(' +
C QUOTE +
C %trim(filename) +
C QUOTE + ')'
C* ' CONTENT(*HTML)'
C callp(e) Cmd(%trim(cmdStr) : %len(%trim(cmdstr)))
C callp unlink(filename)
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 %SubSt(CsPgmNam:1:1) <> 'Q'
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
**-- Retrieve second level help text:
P RtvSecLvl B
D Pi 4096a Varying
D PxMsgFil_q 20a Const
D PxMsgId 7a Const
D PxMsgDta 4096a Const Varying
**-- Message information structure:
D RTVM0100 Ds Qualified
D BytRtn 10i 0
D BytAvl 10i 0
D RtnMsgLen 10i 0
D RtnMsgAvl 10i 0
D RtnHlpLen 10i 0
D RtnHlpAvl 10i 0
D Msg 4096a
**
D RPL_SUB_VAL c '*YES'
D INC_FMT_CTL c '*YES'
/Free
RtvMsg( RTVM0100
: %Size( RTVM0100 )
: 'RTVM0100'
: PxMsgId
: PxMsgFil_q
: PxMsgDta
: %Len( PxMsgDta )
: RPL_SUB_VAL
: INC_FMT_CTL
: ApiError
);
If AeBytAvl > *Zero;
Return NULL;
Else;
Return %Subst( RTVM0100.Msg
: RTVM0100.RtnMsgLen + 1
: RTVM0100.RtnHlpLen
);
EndIf;
/End-Free
P RtvSecLvl E
**-- Format message string:
P FmtMsgStr B
D Pi 78a Dim( 64 )
D PxMsgStr 4096a Value Varying
D PxNbrLin 5i 0
**-- Local variables:
D InzInd s n Inz( *On )
D LinIdx s 5i 0
D PrcLen s 5i 0
D StrPos s 10i 0 Inz( 1 )
D RtnFmt s 78a Dim( 64 )
/Free
If PxMsgStr > *Blanks;
For LinIdx = 1 To %Elem( RtnFmt );
RtnFmt(LinIdx) = FmtMsgLin( %TrimL( PxMsgStr ): PrcLen: InzInd );
If %Len( %TrimL( PxMsgStr )) > PrcLen;
PxMsgStr = %Subst( %TrimL( PxMsgStr ): PrcLen + 1 );
Else;
Leave;
EndIf;
If PxMsgStr = *Blanks;
Leave;
EndIf;
EndFor;
EndIf;
PxNbrLin = LinIdx;
Return RtnFmt;
/End-Free
P FmtMsgStr E
**-- Format message line:
P FmtMsgLin B
D Pi 78a
D PxMsgLin 82a Const Varying
D PxPrcLen 5i 0
D PxInzInd n Options( *NoPass )
**-- Local variables:
D IndPos s 5u 0 Inz( 1 ) Static
D IndNxt s 5u 0 Inz( 1 ) Static
D StrLen s 5u 0
D FmtPos s 5u 0
D FmtIns s 2a
D FmtBeg s n
D LeadBlk s 10i 0
**
D MsgLin Ds Qualified
D LstPos 1a Overlay( MsgLin: 78 )
D NxtPos 1a Overlay( MsgLin: 79 )
/Free
If %Parms = 3 And PxInzInd = *On;
Reset IndPos;
Reset IndNxt;
PxInzInd = *Off;
EndIf;
FmtBeg = *Off;
FmtPos = FndFmtIns( PxMsgLin );
If FmtPos > *Zero;
FmtIns = %Subst( PxMsgLin: FmtPos: 2 );
If FmtPos = 1;
FmtBeg = *On;
IndPos = GetIndPos( FmtIns: IndNxt );
FmtPos = FndFmtIns( PxMsgLin: 4 );
If FmtPos > *Zero;
%Subst( MsgLin: IndPos ) = %Subst( PxMsgLin: 4: FmtPos - 4 );
Else;
%Subst( MsgLin: IndPos ) = %Subst( PxMsgLin: 4 );
EndIf;
Else;
%Subst( MsgLin: IndPos ) = %Subst( PxMsgLin: 1: FmtPos - 1 );
EndIf;
Else;
%Subst( MsgLin: IndPos ) = %Subst( PxMsgLin: 1 );
EndIf;
LeadBlk = %Check( ' ': MsgLin );
If LeadBlk > *Zero;
LeadBlk -= IndPos;
EndIf;
IndPos = IndNxt;
If MsgLin.LstPos = *Blank Or MsgLin.NxtPos = *Blank;
StrLen = %Size( MsgLin ) - 1;
Else;
StrLen = ScanR( ' ': MsgLin ) - 1;
If StrLen = *Zero;
StrLen = %Size( MsgLin ) - 1;
EndIf;
EndIf;
MsgLin = %Subst( MsgLin: 1: StrLen );
If FmtBeg = *On;
PxPrcLen = %Len( %Trim( MsgLin )) + 3 + LeadBlk;
Else;
PxPrcLen = %Len( %Trim( MsgLin )) + 1 + LeadBlk;
EndIf;
Return MsgLin;
/End-Free
P FmtMsgLin E
**-- Find format instruction:
P FndFmtIns B
D Pi 5u 0
D PxMsgLin 82a Const Varying
D PxOffSet 5u 0 Const Options( *NoPass )
**-- Local variables:
D FmtPosN s 5u 0
D FmtPosP s 5u 0
D FmtPosB s 5u 0
D OffSet s 5u 0
/Free
If %Parms = 2;
OffSet = PxOffSet;
Else;
OffSet = 1;
EndIf;
FmtPosN = %Scan( '&N': PxMsgLin: OffSet );
FmtPosP = %Scan( '&P': PxMsgLin: OffSet );
FmtPosB = %Scan( '&B': PxMsgLin: OffSet );
If FmtPosN = *Zero;
FmtPosN = *HiVal;
EndIf;
If FmtPosP = *Zero;
FmtPosP = *HiVal;
EndIf;
If FmtPosB = *Zero;
FmtPosB = *HiVal;
EndIf;
Select;
When FmtPosN < FmtPosP And
FmtPosN < FmtPosB;
Return FmtPosN;
When FmtPosP < FmtPosN And
FmtPosP < FmtPosB;
Return FmtPosP;
When FmtPosB < FmtPosN And
FmtPosB < FmtPosP;
Return FmtPosB;
EndSl;
Return *Zero;
/End-Free
P FndFmtIns E
**-- Get inden positions:
P GetIndPos B
D Pi 5u 0
D PxFmtIns 2a Const
D PxIndNxt 5u 0
/Free
Select;
When PxFmtIns = '&N';
PxIndNxt = 3;
Return 1;
When PxFmtIns = '&P';
PxIndNxt = 3;
Return 5;
When PxFmtIns = '&B';
PxIndNxt = 5;
Return 3;
Other;
PxIndNxt = 0;
Return 0;
EndSl;
/End-Free
P GetIndPos E
**-- Scan reverse:
P ScanR B
D Pi 5u 0
D PxArg 128a Const Varying
D PxString 4096a Const Varying
D PxOfs 5u 0 Const Options( *NoPass )
**
D Pos s 5u 0
D Ofs s 5u 0
/Free
If %Parms = 3;
Ofs = PxOfs - %Len( PxArg ) + 1;
Else;
Ofs = %Len( PxString ) - %Len( PxArg ) + 1;
EndIf;
If Ofs > %Len( PxString );
Pos = %Len( PxString ) + 1;
Else;
For Pos = Ofs DownTo 1;
If %SubSt( PxString: Pos: %Len( PxArg )) = PxArg;
Leave;
EndIf;
EndFor;
EndIf;
Return Pos;
/End-Free
P ScanR E
** As400ObjFound - Attempts to locate an AS/400 object
P As400ObjFound B
D As400ObjFound PI N
D QlObjName 20 Value
D ObjType 10 Value
* Local variables and prototypes
D RtvObjDesc PR ExtPgm( 'QUSROBJD' )
D RcvrVar 8
D LenRcvrVar 10I 0 Const
D FmtName 8 Const
D QlObjName 20 Const
D ObjType 10 Const
D ApiErrInf Like( ApiError )
D Rcvr S 8
* Invoke the QUSROBJD API to attempt to locate the object
C CallP RtvObjDesc( Rcvr:
C %Size( Rcvr ):
C 'OBJD0100':
C QlObjName:
C ObjType:
C ApiError )
* If the API returns any error at all, I assume we were unable to
* locate the object.
C If AeBytAvl > *Zero
C CallP SndEscMsg( AeExcpId
C : 'QCPFMSG'
C : %Subst( AeExcpDta: 1: AeBytAvl- 16 )
C )
C Return *Off
C Else
C Return *On
C EndIf
P As400ObjFound E
**-- Send escape message: ----------------------------------------------**
P SndEscMsg B
D Pi 10i 0
D PxMsgId 7a Const
D PxMsgF 10a Const
D PxMsgDta 512a Const Varying
**
D MsgKey s 4a
D MsgFQual s 20a
C If %SubSt(PxMsgId: 1: 3) = 'GUI'
C eval %SubSt(MsgFQual : 1: 10) = 'QGUIMSG'
C Else
C eval %SubSt(MsgFQual : 1: 10) = PxMsgF
C EndIf
C eval %SubSt(MsgFQual :11: 10) = '*LIBL'
C Callp SndPgmMsg( PxMsgId
C : MsgFQual
C : PxMsgDta
C : %Len( PxMsgDta )
C : '*ESCAPE'
C : '*PGMBDY'
C : 1
C : MsgKey
C : ApiError
C )
C If AeBytAvl > *Zero
C Return -1
C
C Else
C Return 0
C EndIf
P SndEscMsg E
File : QCMDSRC
Member: CHKJOBMSGW
Usage : CrtCmd Cmd( CHKJOBMSGW )
Pgm( CHKJOBMSGW )
SrcFile( YourSourceFile )
/* =============================================================== */
/* = Command....... ChkJobMsgw = */
/* = CPP........... ChkJobMsgw RPGLE = */
/* = Description... Check job message waiting and send = */
/* = notification to msgq or detail info to mail = */
/* = or both = */
/* = = */
/* = CrtCmd Cmd( ChkJobMsgw ) = */
/* = Pgm( ChkJobMsgw ) = */
/* = SrcFile( YourSourceFile ) = */
/* =============================================================== */
/* = Date : 2015/06/05 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
/* = Usage: = */
/* = Notification send to MsgQ QSYSOPR : = */
/* = SBMJOB CMD(CHKJOBMSGW WAKEUP(600)) = */
/* = JOB(CHKJOBMSGW) = */
/* = JOBQ(QSYSNOMAX) = */
/* = = */
/* = Notification send to Mail with attachement by SNDSMTPEMM = */
/* = SBMJOB CMD(CHKJOBMSGW WAKEUP(600) = */
/* = MAIL(*YES) = */
/* = MSGQ(*NO ) = */
/* = TOMAIL('user@domain') = */
/* = CLTCCSID(819) = */
/* = ) = */
/* = JOB(CHKJOBMSGW) = */
/* = JOBQ(QSYSNOMAX) = */
/* = = */
/* =============================================================== */
Cmd Prompt('Check Job Message Wait')
Parm WAKEUP *Dec (5 0) +
Dft(300) +
Prompt('Wakeup interval for the batch')
Parm MAIL *Char 4 +
Dft(*NO) +
Values(*YES *NO) +
Rstd(*YES) +
Prompt('Send to mail')
Parm MSGQ *Char 4 +
Dft(*YES) +
Values(*YES *NO) +
Rstd(*YES) +
Prompt('Send to MsgQ')
Parm TOMAIL *Char 32 +
PmtCtl(IFMAIL) +
Prompt('Notification send to email')
Parm CLTCCSID *Dec (5 0) +
PmtCtl(IFMAIL) +
Dft(950) +
Prompt('Client ccsid for mail used')
Parm TOMSGQ +
Type( Qual2) +
PmtCtl(IFMSGQ) +
Prompt('Notification send to MsgQ')
QUAL2: Qual Type(*NAME) +
Dft(QSYSOPR) +
Expr(*YES)
Qual Type(*NAME) +
Dft(*LIBL) +
SpcVal((*LIBL) (*CURLIB)) +
Expr(*YES) +
Prompt('Library')
IFMAIL: PmtCtl Ctl(MAIL) Cond((*EQ *YES))
IFMSGQ: PmtCtl Ctl(MSGQ) Cond((*EQ *YES))
Dep Ctl(&MAIL *EQ *YES) +
Parm((&TOMAIL *NE ' ')) +
NbrTrue(*EQ 1)
Dep Ctl(&MAIL *EQ *NO) +
Parm((&MSGQ *NE *NO)) +
NbrTrue(*EQ 1)
參照: Open List of Jobs (QGYOLJOB) API
訂閱：
文章 (Atom)