H DEBUG(*YES) * * This program should be compiled as follows: * * CRTBNDRPG * DBGVIEW(*SOURCE) CVTOPT(*DATETIME) USRPRF(*OWNER) * DFTACTGRP(*NO) BNDDIR(QC2LE) ACTGRP(*NEW) * * After it has been compiled, it should be changed to be owned by QSYS * *===================================================================== * SYNOPSIS: This program is a sender program for command requests. * It is used to 'send' a command to another job. It does * this by adding the command to a data queue and then * servicing the target job and starting a trace on that * job, specifying program RCVCMDR as the trace exit * program. When RCVCMDR is invoked, it receives the data * queue entries and invokes them. *===================================================================== FQCLSRC IF F 112 DISK UsrOpn F Extfile(ExtFile) ExtMbr(ExtMbr) *===================================================================== D/COPY QRPGLESRC,PGMSDS D/COPY QSYSINC/QRPGLESRC,QUSEC D/COPY QSYSINC/QRPGLESRC,QUSROBJD *===================================================================== D system PR 10I 0 extproc('system') D * value options(*string) * D qsnddtaq PR Extpgm('QSNDDTAQ') D dtaq 10A Const D dtaqlib 10A Const D dtaqlen 5P 0 Const D data 64512A Const Options(*Varsize) *‚Optional Parameter Group 1 D keylen 3P 0 Const Options(*Nopass) D keydata 256A Const Options(*Nopass:*Varsize) *‚Optional Parameter Group 2 D asyncrqs 10A Const Options(*Nopass) * D qrcvdtaq PR Extpgm('QRCVDTAQ') D dtaq 10A Const D dtaqlib 10A Const D datalen 5P 0 D data 64512A Options(*Varsize) D wait 5P 0 Const *‚Optional Parameter Group 1 D keyorder 2A Const Options(*Nopass) D keylen 3P 0 Const Options(*Nopass) D keydata 256A Options(*Nopass:*Varsize) D senderinfolen 3P 0 Const Options(*Nopass) D senderinfo 32767A Options(*Nopass:*Varsize) *‚Optional Parameter Group 2 D removemessage 10A Const Options(*Nopass) D receiverlen 5P 0 Const Options(*Nopass) D ApiError Like(QUSEC) D Options(*Nopass:*Varsize) * D SenderInfoDS DS D SndInfBytRtn 7P 0 D SndInfBytAvl 7P 0 D SndInfSndJob 10A D SndInfSndUsr 10A D SndInfSndNbr 6A D SndInfCurUsr 10A * D chkobj PR Extpgm('QUSROBJD') D RcvVar 32767A Options(*Varsize) D RcvVarLen 10I 0 Const D Format 8A Const D qObj 20A Const D ObjType 10A Const D ApiError Like(QUSEC) D Options(*Nopass) * D qmhsndpm PR Extpgm('QMHSNDPM') D Msgid 7A Const D qMsgf 20A Const D MsgDta 32767A Const Options(*Varsize) D MsgDtaLen 10I 0 Const D MsgType 10A Const D CSE 4096A Const D CSC 10I 0 Const D MsgKey 4A D ApiError Like(QUSEC) D CSELen 10I 0 Const Options(*Nopass) D CSEQual 20A Const Options(*Nopass) D WaitTime 10I 0 Const Options(*Nopass) D CSEDataType 10A Const Options(*Nopass) D CCSID 10I 0 Const Options(*Nopass) * D SndPgmMsg PR D MsgID 7A Const D MsgDta 3000A Const Varying D MsgType 10A Const * D ExtFile S 21A Inz D ExtMbr S 10A Inz D qDtaq DS D Dtaq 10A Inz('CMDQ') D DtaqLib 10A D RcvPgm C 'RCVCMDR' D DtaqKey S 6A D DataLen S 5P 0 D Data DS D Control 10A D LogCmd N Overlay(Control) D AlwErr N Overlay(Control:*Next) D SndRsp N Overlay(Control:*Next) D Cmd 2000A D Len S 10I 0 D CmdUp S 2000A D String S 2000A Inz Varying D Pos S 10I 0 Inz D Char2 S 2A D AlreadyService S N Inz(*off) * D qJob DS D ToJob 10A D ToUser 10A D ToNbr 6A * D qSrcf DS D SrcFil 10A D SrcLib 10A D SrcMbr 10A * D SrcRcd DS D SrcSeq 6S 2 D SrcDat 6S 0 D SrcDta 100A * *===================================================================== D main PR Extpgm('SNDCMDR') D P_qJob 26A D P_Cmd 2000A D P_RqsDta 2000A D P_LogCmd 4A D P_Execute 4A D P_RspTim 3P 0 D P_qSrcf 20A D P_SrcMbr 10A D P_AlwErr 4A * D main PI D P_qJob 26A D P_Cmd 2000A D P_RqsDta 2000A D P_LogCmd 4A D P_Execute 4A D P_RspTim 3P 0 D P_qSrcf 20A D P_SrcMbr 10A D P_AlwErr 4A *===================================================================== /free //‚Initialize variables qJob = P_qJob; if qJob = '*'; qJob = PSDSQualJob; endif; select; when P_RqsDta = '*CMD'; Cmd = P_Cmd; when P_RqsDta = '*SRC'; qSrcf = P_qSrcf; SrcMbr = P_SrcMbr; other; Cmd = P_RqsDta; endsl; DtaqLib = PSDSPgmLib; //‚Don't allow command execution if the target job is the source job if qJob = PSDSQualJob; P_Execute = '*NO'; endif; //‚Create data queue clear QUSD0100; clear QUSEC; QUSBPRV = %size( QUSEC ); chkobj( QUSD0100 : %len( QUSD0100 ) : 'OBJD0100' : qDtaq : '*DTAQ' : QUSEC ); if QUSEI = 'CPF9801'; clear QUSEC; QUSBPRV = %size( QUSEC ); if system( 'CRTDTAQ DTAQ(' + %trim( DtaqLib ) + '/' + %trim( Dtaq ) + ') MAXLEN(2010) SEQ(*KEYED) KEYLEN(6) SENDERID(*YES)' ) <> 0; exsr *pssr; endif; endif; //‚Add commands to data queue if P_RqsDta = '*SRC'; exsr PrcSrcFil; else; exsr SndDtaq; endif; //‚Service and trace target job, wait 5 seconds for a control //‚response from the target job and then end tracing/servicing. if P_Execute = '*YES'; exsr TrcJob; qrcvdtaq( Dtaq : DtaqLib : DataLen : Data : 5 : 'EQ' : %len( PSDSJobNbrC ) : PSDSJobNbrC : %size( SenderInfoDS ) : SenderInfoDS ); if DataLen = 0; exsr *pssr; endif; exsr EndTrcJob; //‚If necessary, wait for the specified amount of time for //‚a response from the target job saying that it has completed //‚processing the commands. if P_RspTim <> 0; qrcvdtaq( Dtaq : DtaqLib : DataLen : Data : P_RspTim : 'EQ' : %len( PSDSJobNbrC ) : PSDSJobNbrC : %size( SenderInfoDS ) : SenderInfoDS ); if DataLen = 0; Cmd = 'No response from target job within specified time.'; endif; SndPgmMsg( *blanks : Cmd : '*DIAG' ); endif; endif; return; //‚SNDDTAQ: Send the command as a data queue entry begsr SndDtaq; if Cmd <> *Blanks; LogCmd = ( P_LogCmd = '*YES' ); AlwErr = ( P_AlwErr = '*YES' ); SndRsp = ( P_RspTim <> 0 ); exsr ParseCmd; DtaqKey = ToNbr; qsnddtaq( Dtaq : DtaqLib : %len( Data ) : Data : %len( DtaqKey ) : DtaqKey ); if %error; exsr *pssr; endif; endif; endsr; //‚PRCSRCFIL: Read through the specified source file. begsr PrcSrcFil; //‚Open the file. ExtFile = %trim( SrcLib ) + '/' + SrcFil; ExtMbr = SrcMbr; open(e) QCLSRC; if %error; exsr *pssr; endif; //‚Read through the file sending commands to the data queue. Cmd = *blanks; read QCLSRC SrcRcd; dow Not %eof; Cmd = %trim( Cmd ) + ' ' + SrcDta; Len = %len( %trim( Cmd ) ); if %subst( Cmd : Len : 1 ) = '+'; Cmd = %subst( Cmd : 1 : Len - 1 ); else; exsr SndDtaq; Cmd = *blanks; endif; read QCLSRC SrcRcd; enddo; //‚Close the file. close(e) QCLSRC; if %error; exsr *pssr; endif; endsr; //‚TRCJOB: Start servicing and tracing the specified job. begsr TrcJob; if system( 'STRSRVJOB JOB(' + %trim( ToNbr ) + '/' + %trim( ToUser ) + '/' + %trim( ToJob ) + ')' ) <> 0; AlreadyService = *on; endif; if system( 'TRCJOB SET(*ON) EXITPGM(' + %trim( PSDSPgmLib ) + '/' + RcvPgm + ')' ) <> 0; exsr *pssr; endif; endsr; //‚ENDTRCJOB: End tracing/servicing on the specified job. begsr EndTrcJob; if system( 'TRCJOB SET(*END)' ) <> 0; exsr *pssr; endif; if AlreadyService = *off; if system( 'ENDSRVJOB' ) <> 0; exsr *pssr; endif; endif; endsr; //‚PARSECMD: Parse command and replace variables. begsr ParseCmd; CmdUp = %xlate( 'abcdefghjklnorstux': 'ABCDEFGHJKLNORSTUX': Cmd ); Pos = %scan( '&' : CmdUp ); dow Pos > 0; Char2 = %subst( CmdUp : Pos + 1 : 2 ); select; when Char2 = 'TJ'; //‚Target job name String = %trim( ToJob ); when Char2 = 'TU'; //‚Target job user String = %trim( ToUser ); when Char2 = 'TN'; //‚Target job number String = %trim( ToNbr ); when Char2 = 'SJ'; //‚Source job user String = %trim( PSDSJobName ); when Char2 = 'SU'; //‚Source job user String = %trim( PSDSJobUser ); when Char2 = 'SN'; //‚Source job user String = %trim( PSDSJobNbrC ); other; exsr *pssr; endsl; CmdUp = %replace( String : CmdUp : Pos : 3 ); Pos = %scan( '&' : CmdUp : Pos ); enddo; //‚Check for command-specific error-handling if P_RqsDta = '*SRC'; if AlwErr = *off; AlwErr = %scan( '**ALWERR' : CmdUp ) > 0; else; AlwErr = %scan( '**NOALWERR' : CmdUp ) > 0; endif; if LogCmd = *off; LogCmd = %scan( '**LOGCMD' : CmdUp ) > 0; else; LogCmd = %scan( '**NOLOGCMD' : CmdUp ) > 0; endif; endif; endsr; //‚*PSSR: Error handling subroutine begsr *pssr; system( 'DLTOVR FILE(QCLSRC)' ); system( 'TRCJOB SET(*END)' ); if AlreadyService = *off; system( 'ENDSRVJOB' ); endif; return; endsr; /end-free *===================================================================== *‚SndPgmMsg(): Send a message *===================================================================== P SndPgmMsg B D PI D MsgID 7A Const D MsgDta 3000A Const Varying D MsgType 10A Const *--------------------------------------------------------------------- D qMsgf DS D Msgf 10A Inz('QCPFMSG') D MsgfLib 10A Inz('*LIBL') D CSE S 10A Inz D CSC S 10I 0 Inz D MsgKey S 4A Inz *--------------------------------------------------------------------- /free select; when MsgType = '*DIAG'; CSE = '*'; CSC = 2; when MsgType = '*RQS'; CSE = '*EXT'; CSC = 0; other; CSE = '*'; CSC = 3; endsl; reset QUSEC; qmhsndpm( MsgID : qMsgf : MsgDta : %len( MsgDta ) : MsgType : CSE : CSC : MsgKey : QUSEC ); return; begsr *pssr; return; endsr; /end-free P E *=====================================================================