CMD RTVJOBCMD: CMD PROMPT('Retrieve job commands') PARM KWD(JOB) TYPE(JOB) DFT(*) SNGVAL((*)) + PROMPT('Job name') JOB: QUAL TYPE(*NAME) LEN(10) QUAL TYPE(*CHAR) LEN(10) PROMPT('User') QUAL TYPE(*CHAR) LEN(6) RANGE('000000' '999999') + PROMPT('Number') CLP RTVJOBCMD: /* Retrieve commands from joblog */ /* Uses APIs to retrieve messages sent to *EXT */ /* and extracts only the request messages */ /* then places them in the source file in QTEMP */ /* the intention is to capture commands in a */ /* source file that you can use later for */ /* inclusion in a CL program */ PGM &PJOB DCL &PJOB *CHAR 26 DCL &TIME *CHAR 6 DCL &DATE *CHAR 6 DCL &MBR *CHAR 10 DCL &MSG *CHAR 80 DCL &TEXT *CHAR 50 DCL &JOB *CHAR 10 DCL &USER *CHAR 10 DCL &NBR *CHAR 6 DCL &SPC_SIZE *CHAR 4 X'00004098' /* 16kb */ DCL &SPC_VAL *CHAR 1 X'00' DCL &ERR_SIZE *CHAR 4 X'00000010' /* 16 bytes */ DCL &ERR_AVAIL *CHAR 4 DCL &ERR_ID *CHAR 7 DCL &ERR_RES *CHAR 1 DCL &ERR *CHAR 16 /* Create the source file */ RTVSYSVAL QTIME &TIME RTVSYSVAL QDATE &DATE IF (&PJOB *EQ '*') + RTVJOBA JOB(&JOB) USER(&USER) NBR(&NBR) ELSE DO CHGVAR &JOB %SST(&PJOB 01 10) CHGVAR &USER %SST(&PJOB 11 10) CHGVAR &NBR %SST(&PJOB 21 06) ENDDO CHGVAR &MBR ('CL' *CAT &TIME) CHGVAR &TEXT ('Cmds from ' *CAT + &NBR *CAT + '/' *CAT + &USER *TCAT + '/' *CAT + &JOB *TCAT + ' on ' *CAT + &DATE *CAT + ' at ' *CAT + &TIME) CRTDUPOBJ OBJ(QCLSRC) FROMLIB(QGPL) OBJTYPE(*FILE) + TOLIB(QTEMP) NEWOBJ(JOBCLSRC) MONMSG CPF0000 RMVM QTEMP/QCLSRC *ALL MONMSG CPF0000 ADDPFM QTEMP/JOBCLSRC + MBR(&MBR) + SRCTYPE(CL) + TEXT(&TEXT) MONMSG CPF0000 EXEC(CLRPFM QTEMP/JOBCLSRC &MBR) /* Initialise error return structure */ CHGVAR &ERR (&ERR_SIZE *CAT + &ERR_AVAIL *CAT + &ERR_ID *CAT + &ERR_RES) /* Delete space; ignore errors */ CALL QUSDLTUS PARM('RTVJOBCMD QTEMP ' + &ERR ) /* Create 16KB space to hold temp results */ CALL QUSCRTUS ('RTVJOBCMD QTEMP ' + 'JOBLOG ' + &SPC_SIZE + &SPC_VAL + '*LIBCRTAUT' + 'RTVJOBCMD API work area') OVRDBF QCLSRC QTEMP/JOBCLSRC MBR(&MBR) CALL RTVJOBCMDR &PJOB CHGVAR &MSG ('Commands from job are in JOBCLSRC in QTEMP, mbr ' *CAT + &MBR) SNDPGMMSG &MSG + TOPGMQ(*PRV) + MSGTYPE(*INFO) DLTOVR *ALL RCLRSC ENDPGM RPGLE RTVJOBCMDR: F* EXTRACT COMMANDS FROM LIST JOB MESSAGES API F* The CL program creates a user space to hold the F* job messages, and a source file to put them in. FQCLSRC O E DISK F RENAME(QCLSRC:SRCREC) D/SPACE 3 D* Data Structure for API: General Header for User Space D* Format: N/A D* D GENDS DS INZ D USRARA 1 64 D SIZHDR 65 68B 0 D RLSLVL 69 72 D FMTNAM 73 80 D APIUSE 81 90 D DATTIM 91 103 D INFSTS 104 104 D SIZUSE 105 108B 0 D OFFINP 109 112B 0 D SIZINP 113 116B 0 D OFFHDR 117 120B 0 D SIZHD1 121 124B 0 D OFFLST 125 128B 0 D SIZLST 129 132B 0 D NUMLST 133 136B 0 D SIZENT 137 140B 0 D**************************************************************** D* * D* DATA STRUCTURE FOR API: QMHLJOBL * D* FORMAT: LJOB0100 * D* LANGUAGE: RPG * D* * D**************************************************************** D HEADER DS INZ D SPCNMH 1 10 D SPCLBH 11 20 D STRKYH 21 24 D ENDKYH 25 28 D JOBNMH 29 38 D USRPRH 39 48 D JOBNBH 49 54 D CCSIDH 55 56 D RESERV 57 60B 0 D LSTHDR DS INZ D BGNOFF 1 4B 0 D FLDOFF 5 8B 0 D NUMFLD 9 12B 0 D MSGSEV 13 16B 0 D MSGID 17 23 D MSGTYP 24 25 D MSGKEY 26 29 D MSGF 30 39 D MSGFLB 40 49 D DATSNT 50 56 D TIMSNT 57 62 D LSTRSV 63 64 D LSTDTA DS INZ D NXTDTA 1 4B 0 D DTAIDL 5 8B 0 D DTAID 9 12B 0 D DTATYP 13 13 D DTASTS 14 14 D DTARSV 15 28 D DTALEN 29 32B 0 D M 33 9999 D DIM(9967) D* Error return code D ERRRTC DS INZ D ERRSIZ 1 4B 0 D ERRAVL 5 8B 0 D ERRID 9 15 D ERRRES 16 16 D* User space name D SPC DS INZ D SPCN 1 10 D SPCL 11 20 D* Message select criteria D MSGSEL DS INZ D MMSGMA 1 4B 0 D MLSTDI 5 14 D MJOBNA 15 40 D MINTJO 41 56 D MSTRKE 57 60B 0 D MMAXMS 61 64B 0 D MMAXMH 65 68B 0 D MFLDOF 69 72B 0 D MFLDNU 73 76B 0 D MQUEOF 77 80B 0 D MQUELE 81 84B 0 D MIDMSG 85 88B 0 D MCALQU 89 92 D* Misc binary variables D DS INZ D MSGSLE 1 4B 0 D SSTART 5 8B 0 D SLEN 9 12B 0 D OFFSET 13 16B 0 C *ENTRY PLIST C PARM PJOB 26 C* Size of error variable C Z-ADD 16 ERRSIZ C* Message select criteria C Z-ADD -1 MMSGMA C MOVEL(P) '*NEXT' MLSTDI C MOVEL(P) '*' MJOBNA C MOVEL(P) PJOB MJOBNA C Z-ADD 0 MSTRKE C Z-ADD 9967 MMAXMS C Z-ADD -1 MMAXMH C Z-ADD 84 MFLDOF C Z-ADD 1 MFLDNU C Z-ADD 88 MQUEOF C Z-ADD 4 MQUELE C Z-ADD 0302 MIDMSG C MOVEL '* ' MCALQU C* Name of space to hold list C MOVEL 'RTVJOBCM' SPCN C CAT 'D':0 SPCN C MOVEL(P) 'QTEMP' SPCL C* Put job messages in user space C* C MOVEL 'LJOB0100' MFORMA 8 C MOVEL 'JSLT0100' MRETFO 8 C Z-ADD 92 MSGSLE C* C CALL 'QMHLJOBL' C PARM SPC C PARM MFORMA C PARM MSGSEL C PARM MSGSLE C PARM MRETFO C PARM ERRRTC C* Determine how many entries, C* where they begin C* by examining the generic header C* C Z-ADD 1 SSTART C Z-ADD 140 SLEN C* C CALL 'QUSRTVUS' C PARM SPC C PARM SSTART C PARM SLEN C PARM GENDS C PARM ERRRTC C* Point to the header (in case we need the last msg key) C OFFHDR ADD 1 SSTART C Z-ADD SIZHD1 SLEN C* C CALL 'QUSRTVUS' C PARM SPC C PARM SSTART C PARM SLEN C PARM HEADER C PARM ERRRTC C* Working offset will be changed in the loop C Z-ADD OFFLST OFFSET C/EJECT C* Extract messages from user space 1 at a time C DO NUMLST C* Point to the list header C OFFSET ADD 1 SSTART C Z-ADD 64 SLEN C* C CALL 'QUSRTVUS' C PARM SPC C PARM SSTART C PARM SLEN C PARM LSTHDR C PARM ERRRTC C* C Z-ADD BGNOFF OFFSET C* Message types 08 and 10 are request messages C* C* Point to the list data C FLDOFF ADD 1 SSTART C Z-ADD 9999 SLEN C* C CALL 'QUSRTVUS' C PARM SPC C PARM SSTART C PARM SLEN C PARM LSTDTA C PARM ERRRTC C* Trim the bad data from the message C DTALEN ADD 1 L 5 0 C MOVEA *BLANKS M(L) C* Split long lines into multiple records C 1 DO 9967 L C* C L IFGT DTALEN C LEAVE C ENDIF C* C L ADD 75 R 5 0 C MOVEA(P) M(L) THIS 75 C R IFGT 9967 C MOVE *BLANKS NEXT C ELSE C MOVEA(P) M(R) NEXT 75 C ENDIF C* C THIS IFNE *BLANKS C ADD 1 SRCSEQ C MOVEL(P) THIS SRCDTA C NEXT IFNE *BLANKS C CAT '-':0 SRCDTA C ENDIF C WRITE SRCREC C ENDIF C* C ENDDO 75 C* C ENDDO C* C SETON LR