Retrieving Files Used in Programs, SQL packages, Service programs, Modules, Query definitions in an IBM i Library

By -

 In this post, we’ll explore how to efficiently retrieve program files used in queries within an IBM i library using the DPR command, along with its associated CLP (DPRCL) and SQL RPGLE program (DPRRPG). This combination allows users to dynamically fetch program file references based on various filters, enhancing the management of programs in the IBM i environment.



Overview of Components


1. The DPR Command


The DPR command serves as the entry point for retrieving program files. It accepts two parameters: the library name and the object type. Below is the source code for the DPR command: 

             CMD        PROMPT('Show Pgm Files via DSPPGMREF')
 /* COMMAND PROCESSING PROGRAM IS: DPRCL */
 
             PARM       KWD(LIBRARY) TYPE(*CHAR) LEN(10) MIN(1) +
                          PROMPT('Library or *ALL')
             PARM       KWD(OBJTYPE) TYPE(*CHAR) LEN(07) RSTD(*YES) +
                          VALUES(*PGM *SQLPKG *SRVPGM *MODULE +
                          *QRYDFN) MIN(1) PROMPT('ObjType:')

  - Parameters:

  - `&LIBRARY`: Specifies the library from which to retrieve program files. This parameter can accept either a specific library name or *ALL to include all libraries. However, using *ALL should be done cautiously to avoid overloading the IBM i machine with excessive queries.

  - `&OBJTYPE`: Specifies the type of object to filter. Depending on the value selected, you can retrieve different results, such as:

    - `*PGM` for programs

    - `*SQLPKG` for SQL packages

    - `*SRVPGM` for service programs

    - `*MODULE` for modules

    - `*QRYDFN` for query definitions


2. The DPRCL CLP Program


The DPRCL program processes the DPR command by utilizing the `DSPPGMREF` command to create an output file of program references. Below is the key logic of the CLP:

 

 

