|
midrange.com
On Thu, 10 Oct 2002 rob@dekko.com wrote:
>
> Now how to retrieve the offender from within the rpg would be cool. With
> that information I could roll my own technique for dealing with the
> situation.
>
The original poster didn't specify RPG, otherwise I would've simply
posted an example. :) But now that you've requested it, I'll show you
my solution. I'll CC: RPG400-L since it probably belongs there, anyway.
This is a procedure I have in my "UTIL" service program. When I get the
status code that indicates a record lock, I call it to get the offending
job's name:
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* util_LockInfo():
* This scans the program message queue for a record lock
* message and retrieves the user-id & job info of the user
* who is locking a record.
*
* peStackCnt = (input) Specifies which program's msgq to scan by
* how many entries back in the call stack it is.
* peJobNbr = (output) Job number of the job locking the rec
* peUser = (output) User name of the job locking the record
* peJobName = (output) Job name of the job locking the record
*
* Returns *ON if successful, or *OFF if failed
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P util_LockInfo B export
D util_LockInfo PI 1N
D peStackCnt 10I 0 value
D peJobNbr 6A
D peUser 10A
D peJobName 10A
D RcvPgmMsg PR ExtPgm('QMHRCVPM')
D MsgInfo 32766A options(*varsize)
D MsgInfoLen 10I 0 const
D Format 8A const
D StackEntry 10A const
D StackCount 10I 0 const
D MsgType 10A const
D MsgKey 4A const
D WaitTime 10I 0 const
D MsgAction 10A const
D ErrorCode 32766A options(*varsize)
D dsM1 DS
D dsM1_BytRtn 10I 0
D dsM1_BytAvl 10I 0
D dsM1_MsgSev 10I 0
D dsM1_MsgID 7A
D dsM1_MsgType 2A
D dsM1_MsgKey 4A
D dsM1_Reserv1 7A
D dsM1_CCSID_st 10I 0
D dsM1_CCSID 10I 0
D dsM1_DtaLen 10I 0
D dsM1_DtaAvl 10I 0
D dsM1_Dta 256A
D dsEC DS
D dsECBytesP 10I 0 INZ(%size(dsEC))
D dsECBytesA 10I 0 INZ(0)
D dsECMsgID 7A
D dsECReserv 1A
D dsECMsgDta 240A
D wwMsgKey S 4A
D wwJob S 28A
D wwPos1 S 10I 0
D wwPos2 S 10I 0
D wwLen S 10I 0
C*********************************************************
C* Search through the program's message queue until we
C* find a msg CPF5027.
C*********************************************************
c eval wwMsgKey = *ALLx'00'
c dou dsECBytesA>0 or dsM1_MsgID='CPF5027'
c callp RcvPgmMsg(dsM1: %size(dsM1): 'RCVM0100':
c '*': peStackCnt: '*PRV': wwMsgKey:
c 0: '*SAME': dsEC)
c eval wwMsgKey = dsM1_MsgKey
c enddo
C*********************************************************
c* Hmm... we got an error...
C*********************************************************
c if dsECBytesA>0
c return *Off
c endif
C*********************************************************
c* Strange... it didn't provide all the info we need...
C*********************************************************
c if dsM1_DtaLen < 108
c return *Off
c endif
C*********************************************************
C* Job number will be in the format 000001/USER/JOBNAME
C*********************************************************
c eval wwJob = %subst(dsM1_Dta:81:28)
c eval wwPos1 = %scan('/': wwJob)
c if wwPos1 < 2
c return *off
c endif
c eval wwPos2 = %scan('/': wwJob: wwPos1+1)
c if wwPos2 < 2
c return *off
c endif
c eval peJobNbr = %subst(wwJob:1:wwPos1-1)
c eval wwLen = (wwPos2 - wwPos1) - 1
c eval wwPos1 = wwPos1 + 1
c eval peUser = %subst(wwJob:wwPos1:wwLen)
c eval wwPos2 = wwPos2 + 1
c eval peJobName = %subst(wwJob:wwPos2)
c return *on
P E
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
