AW: locked record

[Werner Noll <werner.noll@xxxxxxxxx>]

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.