|
midrange.com
On Wed, 20 Nov 2002, Dan wrote:
>
> DSPPGM PGM(*ALL/*ALL) OUTPUT(*OUTFILE) DETAIL(*MODULE)
> DSPSRVPGM SRVPGM(*ALL/*ALL) OUTPUT(*OUTFILE) DETAIL(*MODULE)
>
> Is anyone out there already doing this with the QBNLPGMI & QBNLSPGM
> APIs? Who would be willing to consider saving the need to reinvent the
> wheel?
You didn't say what exactly you wanted to do with the output of these
module listings... I'm guessing you just want to see where a module is
used on the system.
I wrote code to do that a long time ago, but I don't really use that
program anymore today. Nowadays, I never put more than one module in
a *SRVPGM or *PGM object.... instead, I make each module into a *SRVPGM,
and then use a binding directory to tie them all together. I've found
this to be much easier to maintain.
But, having said that, here's the program I wrote to list all of the
programs that use a given module. If nothing else, maybe you can modify
it to serve your needs.
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 <klemscot@nospam.klements.com> May 7, 1997
**
** CHG SCK 09/23/1999 Use more modern coding.
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
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 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.
