|
Scott, many thanks for the code you supplied below. Just one question on that: How do you identify/specify the input parameter (stack counter), which is apparently passed for the QMHRCVPM API. I didn't understand the meanig of it although I read IBM's API description. Can you explain it in other words? Regards, Werner Noll -----Ursprüngliche Nachricht----- Von: Scott Klement [mailto:klemscot@klements.com] Gesendet: Donnerstag, 10. Oktober 2002 21:29 An: midrange-l@midrange.com Cc: rpg400-l@midrange.com Betreff: Re: locked record 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 _______________________________________________ This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing list To post a message email: RPG400-L@midrange.com To subscribe, unsubscribe, or change list options, visit: http://lists.midrange.com/cgi-bin/listinfo/rpg400-l or email: RPG400-L-request@midrange.com Before posting, please take a moment to review the archives at http://archive.midrange.com/rpg400-l.
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 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.
midrange.com
