and the end * tag into any member name (your choice) * in file QRPGLESRC member type RPGLE. CRTBNDRPG to compile. * NOTE: You need extract the install program only once, this same program * will install any upload on this page. * * 3. Call the install program (or execute XmlPrevew) passing these 3 parms. * 'your-member-name you uploaded this text into' * 'your-source-file-name the member is in' * 'your-library-name the source file is in' * * The various source members will be extracted and the objects required * for the application will be created in your-library-name. * * Members in this install: (to view or manually extract members, scan * Martin Rowe scripting cmd prompts * David George intellectual input * Thomas Raddatz command mode/where allowed * * Use xml tags in text to trigger: * 1. Parse text into source members (create srcfile & member if required). * 2. Compile source into objects. * 3. Send installation progress user messages. * 4. Execute qcmdexc as required. * * This program is free software, you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation. See GNU General Public License for details *--------------------------------------------------------------------------------------------- Fxmlinput if f 112 disk usropn uploaded text Fqxxxsrc o f 112 disk usropn parsed out * * create parm prototypes D qusrmbrd PR ExtPgm('QUSRMBRD') MEMBER DESCRIPTION Db like(vrcvar) RCVR D 10i 0 const RCVR LEN D 8 const TYPE D 20 const FILE LIB D 10 MBR NAME D 1 const OVERRIDE? Db like(vApiErrDS) * D qmhsndpm PR ExtPgm('QMHSNDPM') SEND MESSAGES D 7 ID D 20 const FILE Db like(qm_msgtxt) TEXT D 10i 0 const LENGTH D 10 const TYPE D 10 QUEUE D 10i 0 const STACK ENTRY D 4 const KEY Db like(vApiErrDS) * D qcmdexc PR ExtPgm('QCMDEXC') D 500A options(*varsize) D 15P 5 Const *-------------------------------------------------------------------- D vrcvar s 145 D qm_msgid s 7 D qm_msgtxt s 65 D qm_msgq s 10 D qm_msgtyp s 10 D mbrname s 10 D mbrtype s 10 D mbrtext s 50 D srcfile s 10 D srclen s 5 D srccssid s 5 D bldexc s 500 D write_flag s 1n inz(*off) D srcSeqno s 6s 2 inz(0) D aa s 5u 0 inz(0) D ll s 5u 0 inz(0) D qs c '''' * Error return code parm for APIs. D vApiErrDs ds D vbytpv 10i 0 inz(%size(vApiErrDs)) bytes provided D vbytav 10i 0 inz(0) bytes returned D vmsgid 7 error msgid D vresvd 1 reserved D vrpldta 50 replacement data *-------------------------------------------------------------------- Ixmlinput ns I 13 21 xmltag1 I 18 27 xmltag2 I 13 112 xmlcode *-------------------------------------------------------------------- C *entry plist C parm ParseSrcMbr 10 source member C parm ParseSrcFile 10 source file C parm ParseSrcLib 10 source lib * xmlpreview uses this parm to redirect to user selected source file. optional C parm OvrSrcFile 10 override to source C exsr srValidate make sure exists * Set user selected library *first for remainder of program C eval bldexc = 'RMVLIBLE LIB('+ C %trimr(ParseSrcLib) + ')' C callp(e) qcmdexc(bldexc:%len(%trimr(bldexc))) C eval bldexc = 'ADDLIBLE LIB('+ C %trimr(ParseSrcLib) + ') POSITION(*FIRST)' C callp(e) qcmdexc(bldexc:%len(%trimr(bldexc))) * * Override Input file to uploaded text file C eval bldexc = 'OVRDBF FILE(XMLINPUT) TOFILE(' + C %trimr(ParseSrcLib)+'/'+ C %trimr(ParseSrcFile) + ') MBR(' + C %trimr(ParseSrcMbr) + ')' C callp qcmdexc(bldexc:%len(%trimr(bldexc))) C open xmlinput C read xmlinput 1B C dow not %eof * write records to outfile if flag is on 2B C select 2X C when write_flag = *on 3B C if xmltag2<>'' C eval srcSeqno=srcSeqno+1 C except write_one 3X C else C eval write_flag=*off C close qxxxsrc 3E C endif * Extract values based on xml tags. 2X C when xmltag1 = 'mbrname =' C eval mbrname = %subst(xmlcode:13:10) 2X C when xmltag1 = 'mbrtype =' C eval mbrtype =%subst(xmlcode:13:10) 2X C when xmltag1 = 'mbrtext =' C eval mbrtext =%subst(xmlcode:13:50) 2X C when xmltag1 = 'srcfile =' 3B C if %parms=4 xmlpreview override C eval srcfile=OvrSrcFile 3X C else C eval srcfile =%subst(xmlcode:13:10) 3E C endif 2X C when xmltag1 = 'srclen =' 3B C if %parms=4 xmlpreview override C eval srclen='00112' 3X C else C eval srclen =%subst(xmlcode:13:5) 3E C endif 2X C when xmltag1 = 'srccssid=' C eval srccssid=%subst(xmlcode:13:5) * Start of data to copy. Create source files/mbrs as required. 2X C when xmltag1='' * crtsrcpf C eval bldexc = 'CRTSRCPF FILE(' + C %trimr(ParseSrcLib)+'/'+ C %trimr(srcfile) + ') RCDLEN(' + C srclen + ') CCSID(' + C srccssid + ')' C callp(e) qcmdexc(bldexc:%len(%trimr(bldexc))) * addpfm C eval bldexc = 'ADDPFM FILE(' + C %trimr(ParseSrcLib)+'/'+ C %trimr(srcfile) + ') MBR(' + C %trimr(mbrname) + ') SRCTYPE(' + C %trimr(mbrtype) + ') TEXT(' + C qs+%trimr(mbrtext)+qs + ')' C callp(e) qcmdexc(bldexc:%len(%trimr(bldexc))) 3B C if %error * chgpfm C eval bldexc = 'CHGPFM FILE(' + C %trimr(ParseSrcLib)+'/'+ C %trimr(srcfile) + ') MBR(' + C %trimr(mbrname) + ') TEXT(' + C qs+%trimr(mbrtext)+qs + ')' C callp qcmdexc(bldexc:%len(%trimr(bldexc))) * clr mbr C eval bldexc = 'CLRPFM FILE(' + C %trimr(ParseSrcLib)+'/'+ C %trimr(srcfile) + ') MBR(' + C %trimr(mbrname) + ')' C callp qcmdexc(bldexc:%len(%trimr(bldexc))) 3E C endif * ovr to outfile mbr C eval bldexc = 'OVRDBF QXXXSRC ' + C %trimr(ParseSrcLib) + '/' + C %trimr(srcfile) + ' ' + C mbrname C callp qcmdexc(bldexc:%len(%trimr(bldexc))) C clear srcSeqno C open qxxxsrc C eval write_flag = *on *-------------------------------------------------------------------- * Compile statement. Read next record and execute it. * The subroutine TolibToken will replace &tolib with the * library the user has selected at run time. 2X C when xmltag1 = '' C read xmlinput C eval bldexc = %trimr(xmlcode) C exsr TolibToken C callp qcmdexc(bldexc:%len(%trimr(bldexc))) *-------------------------------------------------------------------- * qcmdexc statement. Build statement from each record between start * and stop tags. When stop tag is found, execute statement. * if dltxxx command, allow errors to be ignored. 2X C when xmltag1 = '' C clear bldexc C eval aa=1 C read xmlinput 3B C dow xmltag2<>'' C eval %subst(bldexc:aa:100)=xmlcode C eval aa=aa+100 C read xmlinput 3E C enddo C exsr TolibToken 3B C if %subst(bldexc:1:3)='DLT' C callp(e) qcmdexc(bldexc:%len(%trimr(bldexc))) 3X C else C callp qcmdexc(bldexc:%len(%trimr(bldexc))) 3E C endif *-------------------------------------------------------------------- * Send messages to user as program executes * Extract message ID, Message Type, from * read a record and get the single line of message text. 2X C when xmltag1 = '0 C eval bldexc=%replace(%trimr(ParseSrcLib):bldexc: C aa:6) C eval aa=%scan('&tolib':bldexc) 1E C enddo * if user has selected to override source files, reset SRCFILE parm in bldexcs. 1B C if %parms=4 xmlpreview override C eval aa=%scan('SRCFILE(':bldexc) 2B C if aa>0 C eval aa=%scan('/':bldexc:aa) 3B C if aa>0 C eval ll=%scan(')':bldexc:aa) C eval bldexc=%replace(%trimr(OvrSrcFile):bldexc: C aa+1:ll-(aa+1)) 3E C endif 2E C endif 1E C endif C endsr *-------------------------------------------------------------------- * Check of file, lib, member exist. C srValidate begsr C callp QUSRMBRD( C vrcvar: C 145: C 'MBRD0100': C ParseSrcFile + ParseSrcLib: C ParseSrcMbr: C '0': C vapierrds) * -------------------------------------------------------------------------------- * If error occurred on call, send appropriate message back to user. 1B C if vBytav>0 error occurred 2B C select * lib not found 2X C when vmsgid = 'CPF9810' C eval qm_msgtxt = '0000 Library ' + C %trimr(ParseSrcLib) + ' was not found.' * src file not found 2X C when vmsgid = 'CPF9812' C eval qm_msgtxt = '0000 Source file ' + C %trimr(ParseSrcFile)+' was not found in ' + C %trimr(ParseSrcLib) + '.' * member not found 2X C when vmsgid = 'CPF9815' C eval qm_msgtxt = '0000 Member ' + C %trimr(ParseSrcMbr)+' was not found in ' + C %trimr(ParseSrcLib)+'/'+ %trimr(ParseSrcFile) * unexpected 2X C other C eval qm_msgtxt = '0000 Unexpected message ' + C vmsgid + ' received. ' 2E C endsl * send message C eval qm_msgid = 'CPD0006' C eval qm_msgtyp = '*DIAG' C eval qm_msgq = '*CTLBDY' C exsr srSndMessage C eval qm_msgtxt = *blanks C eval qm_msgid = 'CPF0002' C eval qm_msgtyp = '*ESCAPE' C exsr srSndMessage C eval *inlr=*on C return 1E C endif C endsr *-------------------------------------------------------------------- C srSndMessage begsr C callp QMHSNDPM( C qm_msgid: C 'QCPFMSG *LIBL ': C qm_msgtxt: C %size(qm_msgtxt): C qm_msgtyp: C qm_msgq: C 1: C ' ': C vApiErrDS) C endsr Oqxxxsrc e write_one O srcSeqno 6 O 12 '000000' O xmlcode 112 * /// END OF INSTALL PGM HERE /// do not copy past this point ********** /// ]]> * This program is free software, you can redistribute it and/or modify it under the terms * of the GNU General Public License as published by the Free Software Foundation. * * 11/13/2001 Luca Brignoli (luca.brignoli@volvo.com) * added array lookup to only load unique commands to screen. *---------------------------------------------------------------- * program summary: * call api to load job log messages to user space * use pointers to get offset information * only show valid commands * load and display subfile of executed commands *---------------------------------------------------------------- * api (application program interfaces) used: * quscrtus create user space * qusptrus retrieve pointer to user space * qmhljobl list job log messages * qmhsndpm send program messages *---------------------------------------------------------------- Fcmdlogd cf e workstn F sfile(data:rrn) D uSpaceName s 20 inz('JCRCMDS QTEMP ') D rrn s 5u 0 D mMsgRtv ds inz D mMsgRtvLen 9 12i 0 length msg retrieved D mMsgMessage 25 256 message retrieved D mMsgLen s 10i 0 inz(%len(mMsgRtv)) length of message * * Arrays LUCA D CmdList s 500 dim(1000) LUCA D CmdCounter s 5u 0 LUCA D CmdP s 5u 0 LUCA * *---------------------------------------------------------------- * Get user space list info from header section. *---------------------------------------------------------------- D ds based(uHeadPtr) D uOffSetToList 125 128i 0 offset to list D uNumOfEntrys 133 136i 0 number list entries D uSizeOfEntry 137 140i 0 list entry size * D uListEntry1 ds Based(uListPtr ) D uOffsetToNext 10i 0 overlay(uListEntry1:1) D uOffsetToFlds 10i 0 overlay(uListEntry1:5) D uNumFldsRetrnd 10i 0 overlay(uListEntry1:9) D uMsgSeverity 10i 0 overlay(uListEntry1:12) D uMsgId 7a overlay(uListEntry1:17) D uMsgType 2a overlay(uListEntry1:24) D uMsgKey 4a overlay(uListEntry1:26) D uMsgFileName 10a overlay(uListEntry1:30) D uMsgFileLib 10a overlay(uListEntry1:40) * * these fields repeat for each key selected. D uListEntry2 ds Based(uListPtr2) D u2OffsetToNext 10i 0 D u2LengthOfFlds 10i 0 D u2IdentifierF 10i 0 D u2TypeOfData 1a D u2StatOfData 1a D u2Reserved 14a D u2LengthOfData 10i 0 D u2Data 500 *---------------------------------------------------------------- * Error return code parm for APIs. *---------------------------------------------------------------- D vApiErrDs ds D vbytpv 10i 0 inz(%size(vApiErrDs)) bytes provided D vbytav 10i 0 inz(0) bytes returned D vmsgid 7a error msgid D vresvd 1a reserved D vrpldta 50a replacement data * *---------------------------------------------------------------- * Message selection data structure. *---------------------------------------------------------------- D MsgSelectDS ds D msMaxMsgRequested... D 10i 0 inz(1000) overlay(msgSelectDS:1) num of msg requested D msListDirection... D 10a inz('*PRV') overlay(msgSelectDS:5) List direction D msQualifiedJobName... D 10a inz('*') overlay(msgSelectDS:15) * = current job D msQualifiedUserName... D 10a inz(' ') overlay(msgSelectDS:25) = current job D msQualifiedJobNumber... D 6a inz(' ') overlay(msgSelectDS:35) = current job D msInternalJobIdentifier... D 16a inz(' ') overlay(msgSelectDS:41) = current job D msStartingMessageKey... D 4a inz(x'FFFFFFFF') start newest message D overlay(msgselectDS:57) D msMaxMsgLength... D 10i 0 inz(500) overlay(msgSelectDS:61) id 301,302 lengths D msMaxMsgHelpLength... D 10i 0 inz(100) overlay(msgSelectDS:65) id 401,402,403,404 D msOffsetToIdentifiersOfFieldstoReturn... D 10i 0 inz(84) overlay(msgSelectDS:69) to start of array D msNumberOfFieldsToReturn... D 10i 0 inz(1) overlay(msgSelectDS:73) D msOffsetToCallMsgQname... D 10i 0 inz(88) overlay(msgSelectDS:77) D msLengthOfCallMsgQname... D 10i 0 inz(1) overlay(msgSelectDS:81) D msIndentifiersOfFieldsToReturn... D 10i 0 inz(0301) overlay(msgSelectDS:85) D msCallMessageQueueName... D 1a inz('*') overlay(msgSelectDS:89) *--------------------------------------------------------------------------------------------- * Create Prototypes for calls *--------------------------------------------------------------------------------------------- D quscrtus PR ExtPgm('QUSCRTUS') create user space D 20 Space Name D 10 const Extended Attrb D 10i 0 const length of space D 1 const Hex0Init D 10 const Use Authority D 50 const text D 10 const replace object Db like(vApiErrDS) error parm * ------------------------------------------------------------- D qmhrtvm PR ExtPgm('QMHRTVM') RETRIEVE MESSAGE D 256 message retrieved D 10i 0 length of message D 8 const requested format D 7 msg identifier D 20 const qualified msgf name D 128 const replacement data D 10i 0 const len of replace data D 10 const substitution char D 10 const format control char Db like(vApiErrDs) * ------------------------------------------------------------- D system PR 10I 0 extproc('system') D i_cmd * value options(*string) * D EXCP_MSGID S 7A import('_EXCP_MSGID') * ------------------------------------------------------------- D qmhljobl PR ExtPgm('QMHLJOBL ') list job log messags D 20 Space Name D 8 const format name Db like(MsgSelectDS) D 10i 0 const LENGTH D 8 const format of msgselect Db like(vApiErrDS) error parm * ------------------------------------------------------------- D qusptrus PR ExtPgm('QUSPTRUS') retrieve pointer D 20 Space Name D * pointer Db like(vApiErrDS) error parm * ------------------------------------------------------------- D qmhsndpm PR ExtPgm('QMHSNDPM') SEND MESSAGES D 7 const ID D 20 const FILE D 73 const TEXT D 10i 0 const LENGTH D 10 const TYPE D 10 const QUEUE D 10i 0 const STACK ENTRY D 4 const KEY Db like(vApiErrDS) * ------------------------------------------------------------- D qcmdchk PR ExtPgm('QCMDCHK') D 500A D 15P 5 Const * ------------------------------------------------------------- D main PR extpgm('CMDLOGR ') D main PI *---------------------------------------------------------------- * Create user space C callp QUSCRTUS( CREATE USER SPC C uSpaceName: CREATE USER SPC C 'TEST': EXTENDED ATRIB C 1500000: SIZE IN BYTES C x'00': INITIAL VALUE C '*ALL': AUTHORITY C 'User Space JCR ': TEXT C '*NO': REPLACE OBJ C vApiErrDs) ERROR * Get pointer to user space C callp QUSPTRUS( GET POINTER TO SPACE C uSpaceName: SPACE LIB C uHeadPtr: pointer to header C vApiErrDs) error * call api to load job log into user space. C callp QMHLJOBL( LIST JOB LOG C uSpaceName: USR SPACE C 'LJOB0100': TYPE FORMAT C MsgSelectDS: DS C %len(MsgSelectDS): C 'JSLT0100': C vApiErrDs) * Process elements C eval CmdCounter=%elem(CmdList)+1 LUCA C eval Cmdp =%elem(CmdList) LUCA * C eval uListPtr = uHeadPtr + uOffSetToList START OF LIST 1B C do uNumOfEntrys PROCESS LOOP 2B C if uMsgType = '08' or uMsgType='10' C eval uListPtr2 = uHeadPtr + uOffsetToFlds 3B C if %subst(u2data:1:1)>' ' and C %subst(u2data:1:2)<>'/*' and C %subst(u2data:1:6)<>'cmdlog' and C %subst(u2data:1:6)<>'endrqs' C eval FullCmd=%subst(u2Data:1:U2LengthOfData) C * Code by Luca Brignoli to only show command once * regardless of number times used. * Load and lookup the array from the back end so * the lookup doesn't have to search blank elements. C FullCmd lookup CmdList(Cmdp) 99 LUCA 4B C if *in99 = *off LUCA C eval CmdCounter = CmdCounter - 1 LUCA C eval CmdList(CmdCounter) = FullCmd LUCA * C callp(e) qcmdchk(FullCmd:%len(%trimr(FullCmd))) 5B C if not %error C eval cmdmsg73=FullCmd C eval rrn=rrn+1 C write data LOAD SUBFILE 5E C endif 4E C endif C eval Cmdp=CmdCounter LUCA 3E C endif 2E C endif C eval uListPtr = uHeadPtr + uOffsetToNext 1E C enddo * * allow the user to make a selection from subfile. C eval s1recnum=1 C eval *in01 = (rrn > 0) THERE ARE RECOR C eval *in02 = *on DISPLAY CONTRL 1B C dow not *inkc C write contrl DISPLAY SUBFILE C exfmt keys GET USER RESPON 2B C if *in01=*off or *inkc or *inkl 1L C leave 2E C endif * * Find the record in the subfile the user has selected. C clear errmsg C eval *in30=*off * C readc data READ CHANGED 2B C dow not %eof PROCESS LOOP C eval EXCP_MSGID = ' ' C eval *in20=*off * 3B C if select = '1' PROMPT C callp system(FullCMD) 3E C endif 3B C if select = '2' RUN C callp SYSTEM('?'+FullCMD) 3E C endif * 3B C if EXCP_MSGID>*blanks error occurred C eval *in20=*on sbf error C eval *in30=*on error message * * call retrieve message API to pull in message text C callp QMHRTVM( rtvmsgd C mMsgRtv : message retrieved C mMsgLen : length of message C 'RTVM0100': requested format C EXCP_MSGID: msg identifier C 'QCPFMSG *LIBL': qualified msg file C ' ': replacement data C 0: len of replace data C '*YES ': substitution char C '*NO ': format control char C vApiErrDs) * load error message C eval errmsg = EXCP_MSGID +': ' + C %subst(mMsgMessage:1:mMsgRtvLen) 3E C endif * * Update subfile to reflect selected change. C clear select RESET C eval s1recnum = rrn C update data UPDATE SUBFILE * C readc data READ CHANGED 2E C enddo 1E C enddo NO SELECTION * * Send completion message C callp QMHSNDPM( C ' ':' ': C 'Command retrieval - completed': C 73:'*INFO ':'*CTLBDY ': 1:' ': C vApiErrDS) C eval *inlr = *on PROGRAM END C return ]]> */ /* */ /* This program is free software, you can redistribute it and/or modify it */ /* under the terms of the GNU General Public License as published by */ /* the Free Software Foundation. See GNU General Public License for detail.*/ /*--------------------------------------------------------------------------*/ CMD PROMPT('Previously Executed Commands') ]]>