PGM PARM(&LIBRARY &OBJTYPE)
DCL VAR(&LIBRARY) TYPE(*CHAR) LEN(10)
DCL VAR(&OBJTYPE) TYPE(*CHAR) LEN(07)
DCL VAR(&CPF) TYPE(*CHAR) LEN(07)
DLTF FILE(QTEMP/DPRFILE)
MONMSG MSGID(CPF0000)
DSPPGMREF PGM(&LIBRARY/*ALL) OUTPUT(*OUTFILE) +
           OBJTYPE(&OBJTYPE) OUTFILE(QTEMP/DPRFILE)
MONMSG MSGID(CPF3033) EXEC(CHGVAR VAR(&CPF) VALUE(CPF3033))
MONMSG MSGID(CPF3064) EXEC(CHGVAR VAR(&CPF) VALUE(CPF3064))
CALL PGM(DPRRPG) PARM((&LIBRARY) (&OBJTYPE) (&CPF))
ENDPGM

 

 In this code:

- The `DSPPGMREF` command generates the program references, outputting them to a temporary file.

- The program then calls the DPRRPG program to process this data further.


3. The DPRRPGV User Interface (DSPF)


The display file (DPRRPGV) is designed to provide a user-friendly interface for interacting with the results. It includes several filter fields to refine the search for program files, enabling users to enter specific criteria and retrieve relevant information.

 

 

     A                                      DSPSIZ(27 132 *DS4)
     A                                      CHGINPDFT(CS UL HI)
     A                                      INDARA
     A                                      CA03(03 'F3=EXIT')
     A                                      CA05(05 'F5=Refr')
     A                                      REF(DPRFILE)
     A*--------------------------------------------------------
     A          R SFL1                      SFL
     A*--------------------------------------------------------
     A            S1OPT          1A  B 10  2
     A            S1LIB     R             +3REFFLD(WHLIB )
     A            S1PNAM    R            + 1REFFLD(WHPNAM)
     A            S1FNAM    R            + 1REFFLD(WHFNAM)
     A            S1RFNM    R            + 1REFFLD(WHRFNM)
     A            S1OTYP    R            + 1REFFLD(WHOTYP)
     A            S1FUSG    R            + 1REFFLD(WHFUSG)
     A            S1TEXT    R             +2REFFLD(WHTEXT)
     A*--------------------------------------------------------
     A          R FMT01                     SFLCTL(SFL1)
     A*--------------------------------------------------------
     A                                      SFLPAG(0010)
     A                                      SFLSIZ(&NBRRECS)
     A                                      OVERLAY
     A       N50                            SFLDSP SFLDSPCTL
     A        50                            SFLCLR
     A        91                            SFLEND(*MORE)
     A                                      RTNCSRLOC(&PM_RCD &PM_FLD)
     A            PM_RCD        10A  H
     A            PM_FLD        10A  H
     A            SF1NUM         4S 0H
     A            NBRRECS        5S 0P
     A                                  1 44'Show ' DSPATR(HI)
     A            POBJTYPE       7       + 1DSPATR(HI)
     A                                   + 1' Files via DSPPGMREF'
     A                                      DSPATR(HI)
     A                                  3  2'CL Command:'
     A            WCMD         101       + 1COLOR(BLU)
     A            F1LIB     R        B  4  6REFFLD(WHLIB )
     A            F1PNAM    R        B   + 1REFFLD(WHPNAM)
     A            F1RFNM    R        B  4 40REFFLD(WHRFNM)
     A            F1OTYP    R        B   + 1REFFLD(WHOTYP)
     A            F1FUSG    R        B   + 1REFFLD(WHFUSG)
     A            F1TEXT    R        B   + 1REFFLD(WHTEXT)
     A                                   + 1'<--FILTERS'
     A                                  5 17'File name:'
     A            F1FNAM    R        B  5 28REFFLD(WHFNAM)
     A                                  5 62' 1=I,2=E,3=I/E,4=A,
     A                                      5=I/A,6=E/A,7=I-
     A                                      /E/A,8=N/S,0=N/A'
     A                                  6 25'OR'
     A            F1FNA2    R        B  6 28REFFLD(WHFNAM)
     A                                  7 25'OR'
     A            F1FNA3    R        B  7 28REFFLD(WHFNAM)
     A
     A                                  8  2'Opt'
     A                                    +1'Library   '
     A                                    +1'Object'
     A                                    +5'File       '
     A                                    +1'Format    '
     A                                    +1'Obj Type  '
     A                                    +1'___'
     A                                    +1'Description'
     A*--------------------------------------------------------
     A          R S1CMD
     A*--------------------------------------------------------
     A            S1MSG         78A    23  2
     A                                 24  2'F3=Exit'
     A                                    +3'F5=Refresh'

 


4. The DPRRPG SQL RPGLE Program


The DPRRPG program is where the main logic for handling the retrieved data occurs. It filters records based on user-defined criteria and manages display logic:


 

 

**FREE
     // ****************************************************
     // Retrieve Files Used in Queries of an IBM i Library *
     // ****************************************************
     ctl-opt option(*nodebugio:*srcstmt:*nounref) dftactgrp(*no);
 
     dcl-f DPRRPGV workstn indds(Dspf) sfile(SFL1 : SF1NUM);
 
     // constant
     dcl-c MaxSFLrec 9999 ;
 
     // standalone
     dcl-s ReLoadSFL ind inz(*on) ;
     dcl-s wInclude  char(1);
     dcl-s pos1 int(10);
     dcl-s pos2 int(10);
     dcl-s pos3 int(10);
 
     // alfanumeric filter fields
     dcl-s F1LIB0lke varchar(35) inz('%') ;
     dcl-s F1LIB0prv varchar(35) inz(*blanks);
     dcl-s F1PNAMlke varchar(35) inz('%') ;
     dcl-s F1PNAMprv varchar(35) inz(*blanks);
     dcl-s F1FNAMlke varchar(35) inz('%') ;
     dcl-s F1FNAMprv varchar(35) inz(*blanks);
     dcl-s F1RFNMlke varchar(35) inz('%') ;
     dcl-s F1RFNMprv varchar(35) inz(*blanks);
     dcl-s F1TEXTlke varchar(55) inz('%') ;
     dcl-s F1TEXTprv varchar(55) inz(*blanks);
     dcl-s F1FNA2lke varchar(35) inz('%') ;
     dcl-s F1FNA2prv varchar(35) inz(*blanks);
     dcl-s F1FNA3lke varchar(35) inz('%') ;
     dcl-s F1FNA3prv varchar(35) inz(*blanks);
     dcl-s F1OTYPlke varchar(35) inz('%') ;
     dcl-s F1OTYPprv varchar(35) inz(*blanks);
 
     // numeric filter fields
     dcl-s F1FUSGstr zoned(02) inz(*zeros);
     dcl-s F1FUSGend zoned(02) inz(*hival);
     dcl-s F1FUSGprv zoned(04) inz(*zeros);
 
     // data structure
     dcl-ds Dspf qualified ;
       Exit ind pos(03) inz(*off);
       Refr ind pos(05) inz(*off);
       DoForF6 ind pos(06) inz(*off);
       SflClr ind pos(50) inz(*off);
       SflEnd ind pos(91) inz(*off);
     end-ds ;
 
     dcl-ds RecordDs;
       WHLIB  char(10);
       WHPNAM char(10);
       WHFNAM char(11);
       WHRFNM char(10);
       WHTEXT char(50);
       WHFUSG zoned(2);
       WHOTYP char(10);
     end-ds;
 
     Dcl-pi DPRRPG;
       pLibrary char(10);
       pObjType char(07);
       pCPF     char(07);
     End-pi;
 
     // Both "exec sql" is not executed but needed at compile time.
     // It must be placed just after the last "dcl" declaration.
     // LANGIDSHR defines the sort sequence as a "shared-weight sort
     // upper/lower insensitive, special characters are treated
     // "ä" as "A"
     // "Ü" as "E" and so on.
     exec sql set option Commit = *None;
     exec sql set option SRTSEQ = *LANGIDSHR;
     // preapre the data recordset
     exec sql declare C1 cursor for
     select WHLIB ,
            WHPNAM,
            WHFNAM,
            WHRFNM,
            WHTEXT,
            WHFUSG,
            WHOTYP
     from DPRFILE
     where
           WHLIB  like :F1LIB0lke
     and   WHPNAM like :F1PNAMlke
     and   WHRFNM like :F1RFNMlke
     and   WHFUSG between :F1FUSGstr and :F1FUSGend
     and   WHTEXT like :F1TEXTlke
     and   WHOTYP like :F1OTYPlke
 
     order by WHLIB, WHPNAM
 
     for read only;
     //*************************************************************
     // Start working...
     //*************************************************************
     wCmd = 'DSPPGMREF PGM(' + %trim(pLibrary)
            + '/*ALL) OUTPUT(*OUTFILE) OBJTYPE(' + %trim(pObjType)
            + ') OUTFILE(QTEMP/DPRFILE)';
     ReLoadSFL = *on;
     dow Dspf.Exit = *off;
       if ReLoadSFL;
         LoadSFL();
       endif;
       write S1CMD;
       exfmt FMT01;
       select;
       when Dspf.Exit; // F3=Exit
         leave;
       when Dspf.Refr   ; // Refresh
          F1FNAM = '           ';
          F1FNA2 = '           ';
          F1FNA3 = '           ';
       when Dspf.DoForF6; // F6=do something
       // call a program or a subroutine
       other; // Read user options
         dow 1 = 1;
           readc SFL1;
           if Not %eof;
             if S1OPT = '1';
             // call a program or a subroutine
             endif;
             if S1OPT = '2';
             // call a program or a subroutine
             endif;
             S1OPT = '>';
             update SFL1;
             S1OPT = ' ';
           else;
             leave;
           endif;
         enddo;
       endsl;
       SetFilters();
     enddo;
     exec sql close C1;
     *inlr = *on;
     //*************************************************************
     // Load subfile
     //*************************************************************
     dcl-proc LoadSFL;
       ReLoadSFL = *off;
       // Clear subfile
       Dspf.SflClr = *on;
       write FMT01;
       Dspf.SflClr = *off;
       // Load SFL
       SF1NUM = *zero;
       exec sql close C1;
       exec sql open C1;
       // Read recordset
       dow Sqlcode = 0 and SF1NUM < MaxSFLrec;
         exec sql fetch C1 into :RecordDS;
         if sqlcode = 0;
           pos1=0;
           pos2=0;
           pos3=0;
           wInclude='N';
           if F1FNAM=*blanks and F1FNA2=*blanks and F1FNA3=*blanks;
             wInclude='Y';
           else;
             if F1FNAM <> *blanks;
               pos1 = %scan(%trim(F1FNAM):WHFNAM);
             endif;
             if F1FNA2 <> *blanks;
               pos2 = %scan(%trim(F1FNA2):WHFNAM);
             endif;
             if F1FNA3 <> *blanks;
               pos3 = %scan(%trim(F1FNA3):WHFNAM);
             endif;
             if pos1>0 or pos2>0 or pos3>0;
               wInclude='Y';
             endif;
           endif;
           if wInclude='Y';
             S1LIB  = WHLIB ;
             S1PNAM = WHPNAM;
             S1FNAM = WHFNAM;
             S1RFNM = WHRFNM;
             S1FUSG = WHFUSG;
             S1TEXT = WHTEXT;
             S1OTYP = WHOTYP;
             SF1NUM += 1;
             write SFL1;
           endif;
         else;
           Dspf.SflEnd = *on;
         endif;
       enddo;
       NBRRECS = SF1NUM;
       S1MSG = %Editc(NBRRECS:'X') + ' record loaded. No more record +
       to load';
       if sqlcode = 0 and NBRRECS >= MaxSFLrec; // MaxSFLrec reached
         S1MSG = %Editc(NBRRECS:'X') + ' records loaded. Use filters +
         to limit the records to be loaded.';
       endif;
 
       if NBRRECS = 0;
         clear SFL1;
         SF1NUM += 1;
         S1LIB  = '*';
         S1MSG = 'No records loaded';
         if pCPF = 'CPF3033';
            S1MSG = 'Object *ALL of type ' + pObjType + ' not found';
         endif;
         if pCPF = 'CPF3064';
           S1MSG = 'Library ' + pLibrary + ' not found';
         endif;
         write SFL1;
       endif;
 
     end-proc;
     //*************************************************************
     // Set filters filed
     //*************************************************************
     dcl-proc SetFilters;
       if (F1LIB <>                F1LIB0prv); // char filter
           F1LIB0prv =             F1LIB ;
           F1LIB0lke = '%' + %trim(F1LIB ) + '%';
         ReLoadSFL = *on;
       endif;
 
       if (F1PNAM <>               F1PNAMprv); // char filter
           F1PNAMprv =             F1PNAM;
           F1PNAMlke = '%' + %trim(F1PNAM) + '%';
         ReLoadSFL = *on;
       endif;
 
       if (F1FNAM <>               F1FNAMprv); // char filter
           F1FNAMprv =             F1FNAM;
           F1FNAMlke = '%' + %trim(F1FNAM) + '%';
         ReLoadSFL = *on;
       endif;
 
       if (F1RFNM <>               F1RFNMprv); // char filter
           F1RFNMprv =             F1RFNM;
           F1RFNMlke = '%' + %trim(F1RFNM) + '%';
         ReLoadSFL = *on;
       endif;
 
       if (F1FNA2 <>               F1FNA2prv); // char filter
           F1FNA2prv =             F1FNA2;
           F1FNA2lke = '%' + %trim(F1FNA2) + '%';
         ReLoadSFL = *on;
       endif;
 
       if (F1FNA3 <>               F1FNA3prv); // char filter
           F1FNA3prv =             F1FNA3;
           F1FNA3lke = '%' + %trim(F1FNA3) + '%';
         ReLoadSFL = *on;
       endif;
 
       if (F1FUSG <>   F1FUSGprv); // numeric filter need str & end
           F1FUSGprv = F1FUSG;
           F1FUSGstr = F1FUSG;
           F1FUSGend = F1FUSG;
           ReLoadSFL = *on;
       endif;
       if (F1FUSG = 0); // numeric filter: if 0 set from 0 to HiVal
           F1FUSGprv = F1FUSG;
           F1FUSGstr = *zeros;
           F1FUSGend = *HiVal;
       endif;
 
       if (F1TEXT <>               F1TEXTprv); // char filter
           F1TEXTprv =             F1TEXT;
           F1TEXTlke = '%' + %trim(F1TEXT) + '%';
         ReLoadSFL = *on;
       endif;
 
       if (F1OTYP <>               F1OTYPprv); // char filter
           F1OTYPprv =             F1OTYP;
           F1OTYPlke = '%' + %trim(F1OTYP) + '%';
         ReLoadSFL = *on;
       endif;
 
     end-proc;

 


Conclusion


The DPR command, alongside the DPRCL and DPRRPG programs, provides an efficient way to manage program files on the IBM i system. By utilizing dynamic filters and a user-friendly display, users can quickly access the information they need, streamlining their workflow.


Feel free to explore the code snippets and adapt them to fit your specific needs!

Your feedback on DPR is highly valued, and I encourage you to share your thoughts and experiences. My goal is to continually improve and provide IBMi users with efficient and user-friendly solutions.
Stay tuned for more updates and innovative solutions on RPGFreeIBM.

Note: If you have access to PUB400, to try DPR type: addlible ffd11 *last then DPR F4

Comments

Post a Comment

Popular posts from this blog

IBMi (AS400) fans only ' Efficient WRKSPLF with WSF - How to Search string into spooled files, Sort, and Generate PDFs on IBMi

By -
Image
Searching Spooled Files Made Easy: A Unique Solution Managing spooled files efficiently is crucial for users dealing with numerous rows of print data. IBM's WRKSPLF command provides a standard way to interact with spooled files, but it lacks certain features that can significantly enhance user experience. In this article, we'll delve into a powerful functionality that IBM doesn't offer — the ability to search among spooled file lists. Our goal is to highlight the advantages of this capability and introduce a practical solution. The Limitations of Standard WRKSPLF While the WRKSPLF command is a handy tool for working with spooled files, it falls short in certain aspects. One prominent limitation is the inability to search efficiently through the list of spooled file rows. Users often find it challenging to quickly locate specific files based on criteria like creation date, status, or content. Introducing a Unique Solution: WSF (WorkSpooledFiles) To address the limitations of
Read more

IBMi (AS400) fans only - How to Sniff User Access

By -
Image
If you need to monitor user access on your IBM i system, you can use SQL to query the history log. Note: At the end of this post, you'll find a request directly addressed to you, the readers. Here’s a simple example of how you can do this: SELECT MESSAGE_ID,        MESSAGE_TIMESTAMP,        FROM_USER,        MESSAGE_TEXT     FROM TABLE (             QSYS2.HISTORY_LOG_INFO()         )     WHERE message_id IN ('CPF1164', 'CPF1124')           AND FROM_USER IN ('QSECOFR', 'QSYS', 'QSYSOPR')     ORDER BY MESSAGE_TIMESTAMP In this query: - QSYS2.HISTORY_LOG_INFO(): This function retrieves information from the history log. -  message_id IN ('CPF1164', 'CPF1124') : Filters the results to include only specific message IDs, which indicate sign-on and sign-off events. - FROM_USER in ('QSECOFR', 'QSYS', 'QSYSOPR'): Filters the results to include only messages from specific users. Update 28/07/2024: A Smart Enhancem
Read more

IBMi (AS400) fans only ' Detecting and Handling Non-Printable Characters in DB2 SQL Using LOCATE() and REPLACE() Functions

By -
Image
When working with DB2 SQL on the IBMi platform, one of the challenges we might encounter is dealing with non-printable characters in our data. These are characters that don't have a direct representation on a standard keyboard and can cause display programs to crash if not handled properly. For this example, we'll be working with the CLANA00F file, which contains customer data. You can find details on how to create this file on my blog post here . Non-printable characters can sneak into our records for various reasons, and to prevent issues, we can run an SQL query that uses the LOCATE() function. This function returns the position of the first occurrence of a substring within a string, allowing us to detect these problematic characters. Suppose we have a customer name with a non-printable character, specifically the EBCDIC '0D' character, which corresponds to the "Carriage Return" (CR) control character in ASCII. To find this character in our records, we can
Read more