|
midrange.com
> message: 3
> date: Tue, 24 Aug 2004 12:25:58 -0500
> from: "Drew, Ronald" <RDrew@xxxxxxxxxxxxxxx>
> subject: AS400 RPG Scanning Question
>
> Does anyone out there know of any utility available that can look at an
> AS400 program directory, scan the RPG code and return results of only the
> programs that have specific criteria back? We have 5,200 RPG programs
> and I
> bet at least 4,000 are just reports. We have 4900 files of which I
> believe
> at least 3500 are no longer used. The environment has been built over
> many
> years and nothing has been purged. I now want to upgrade to a non-green
> screen environment but want to purge the out stuff not being used. So I
> want to scan the code and look for the programs that only match criteria
> such as a printer for output. Do you know of any utility or can you
> point
> me in the right direction?
>
>
>
> I have asked IBM and a friendly rep advised using DSPPGMREF (Display
> Program
> References) creating an output file and then downloading it to the PC for
> investigating.
>
> Does anyone have any other ideas?
>
>
>
> Ron Drew
Ron,
Here is something I knocked together for a situation similar to yours.
Perhaps you can modify it to suit your needs.
HTH,
Terry
/*********************************************************************/
/* PROGRAM NAME: FILCHGRPGC */
/* CREATION DATE: 07/30/04 */
/* PURPOSE OF PROGRAM: TO CHECK FOR CHANGED FILES */
/*********************************************************************/
PGM (&SRCLIBNAME)
DCL VAR(&SRCLIBNAME) TYPE(*CHAR) LEN(10)
DCLF FILE(HIGHLIGHTF)
/*********************************************************************/
/* VERIFY LIBARARY */
/*********************************************************************/
CHKOBJ OBJ(&SRCLIBNAME) OBJTYPE(*LIB)
MONMSG MSGID(CPF0001) EXEC(GOTO CMDLBL(ENDCLPGM))
CLRPFM FILE(FILCHGPGMF)
CHGDTAARA DTAARA(QGPL/FILCHGDTA) VALUE('Y')
/*********************************************************************/
/* DISPLAY FILE DESCRIPTON TO OUT FILE FOR PROCESSING */
/*********************************************************************/
DSPFD FILE(&SRCLIBNAME/QRPGLESRC) TYPE(*MBRLIST) +
OUTPUT(*OUTFILE) OUTFILE(QTEMP/HIGHLIGHTF)
/*********************************************************************/
/* READ OUTFILE FOR MEMBER NAME */
/*********************************************************************/
LOOP:
RCVF
MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(ENDCLPGM))
/*********************************************************************/
/* COPY SOURCE MEMBER TO FILE FOR SCANNING */
/*********************************************************************/
OVRDBF FILE(QRPGLESRC) +
TOFILE(&SRCLIBNAME/QRPGLESRC) MBR(&MLNAME)
/*********************************************************************/
/* CALL PROGRAM TO CHECK FOR FILES. */
/*********************************************************************/
CALL PGM(FILCHGRPGR) PARM(&MLNAME &MLMTXT &MLLIB)
GOTO CMDLBL(LOOP)
/*********************************************************************/
/* END PROGRAM */
/*********************************************************************/
ENDCLPGM:
RUNQRY QRY(QGPL/FILCHGDATQ)
ENDPGM
****************************************************************
* SET COMPILER OPTIONS *
****************************************************************
HOPTION(*NODEBUGIO:*SRCSTMT)
****************************************************************
* FILES USED IN PROGRAM *
****************************************************************
FQRPGLESRC IF F 112 DISK
FFILECHGSPFIF E K DISK
FFILCHGPGMFIF A E K DISK
****************************************************************
* FIELD DEFINITIONS.
****************************************************************
D FILNAME S 10 INZ
D PGMNAME S 10
D PGMLIB S 10
D PGMTXT S 50
D POS S 3 0 INZ(0)
****************************************************************
* EXTERNAL DATA AREA FOR ABSENTEE CODE. *
****************************************************************
D FILECHAGES DS DTAARA(FILCHGDTA)
D WRITEDTA 1 1
****************************************************************
* INTERNAL FILE SPECS FOR QRPGLESRC *
****************************************************************
IQRPGLESRC NS
I 1 6 2SRCSEQ
I 7 12 0SRCDAT
I 13 112 SRCDATA
****************************************************************
* ENTRY PARMS.
****************************************************************
C *ENTRY PLIST
C PARM PGMNAME
C PARM PGMTXT
C PARM PGMLIB
**********************************************************************
* CHECK FOR PRIMARY WRITE.
**********************************************************************
C *LOCK IN FILECHAGES
**********************************************************************
* DATA AREA FOR PRIMARY WRITE. THIS WILL WRITE AT LEAST ONE
* RECORD TO THE HOLDING FILE.
**********************************************************************
C IF WRITEDTA = 'Y'
C EVAL FILFILE = 'QRPGLESRC'
C EVAL FILPGMLIB = PGMLIB
C WRITE FILCHGPGM
C CLEAR FILCHGPGM
C EVAL WRITEDTA = 'N'
C OUT FILECHAGES
C UNLOCK FILECHAGES
C ENDIF
**********************************************************************
* READ HOLDING FILE
**********************************************************************
C DOW *IN45 = *OFF
C READ QRPGLESRC 45
C IF *IN45 = *OFF
**********************************************************************
* READ ONLY THE F SPECS THAT ARE NOT COMMENTS
**********************************************************************
C IF %SUBST(SRCDATA:6:1) = 'F' AND
C %SUBST(SRCDATA:7:1) <> '*'
**********************************************************************
* READ THROUGH THE LIST OF FILES. IF A FILE IS FOUND IN THE
* SOURCE, WRITE THE FILE NAME TO THE HOLDING FILE.
* ONLY WRITE THE NAME OF THE PORGRAM TO THE FILE ONCE.
**********************************************************************
C *LOVAL SETLL FILECHGSPF
C READ FILECHGSPF
C DOW NOT %EOF(FILECHGSPF)
C EVAL POS = %SCAN(FILENAME : SRCDATA : 7)
C IF POS > 0
C FILENAME CHAIN FILCHGPGMF
C IF NOT %FOUND
C EVAL FILPGM = PGMNAME
C EVAL FILTXT = PGMTXT
C EVAL FILFILE = FILENAME
C EVAL FILPGMLIB = PGMLIB
C WRITE FILCHGPGM
C CLEAR FILCHGPGM
C ENDIF
C ENDIF
C READ FILECHGSPF
C ENDDO
**********************************************************************
* WHEN THE PROGAM GETS PAST THE F SPECS, END LOOP.
**********************************************************************
C ELSE
C IF %SUBST(SRCDATA:6:1) = 'D' OR
C %SUBST(SRCDATA:6:1) = 'I' OR
C %SUBST(SRCDATA:6:1) = 'C'
C EVAL *IN45 = *ON
C ENDIF
C ENDIF
C ENDIF
C ENDDO
**********************************************************************
* END PROGRAM
**********************************************************************
C EVAL *INLR = *ON
C RETURN
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 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.
