//BCHJOB JOB(JMOD) JOBD(NERONI2/NERONI2) OUTQ(QPRINT) + ENDSEV(60) LOG(4 00 *SECLVL) MSGQ(*USRPRF) CCSID(280) /* Open source from www.neroni.it */ /* LA JOB DESCRIPTION "NERONI2/NERONI2" DEVE PREESISTERE. PUO' ESSERE */ /* IDENTICA A QBATCH E PUO' ESSERE SOSTITUITA DA QBATCH O SIMILE. */ /* From System: "S65D69DA" */ /* From Library: "NERONI2" */ /* Unload Time: 2016-07-28 18:10 */ /* To File : "JMOD" */ /* To Library : "NERONI2" */ /* To Text : "List embedded modules. Src REFPGM" */ /********* INIZIO ISTRUZIONI **************************************************/ /* LE SUCCESSIVE ISTRUZIONI PERMETTONO DI RICARICARE I SORGENTI. */ /* 1) DA UN VIDEO COMANDI DELL'AS400 RICEVENTE */ /* CREARE UN FILE SORGENTE DI LUNGHEZZA RECORD 112: */ /* CRTSRCPF FILE(NERONI2/STRINGHE) RCDLEN(112) */ /* 2) SPOSTARE IL FILE "JMOD.txt" NELL'INDIRIZZARIO */ /* DI UN PC CONNESSO IN RETE CON L'AS400 RICEVENTE */ /* (AD ES.: "c:\"). */ /* 3) DAL VIDEO COMANDI DEL PC CHIAMARE FTP: */ /* ftp nomeas400 */ /* 4) DIGITARE UTENTE E PASSWORD. */ /* 5) ESEGUIRE IL COMANDO DI COPIA DA FILE PC A MEMBRO AS400: */ /* put "c:\JMOD.txt" "/qsys.lib/NERONI2.lib/stringhe.file/JMOD.mbr" */ /* 6) ABBANDONARE FTP: */ /* quit */ /* 7) DA UN VIDEO COMANDI DELL'AS400 RICEVENTE */ /* ESEGUIRE LA STRINGA COPIATA NEL MEMBRO SORGENTE: */ /* SBMDBJOB FILE(NERONI2/STRINGHE) MBR(JMOD) JOBQ(QBATCH) */ /* LE SUCCESSIVE ISTRUZIONI PERMETTONO DI CREARE L'UTILITY. */ /* 8) DA UN VIDEO COMANDI DELL'AS400 RICEVENTE */ /* ESEGUIRE LA STRINGA O LE STRINGHE SORGENTE DI TIPO SEU "CL" */ /* (IL CUI NOME TERMINA SEMPRE CON ".") */ /* PRESENTI NEL FILE RICARICATO "NERONI2/JMOD" */ /* FACENDO ATTENZIONE ALL'ORDINE DI ESECUZIONE INDICATO NEL */ /* MEMBRO FACOLTATIVO "A.LEGGIMI", AD ESEMPIO: */ /* SBMDBJOB FILE(NERONI2/JMOD) MBR(JMOD.) JOBQ(QBATCH) */ /********* FINE ISTRUZIONI ****************************************************/ /* Crea la libreria. */ MKDIR DIR('/qsys.lib/NERONI2.lib') CHGLIB LIB(NERONI2) TEXT('Claudio Neroni Utility') /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP NERONI2 QGPL) /* Crea il file sorgente. */ DLTF FILE(NERONI2/JMOD) CRTSRCPF FILE(NERONI2/JMOD) RCDLEN(112) + TEXT('List embedded modules. Src REFPGM') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JMOD) TOFILE(NERONI2/JMOD) + TOMBR(JMOD) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JMOD) MBR(JMOD) + SRCTYPE(CMD) + TEXT('List embedded modules. Cmd') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JMOD.) TOFILE(NERONI2/JMOD) + TOMBR(JMOD.) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JMOD) MBR(JMOD.) + SRCTYPE(CL) + TEXT('List embedded modules. CrtJs') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JMODC) TOFILE(NERONI2/JMOD) + TOMBR(JMODC) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JMOD) MBR(JMODC) + SRCTYPE(CLLE) + TEXT('List embedded modules. Cpp') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JMODL) TOFILE(NERONI2/JMOD) + TOMBR(JMODL) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JMOD) MBR(JMODL) + SRCTYPE(RPGLE) + TEXT('List embedded modules. ListCalledModules') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JMODL_ORIG) TOFILE(NERONI2/JMOD) + TOMBR(JMODL_ORIG) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JMOD) MBR(JMODL_ORIG) + SRCTYPE(RPGLE) + TEXT('List embedded modules. ListCalledModules ORIGINALE') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JMOD1) TOFILE(NERONI2/JMOD) + TOMBR(JMOD1) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JMOD) MBR(JMOD1) + SRCTYPE(PF) + TEXT('List embedded modules. Outfile') /*----------------------------------------------------------------------------*/ //DATA FILE(JMOD) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Claudio Neroni 19-11-2008 Creato. */ /* List embedded modules. Cmd */ /* */ CMD PROMPT('List embedded modules') PARM KWD(LIB) TYPE(*NAME) LEN(10) MIN(1) + PROMPT('Library name') PARM KWD(PGM) TYPE(*NAME) LEN(10) DFT(*ALL) + SPCVAL((*ALL)) PROMPT('Program name') PARM KWD(PRINT) TYPE(*CHAR) LEN(10) RSTD(*YES) + DFT(*YES) VALUES(*YES *NO) PROMPT('Print') PARM KWD(OUTFILE) TYPE(OUTFILE) DFT(*NONE) + SNGVAL((*NONE)) PROMPT('Output file') OUTFILE: QUAL TYPE(*NAME) LEN(10) QUAL TYPE(*NAME) LEN(10) DFT(QTEMP) + SPCVAL((QTEMP)) MIN(0) PROMPT('in library') PARM KWD(MBROPT) TYPE(*CHAR) LEN(10) RSTD(*YES) + DFT(*REPLACE) VALUES(*REPLACE *ADD) + PROMPT('Replace or add records') PARM KWD(REFPGM) TYPE(*NAME) LEN(10) DFT(*CPP) + SPCVAL((*CPP)) PROMPT('Reference program + for messages') //ENDSRC /*----------------------------------------------------------------------------*/ //DATA FILE(JMOD.) FILETYPE(*SRC) ENDCHAR('//ENDSRC') //BCHJOB JOB(JMOD.) JOBD(NERONI2/NERONI2) OUTQ(QPRINTS) ENDSEV(60) + LOG(4 00 *SECLVL) MSGQ(*USRPRF) CCSID(280) jmy /* Claudio Neroni 19-11-2008 Creato. */ /* JMOD */ /* List embedded modules. CrtJs */ /* Prerequisiti: JCPYCLR JRSNMSG JCALLER */ /* Da un originale di Scott Klement del 07-05-1997 */ /* trovato al link www.think400.dk/apier_2.htm#eks0006 */ /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP QGPL) ADDLIBLE LIB(NERONI2) POSITION(*AFTER QTEMP) /* Cancella il file messaggi preesistente. */ DLTMSGF MSGF(NERONI2/JMOD) /* Cancella i testi d'aiuto preesistenti. */ DLTPNLGRP PNLGRP(NERONI2/JMODP) /* Cancella i logici preesistenti. */ /* Cancella i fisici preesistenti. */ DLTF FILE(NERONI2/JMOD1) /* Cancella i comandi preesistenti. */ DLTCMD CMD(NERONI2/JMOD) /* Cancella i programmi preesistenti. */ DLTPGM PGM(NERONI2/JMODC) DLTPGM PGM(NERONI2/JMODL) /* Crea i file fisici. */ CRTPF FILE(NERONI2/JMOD1) SRCFILE(JMOD) SIZE(*NOMAX) /* Crea i file logici. */ /* Crea i comandi. */ CRTCMD CMD(NERONI2/JMOD) PGM(JMODC) SRCFILE(JMOD) + HLPPNLGRP(JMODP) HLPID(CMD) PRDLIB(NERONI2) /* Duplica i comandi in QGPL. */ CRTPRXCMD CMD(QGPL/JMOD) TGTCMD(NERONI2/JMOD) AUT(*USE) REPLACE(*YES) /* Crea i programmi. */ CRTBNDCL PGM(NERONI2/JMODC) SRCFILE(JMOD) TGTRLS(*CURRENT) + DBGVIEW(*ALL) CRTBNDRPG PGM(NERONI2/JMODL) SRCFILE(JMOD) DBGVIEW(*ALL) + TGTRLS(*CURRENT) /* Crea il file messaggi. */ CRTMSGF MSGF(NERONI2/JMOD) TEXT('List embedded modules. Msgf') /* Fotografia comandi (xxxA001). */ ADDMSGD MSGID(JMDA001) MSGF(NERONI2/JMOD) MSG('JMOD LIB(&1) + PGM(&2) PRINT(&3) OUTFILE(&4/&5) MBROPT(&6) + REFPGM(&7)') FMT((*CHAR 10) (*CHAR 10) (*CHAR 10) + (*CHAR 10) (*CHAR 10) (*CHAR 10) (*CHAR 10)) /* Messaggi comuni a pgm di comandi diversi (xxx0001). */ /* Messaggi nei pgm del Cmd 1 (xxx0101). */ ADDMSGD MSGID(JMD0101) MSGF(NERONI2/JMOD) MSG('Richiedi almeno + un''emissione.') SECLVL('Il comando JMOD puo'' + stampare e scaricare un file di emissione. Scegli + almeno una delle due attivita''.') ADDMSGD MSGID(JMD0102) MSGF(NERONI2/JMOD) MSG('Il file di + emissione &1/&2 deve preesistere.') SECLVL('Se + richiedi l''aggiunta al file di emissione &1/&2, lo + stesso deve preesistere come emissione di una + precedente esecuzione.') FMT((*CHAR 10) (*CHAR 10)) ADDMSGD MSGID(JMD0111) MSGF(NERONI2/JMOD) MSG('Lista moduli in + corso per libreria &1') FMT((*CHAR 10)) ADDMSGD MSGID(JMD0121) MSGF(NERONI2/JMOD) MSG('Creata e stampata + Lista moduli per libreria &1 in outfile &2/&3.') + FMT((*CHAR 10) (*CHAR 10) (*CHAR 10)) ADDMSGD MSGID(JMD0122) MSGF(NERONI2/JMOD) MSG('Stampata Lista + moduli per libreria &1.') FMT((*CHAR 10) (*CHAR 10) + (*CHAR 10)) ADDMSGD MSGID(JMD0123) MSGF(NERONI2/JMOD) MSG('Creata Lista + moduli per libreria &1 in outfile &2/&3.') FMT((*CHAR + 10) (*CHAR 10) (*CHAR 10)) /* Messaggi nei pgm del Cmd 2 (xxx0201). */ /* Messaggi dei Cmd (xxx1001). */ /* Crea i testi d'aiuto. */ CRTPNLGRP PNLGRP(NERONI2/JMODP) SRCFILE(JMOD) //ENDBCHJOB //ENDSRC /*----------------------------------------------------------------------------*/ //DATA FILE(JMODC) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Claudio Neroni 19-11-2008 Creato. */ /* List embedded modules. */ /* */ PGM PARM(&LIB &PGM &PRINT &OUTFILE &MBROPT + &REFPGM) /* Riceve Nome libreria. */ DCL VAR(&LIB) TYPE(*CHAR) LEN(10) /* Riceve Nome programma. */ DCL VAR(&PGM) TYPE(*CHAR) LEN(10) /* Riceve Richiesta di stampa. */ DCL VAR(&PRINT) TYPE(*CHAR) LEN(10) /* Riceve Nome qualificato del file di emissione. */ DCL VAR(&OUTFILE) TYPE(*CHAR) LEN(20) /* File di emissione. */ DCL VAR(&OUTFILEF) TYPE(*CHAR) LEN(10) /* Libreria del File di emissione. */ DCL VAR(&OUTFILEL) TYPE(*CHAR) LEN(10) /* Riceve Sostituzione o aggiunta record. */ DCL VAR(&MBROPT) TYPE(*CHAR) LEN(10) /* Riceve Programma di riferimento per i messaggi. */ DCL VAR(&REFPGM) TYPE(*CHAR) LEN(10) /* Identificazione messaggio. */ DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) /* Tipo lavoro (0=Batch 1=Interactive). */ DCL VAR(&JOBTYPE) TYPE(*CHAR) LEN(1) /* Prenotazione del CPF0001. */ DCL VAR(&CPF0001) TYPE(*LGL) /* Intercetta tutti gli errori saltando a fine con errore. */ MONMSG MSGID(CPF0000 MCH0000 CEE0000) EXEC(GOTO + CMDLBL(ERRORE)) /* Recupera tipo lavoro. */ RTVJOBA TYPE(&JOBTYPE) /* Estrae parametri. */ CHGVAR VAR(&OUTFILEF) VALUE(%SST(&OUTFILE 1 10)) CHGVAR VAR(&OUTFILEL) VALUE(%SST(&OUTFILE 11 10)) /* Se richiesto *CPP (Command Processing Program) come programma */ /* di riferimento dei messaggi, assume il nome del programma corrente. */ IF COND(&REFPGM *EQ *CPP) THEN(DO) JCALLER CALLER(&REFPGM) KINSHIP(*FATHER) ENDDO /* Fotografa il comando. */ SNDPGMMSG MSGID(JMDA001) MSGF(JMOD) MSGDTA(&LIB *CAT + &PGM *CAT &PRINT *CAT &OUTFILEL *CAT + &OUTFILEF *CAT &MBROPT *CAT &REFPGM) + TOPGMQ(*PRV (&REFPGM)) MSGTYPE(*INFO) /* Se non sono richiesti ne' stampa ne' file, segnala e abbandona. */ IF COND(&PRINT *NE *YES *AND &OUTFILEF *EQ + *NONE) THEN(DO) SNDPGMMSG MSGID(JMD0101) MSGF(JMOD) TOPGMQ(*PRV + (&REFPGM)) MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO /* Se richiesto il file di scarico e l'aggiunta dati, */ /* controla l'esistenza del file di scarico. */ IF COND(&OUTFILEF *NE *NONE *AND &MBROPT *EQ + *ADD) THEN(DO) CHKOBJ OBJ(&OUTFILEL/&OUTFILEF) OBJTYPE(*FILE) MONMSG MSGID(CPF0000) EXEC(DO) SNDPGMMSG MSGID(JMD0102) MSGF(JMOD) MSGDTA(&OUTFILEL + *CAT &OUTFILEF) TOPGMQ(*PRV (&REFPGM)) + MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO ENDDO /* Se richiesto il file di scarico e la sostituzione dati, */ /* crea il file di scarico. */ IF COND(&OUTFILEF *NE *NONE *AND &MBROPT *EQ + *REPLACE) THEN(DO) JCPYCLR FROMFILE(JMOD1) TOFILE(&OUTFILEL/&OUTFILEF) ENDDO /* Se interattivo, Messaggia stato. */ /* Creazione elenco file in corso per libreria &1 */ IF COND(&JOBTYPE *EQ '1') THEN(DO) SNDPGMMSG MSGID(JMD0111) MSGF(JMOD) MSGDTA(&LIB) + TOPGMQ(*EXT) MSGTYPE(*STATUS) ENDDO /* Se richiesto il file di scarico, lo reindirizza. */ IF COND(&OUTFILEF *NE *NONE) THEN(DO) OVRDBF FILE(JMOD1) TOFILE(&OUTFILEL/&OUTFILEF) ENDDO /* Se richiesta, reindirizza la stampa. */ IF COND(&PRINT *EQ *YES) THEN(DO) OVRPRTF FILE(QPRINT) PAGESIZE(66 198) USRDTA(&LIB) + SPLFNAME(JMOD) ENDDO /* Estrae informazioni dalla libreria. */ CALL PGM(JMODL) PARM(&LIB &PGM &PRINT &OUTFILEF) /* Se richiesta, visualizza la stampa. */ IF COND(&PRINT *EQ *YES) THEN(DO) DSPSPLF FILE(JMOD) SPLNBR(*LAST) ENDDO /* Segnala buon esito. */ SELECT WHEN COND(&PRINT *EQ *YES *AND &OUTFILEF *NE + *NONE) THEN(CHGVAR VAR(&MSGID) + VALUE(JMD0121)) WHEN COND(&PRINT *EQ *YES) THEN(CHGVAR + VAR(&MSGID) VALUE(JMD0122)) OTHERWISE CMD(CHGVAR VAR(&MSGID) VALUE(JMD0123)) ENDSELECT SNDPGMMSG MSGID(&MSGID) MSGF(JMOD) MSGDTA(&LIB *CAT + &OUTFILEL *CAT &OUTFILEF) TOPGMQ(*PRV + (&REFPGM)) MSGTYPE(*COMP) /* Attivitą finali. */ RCLRSC: /* Riacquisisce le risorse. */ RCLRSC MONMSG MSGID(CPF0000 MCH0000) /* Dealloca. */ /* ... */ /* Cancella i file di lavoro. */ /* ... */ /* Se richiesto, rilascia il CPF0001. */ IF COND(&CPF0001) THEN(DO) SNDPGMMSG MSGID(CPF0001) MSGF(QCPFMSG) MSGDTA(JMOD) + MSGTYPE(*ESCAPE) MONMSG MSGID(CPF0000 MCH0000) ENDDO /* Ritorna. */ RETURN /* Errore. */ ERRORE: /* Restituisce i messaggi al chiamante, */ /* trasformando eventuali escape in diagnostici. */ JRSNMSG MONMSG MSGID(CPF0000 MCH0000) /* Prenotazione del CPF0001. */ CPF0001: /* Prenota il CPF0001. */ CHGVAR VAR(&CPF0001) VALUE('1') MONMSG MSGID(CPF0000 MCH0000) /* Salta ad Attivitą finali. */ GOTO CMDLBL(RCLRSC) ENDPGM //ENDSRC /*----------------------------------------------------------------------------*/ //DATA FILE(JMODL) FILETYPE(*SRC) ENDCHAR('//ENDSRC') * Claudio Neroni 18-11-2008 Creato. * List embedded modules. List called modules * Lista moduli integrati. Elenca i moduli chiamati * Da un originale trovato su www.think400.dk/apier_2.htm#eks0006 * Claudio Neroni 28-07-2016 Modificato. * Riaggiunti, come nell'originale, i service program. * Scarica info nello stesso outfile. *--------------------------------------------------------------------------------------------- ** 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 ** *--------------------------------------------------------------------------------------------- H DFTACTGRP(*NO) OPTION(*SRCSTMT: *NODEBUGIO) H decedit('0,') datfmt(*dmy/) datedit(*dmy/) *--------------------------------------------------------------------------------------------- * Print. FQPRINT O F 132 PRINTER OFLIND(*INOF) usropn * Outfile. Fjmod1 o e disk usropn *--------------------------------------------------------------------------------------------- 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) * Filler D dsLHFill1 103A * Status (I=Incomplete, C=Complete, F=PartiallyComplete) D dsLHStatus 1A * Filler D dsLHFill2 12A * Header Offset D dsLHHdrOff 10I 0 * Header Size D dsLHHdrSiz 10I 0 * List Offset D dsLHLstOff 10I 0 * List Size D dsLHLstSiz 10I 0 * Count of Entries in List D dsLHEntCnt 10I 0 * 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 *--------------------------------------------------------------------------------------------- * Parametri. D pePgm S 10A D peLib S 10A D pePrint S 10A D peOutFile S 10A *--------------------------------------------------------------------------------------------- * Scambia parametri. c *entry plist c parm peLib c parm pePgm c parm pePrint c parm peOutFile *--------------------------------------------------------------------------------------------- * Trasforma in indicatori le richieste di stampa e di outfile. C pePrint comp '*YES' 51 C peOutFile comp '*NONE' 5252 *--------------------------------------------------------------------------------------------- * Apre le emissioni richieste. C 51 open qprint C 52 open jmod1 *--------------------------------------------------------------------------------------------- * Print Header. c 51 except PrtHeader * Create a user space to stuff module info into c callp QUSCRTUS('JMODUS 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('JMODUS QTEMP': p_Header) * List all ILE programs modules to space c callp QBNLPGMI('JMODUS QTEMP': 'PGML0100': c (pePgm+peLib): dsEC) c if dsECBytesA > 0 c callp EC_Escape('Calling QBNLPGMI API':3:dsEC) c endif * List module in program c eval p_Entry = p_Header + dsLHLstOff c for Entry = 1 to dsLHEntCnt C if *in51 c of except PrtHeader c except PrtModule C endif C 52 exsr out c eval p_Entry = p_Entry + dsLHEntSiz c endfor ******************** * List all ILE service program modules to space c callp QBNLSPGM('JMODUS QTEMP': 'SPGL0100': c (pePgm+peLib): dsEC) c if dsECBytesA > 0 c callp EC_Escape('Calling QBNLSPGM API':3:dsEC) c endif * List module in program c eval p_Entry = p_Header + dsLHLstOff c for Entry = 1 to dsLHEntCnt C if *in51 c of except PrtHeader c except PrtModule C endif C 52 exsr out c eval p_Entry = p_Entry + dsLHEntSiz c endfor ******************** * And that's about the size of it c eval *inlr = *on c 51 except eop *--------------------------------------------------------------------------------------------- * Emette record in outfile. C out begsr C eval MOPGMN = dsPgm_Pgm C eval MOPGML = dsPgm_PgmLib C eval MOMODN = dsPgm_Module C eval MOMODL = dsPgm_ModLib C eval MOATTR = dsPgm_Attrib C eval MOSRCF = dsPgm_SrcF C eval MOSRCL = dsPgm_SrcLib C eval MOSRCM = dsPgm_SrcMbr C eval MOSRCD = dsPgm_SrcDat C eval MOCRTD = dsPgm_CrtDat C write jmod1r C endsr *--------------------------------------------------------------------------------------------- OQPRINT E PrtHeader 2 1 1 O *DATE Y 10 O +3 'Listing of modules' O +1 'used by program' O peLib +1 O '/' O pePgm O 75 'Page' O PAGE Z 80 O E PrtHeader 2 O 'Pgm.......' O +1 'PgmLib....' O +1 'SrcF......' O +1 'SrcLib....' O +1 'SrcMbr....' O +1 'SrcDat.......' O +1 'Module....' O +1 'ModLib....' O +1 'Attrib....' O +1 'CrtDat.......' O E PrtModule 1 O dsPgm_Pgm O dsPgm_PgmLib +1 O dsPgm_SrcF +1 O dsPgm_SrcLib +1 O dsPgm_SrcMbr +1 O dsPgm_SrcDat +1 O dsPgm_Module +1 O dsPgm_ModLib +1 O dsPgm_Attrib +1 O dsPgm_CrtDat +1 O e eop 1 O '*** End of print ***' *--------------------------------------------------------------------------------------------- * 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 * 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) * send back actual error from API c callp QMHSNDPM(dsECMsgID: 'QCPFMSG *LIBL': c dsECMsgDta: MsgDtaLen: '*ESCAPE': c '*': CallStackCnt: MsgKey: c dsNullError) P E *--------------------------------------------------------------------------------------------- //ENDSRC /*----------------------------------------------------------------------------*/ //DATA FILE(JMODL_ORIG) FILETYPE(*SRC) ENDCHAR('//ENDSRC') * Al link http://www.think400.dk/apier_2.htm#eks0006 * QBNLPGMI - QBNLSPGM * 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 //ENDSRC /*----------------------------------------------------------------------------*/ //DATA FILE(JMOD1) FILETYPE(*SRC) ENDCHAR('//ENDSRC') * Claudio Neroni 18-11-2008 Creato. A R JMOD1R A TEXT('List embedded modules.') A MOPGMN 10 A COLHDG('Program') A MOPGML 10 A COLHDG('Program' 'library') A MOMODN 10 A COLHDG('Module') A MOMODL 10 A COLHDG('Module' 'library') A MOATTR 10 A COLHDG('Attribute') A MOSRCF 10 A COLHDG('Source' 'file') A MOSRCL 10 A COLHDG('Source' 'library') A MOSRCM 10 A COLHDG('Source' 'member') A MOSRCD 13 A COLHDG('Source' 'date') A MOCRTD 13 A COLHDG('Creation' 'date') A K MOPGML A K MOPGMN //ENDSRC //ENDBCHJOB