2001-06-20 如何取得程式先後執行的順序(Calling Stack Information)？利用系統函數 _MATINVS2 即可。

如何取得程式先後執行的順序(Calling Stack Information)？利用系統函數 _MATINVS2 即可。

File  : QRPGLESRC
Member: CALLSTKR
Type  : RPGLE


      * The following ILE RPG program reads the invocation stack.
      * No need to use MI, a system built-in MATINVS2 does the trick.

      * Compile with DFTACTGRP(*NO)

     D wPgm            s             30
     D tmpstr          s             52

     D wObj            ds            60
     D  wObjLib                      30
     D  wObjPgm                      30

     D wInvStk         ds         32767
     D  wInvBytPrv                    9b 0
     D  wInvBytAvl                    9b 0
     D  wInvNbrEnt                    9b 0
     D  wInvMrkCnt                    9b 0

     D pInvEnt         s               *
     D wInvEnt         ds           128    based(pInvEnt)
     D                               32
     D  pInvPgm                        *
     D  wInvNbr                       9b 0
     D  wInvMec                       1
     D  wInvTyp                       1
     D  wInvMrk                       9b 0
     D  wInvIns                       9b 0
     D  wInvActGrp                    9b 0
     D  wInvSusP                       *

     D MatInvS         pr                  extproc('_MATINVS2')
     D  xInvStk                            like(wInvStk)

     D*GetPgmName      pr            30
     D GetPgmName      pr            60
     D  xpPgm                          *

     C                   callp     MatInvS (wInvStk)
     C                   eval      pInvEnt = %addr(wInvStk) + 16

     C                   do        wInvNbrEnt
     C*                  eval      wPgm = GetPgmName (pInvPgm)
     C*    wPgm          dsply
     C                   eval      wObj = GetPgmName (pInvPgm)
     C                   eval      tmpstr = %trim(wObjLib) + '/' +
     C                                      %trim(wObjPgm)
     C     tmpstr        dsply
     C                   eval      pInvEnt = pInvEnt + %size(wInvEnt)
     C                   enddo

     C                   eval      *inlr = *on
     ***********************************************************************************************
     ** Get Program Name, returns blank if domain violation (security level >= 40)
     ***********************************************************************************************
     P GetPgmName      b
     D                 pi            60
     D  xpPgm                          *

     D wMatTmp         ds
     D  wMatBytPrv                    9b 0
     D  wMatBytAvl                    9b 0
     D  wMatPtrTyp                    1
     D  wMatPtrCtxT                   1
     D  wMatPtrCtxST                  1
     D  wMatPtrCtx                   30
     D  wMatPtrObjT                   1
     D  wMatPtrObjST                  1
     D  wMatPtrObj                   30
     D  wMatPtrAut                    2
     D  wMatPtrTgI                    2

     D wRtnStr         s             60

     D MatPtr          pr                  extproc('_MATPTR')
     D  xTemplate                          like(wMatTmp)
     D  xPointer                       *

     C                   callp     MatPtr (wMatTmp : xpPgm)

     c                   if        wMatBytAvl > 0
     C                   eval      wRtnStr = wMatPtrCtx   +
     C                                       wMatPtrObj
     C                   return    wRtnStr
     C                   else
     C                   eval      wRtnStr = *blanks
     C                   return    wRtnStr
     C                   endif

     C     *pssr         begsr
     C                   return    *blanks
     C                   endsr

     P GetPgmName      e