close
如何監控系統中執行狀態為 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)
文章標籤
全站熱搜
留言列表
