|
midrange.com
Hi !
What about OS/400 commands ???
DSPRCDLCK FILE(LIB/OBJ) OUTPUT(*PRINT)
and small analyzing program to print file QPDSPRLK:
CPYSPLF to PF
cut fields to analyze
I make so many think on AS/400 (for commands they havn't *OUTFILE as parameter
OUTPUT).
It is fast and for other think must i only copy my standard program.
Best Regards
Dariusz Blazkow
Am Donnerstag, 10. Oktober 2002 21:29 schrieb Scott Klement:
> 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-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.
