List ILE Program Information and List ILE Service Program Information
H DFTACTGRP(*NO) OPTION(*SRCSTMT: *NODEBUGIO)
** This program will find all places that a bound module is called.
** (by searching all ILE programs in the user libraries)
**
** Scott Klement, May 7, 1997
**
FQSYSPRT O F 80 PRINTER OFLIND(*INOF)
D EC_Escape PR
D When 60A const
D CallStackCnt 10I 0 value
D ErrorCode 32766A options(*varsize)
* List ILE program information API
D QBNLPGMI PR ExtPgm('QBNLPGMI')
D UsrSpc 20A const
D Format 8A const
D PgmName 20A const
D Errors 32766A options(*varsize)
* List ILE service program information API
D QBNLSPGM PR ExtPgm('QBNLSPGM')
D UsrSpc 20A const
D Format 8A const
D SrvPgm 20A const
D Errors 32766A options(*varsize)
* Create User Space API
D QUSCRTUS PR ExtPgm('QUSCRTUS')
D UsrSpc 20A const
D ExtAttr 10A const
D InitSize 10I 0 const
D InitVal 1A const
D PublicAuth 10A const
D Text 50A const
D Replace 10A const
D Errors 32766A options(*varsize)
* Retrieve pointer to user space API
D QUSPTRUS PR ExtPgm('QUSPTRUS')
D UsrSpc 20A const
D Pointer *
* API error code structure
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
* List API generic header structure
D p_Header S *
D dsLH DS BASED(p_Header)
D* Filler
D dsLHFill1 103A
D* Status (I=Incomplete,C=Complete
D* F=Partially Complete)
D dsLHStatus 1A
D* Filler
D dsLHFill2 12A
D* Header Offset
D dsLHHdrOff 10I 0
D* Header Size
D dsLHHdrSiz 10I 0
D* List Offset
D dsLHLstOff 10I 0
D* List Size
D dsLHLstSiz 10I 0
D* Count of Entries in List
D dsLHEntCnt 10I 0
D* Size of a single entry
D dsLHEntSiz 10I 0
* PGML0100 format: modules in program
* SPGL0100 format: modules in service program
* (these fields are the same in both APIs)
D p_Entry S *
D dsPgm DS based(p_Entry)
D dsPgm_Pgm 10A
D dsPgm_PgmLib 10A
D dsPgm_Module 10A
D dsPgm_ModLib 10A
D dsPgm_SrcF 10A
D dsPgm_SrcLib 10A
D dsPgm_SrcMbr 10A
D dsPgm_Attrib 10A
D dsPgm_CrtDat 13A
D dsPgm_SrcDat 13A
D peModule S 10A
D Entry S 10I 0
c *entry plist
c parm peModule
c except PrtHeader
* Create a user space to stuff module info into
c callp QUSCRTUS('MODULES QTEMP': 'USRSPC':
c 1024*1024: x'00': '*ALL':
c 'List of modules': '*YES': dsEC)
c if dsECBytesA > 0
c callp EC_Escape('Calling QUSCRTUS API':3:dsEC)
c endif
c callp QUSPTRUS('MODULES QTEMP': p_Header)
* List all ILE programs modules to space
c callp QBNLPGMI('MODULES QTEMP': 'PGML0100':
c '*ALL *ALLUSR': dsEC)
c if dsECBytesA > 0
c callp EC_Escape('Calling QBNLPGMI API':3:dsEC)
c endif
* List occurrances of our module
c eval p_Entry = p_Header + dsLHLstOff
c for Entry = 1 to dsLHEntCnt
c if dsPgm_Module = peModule
c except PrtModule
c endif
c eval p_Entry = p_Entry + dsLHEntSiz
c endfor
* List all ILE service program modules to space
c callp QBNLSPGM('MODULES QTEMP': 'SPGL0100':
c '*ALL *ALLUSR': dsEC)
c if dsECBytesA > 0
c callp EC_Escape('Calling QBNLSPGM API':3:dsEC)
c endif
* List occurrances of our module
c eval p_Entry = p_Header + dsLHLstOff
c for Entry = 1 to dsLHEntCnt
c if dsPgm_Module = peModule
c except PrtModule
c endif
c eval p_Entry = p_Entry + dsLHEntSiz
c endfor
* And that's about the size of it
c eval *inlr = *on
OQSYSPRT E PrtHeader 2 3
O *DATE Y 10
O +3 'Listing of programs'
O +1 'that use module'
O peModule +1
O 75 'Page'
O PAGE Z 80
O E PrtModule 2 3
O dsPgm_Pgm 10
O dsPgm_PgmLib +1
O dsPgm_SrcF +1
O dsPgm_SrcLib +1
O dsPgm_SrcMbr +1
O dsPgm_SrcDat +1
* Send back an escape message based on an API error code DS
P EC_Escape B
D EC_Escape PI
D When 60A const
D CallStackCnt 10I 0 value
D ErrorCode 32766A options(*varsize)
* Send Program Message API
D QMHSNDPM PR ExtPgm('QMHSNDPM')
D MessageID 7A Const
D QualMsgF 20A Const
D MsgData 256A Const
D MsgDtaLen 10I 0 Const
D MsgType 10A Const
D CallStkEnt 10A Const
D CallStkCnt 10I 0 Const
D MessageKey 4A
D Errors 1A
* API error code (passed from caller)
D p_EC S *
D dsEC DS based(p_EC)
D dsECBytesP 10I 0
D dsECBytesA 10I 0
D dsECMsgID 7A
D dsECReserv 1A
D dsECMsgDta 240A
* API error code (no error handling requested)
D dsNullError DS
D dsNullError0 10I 0 inz(0)
D MsgDtaLen S 10I 0
D MsgKey S 4A
c eval p_EC = %addr(ErrorCode)
c if dsECBytesA <= 16
c eval MsgDtaLen = 0
c else
c eval MsgDtaLen = dsECBytesA - 16
c endif
C* diagnostic msg tells us when the error occurred in our pgm
c callp QMHSNDPM('CPF9897': 'QCPFMSG *LIBL':
c When: %Len(%trimr(when)): '*DIAG':
c '*': 1: MsgKey: dsNullError)
C* send back actual error from API
c callp QMHSNDPM(dsECMsgID: 'QCPFMSG *LIBL':
c dsECMsgDta: MsgDtaLen: '*ESCAPE':
c '*': CallStackCnt: MsgKey:
c dsNullError)
P E
Thanks to Scott Klement
阅读(1799) | 评论(0) | 转发(0) |
