Programme de service CallStack
*===================================================================
* = Service Program... CallStack =
* = Description....... Call stack routines =
* = =
* = Compile........... CrtRPGMod Module(YourLib/CallStack) =
* = SrcFile(YourLib/YourSrcFile) =
* = CrtSrvPgm SrvPgm(YourLib/CallStack) =
* = Export(*All) =
* ===================================================================
H NoMain
* ===================================================================
* = Prototypes =
* ===================================================================
* ——————————————————————-
* – RtvNbrStkEnt – Retrieve number of call stack entries –
* ——————————————————————-
D RtvNbrStkEnt PR 1à˜I à˜
D 1à˜ Value
D 1à˜ Value
D 6 Value
D 272 Options( *NoPass )
* ——————————————————————-
* – RtvStkEnt – Retrieve call stack entry –
* ——————————————————————-
D RtvStkEnt PR N
D 1à˜ Value
D 1à˜ Value
D 6 Value
D 1à˜I à˜ Value
D 1à˜I à˜
D 1à˜
D 1à˜
D 1à˜
D 1à˜
D 1à˜
D 4à˜96
D 272 Options( *NoPass )
* ——————————————————————-
* – RtvCallStkAPI – Retrieve call stack API –
* ——————————————————————-
D RtvCallStkAPI PR ExtPgm( ‘QWVRCSTK’ )
D 65535
D 1à˜I à˜
D 8
D 56
D 8
D 272
* ===================================================================
* = Procedure….. RtvNbrStkEnt =
* = Description… Retrieve number of call stack entries =
* ===================================================================
.
.
.
D RtvInfoDS DS 65535
D 8
D TotStkEnt 1à˜I à˜
D 4
D NbrStkEnt 1à˜I à˜
D 8
D Status 1
.
.
.
D RtvInfoDS DS 65535
D 8
D TotStkEnt 1à˜I à˜
D FirstEntOff 1à˜I à˜
D NbrStkEnt 1à˜I à˜
D 8
D Status 1
D RtvInfoDSLen S 1à˜I à˜ Inz( %Len( RtvInfoDS ) )
D RtvInfoFmt S 8 Inz( ‘CSTKà˜1à˜à˜’ )
D StkEntDS DS Based( StkEntPtr )
D EntLen 1à˜I à˜
D 8
D PrcDisplace 1à˜I à˜
D PrcNameLen 1à˜I à˜
D RequestLevel 1à˜I à˜
D PgmName 1à˜
D PgmLibName 1à˜
D 4
D ModName 1à˜
D ModLibName 1à˜
D 8
D ActGrpName 1à˜
StkEntPtr S *
PrcNameArea S 4à˜96 Based( PrcNamePtr )
PrcNamePtr S *
D PrcName S 4à˜96
D JobIDInfoDS DS
D JobName 1à˜ Inz( *Blank )
D JobUser 1à˜ Inz( *Blank )
D JobNbr 6 Inz( *Blank )
D 16 Inz( *Blank )
D 2 Inz( *AllX’à˜à˜’ )
D 1à˜I à˜ Inz( 2 )
D 8 Inz( *AllX’à˜à˜’ )
D JobIDFmt S 8 Inz( ‘JIDFà˜1à˜à˜’ )$
D BadStatusError DS
D 1à˜I à˜ Inz( %Size( BadStatusError
D 1à˜I à˜ Inz( 16 )
D 7 Inz( ‘CPF9898′ )
D 1 Inz( X’à˜à˜’ )
D 256 Inz( ‘Unexpected error’ )
D BadEntNbrError DS
D 1à˜I à˜ Inz( %Size( BadEntNbrError ) )
D 1à˜I à˜ Inz( 2à˜ )
D 7 Inz( ‘CPF9898′ )
D 1 Inz( X’à˜à˜’ )
D 256 Inz( ‘Invalid entry number’ )
D RcvSizeError DS
D 1à˜I à˜ Inz( %Size( RcvSizeError ) )
D 1à˜I à˜ Inz( 16 )
D 7 Inz( ‘CPF9898′ )
D 1 Inz( X’à˜à˜’ )
D 256 Inz( ‘Receiver too small’ )
* ——————————————————————-
* – Determine whether API error parameter was passed –
* ——————————————————————-
C If %Parms > 11
C Eval APIErrorPassed = *On
C EndIf
* ——————————————————————-
* – Load input parameters –
* ——————————————————————-
C Eval JobName = JobNameIn
C Eval JobUser = JobUserIn
C Eval JobNbr = JobNbrIn
* ——————————————————————-
* – Retrieve call stack –
* ——————————————————————-
C Reset APIErrorDS
C CallP RtvCallStkAPI(
C R tvInfoDS :
C RtvInfoDSLen:
C RtvInfoFmt :
C JobIDInfoDS :
C JobIDFmt :
C APIErrorDS
C )
C If BytesAvail <> NoAPIError
C ExSr ReturnError
C EndIf
H
I
J
C If EntNbr <= *Zero or
C EntNbr > NbrStkEnt
C Eval APIErrorDS = BadEntNbrError
C ExSr ReturnError
C EndIf
C If Status <> *Blank
C Eval APIErrorDS = BadStatusError
C ExSr ReturnError
C EndIf
C If NbrStkEnt <> TotStkEnt
C Eval APIErrorDS = RcvSizeError
C ExSr ReturnError
C EndIf
* ——————————————————————-
* – Extract call stack entry information –
* ——————————————————————-
C Eval StkEntPtr = %Addr( RtvInfoDS ) +
C FirstEntOff
C Do EntNbr
C Eval PrcNamePtr = StkEntPtr + PrcDisplace
C Eval PrcName = %Subst( PrcNameArea:
C 1 :
C PrcNameLen )
C Eval RtnRqsLvl = RequestLevel
C Eval RtnPgmName = PgmName
C Eval RtnPgmLib = PgmLibName
C Eval RtnModName = ModName
C Eval RtnModLib = ModLibName
C Eval RtnActGrpName = ActGrpName
C Eval RtnPrcName = PrcName
C Eval StkEntPtr = StkEntPtr + EntLen
C EndDo
C Return *Off
* ——————————————————————-
* – Subroutine…. ReturnError –
* – Description… Return error condition to caller –
* ——————————————————————-
C ReturnError BegSr
C If APIErrorPassed
C Eval APIError = APIErrorDS
C EndIf
C Return *On
C EndSr
Téléchargez gratuitement cette ressource
Comment cerner la maturité digitale de votre entreprise ?
Conçu pour les directions IT et Métiers, ce guide vous permettra d'évaluer précisément vos
processus de communication client, d'identifier vos lacunes et points d'inflexion pour établir
un plan d’actions capable de soutenir durablement votre évolution. Bénéficiez maintenant
d'une feuille de route complète.
