2004-09-05 如何顯示 ILE Program 由哪一 source file 的 member 產生？(API QBNLPGMI)

如何顯示 ILE Program 由哪一 source file 的 member 產生？(API QBNLPGMI)


	

ILE 程式至少包含一個模組，或可以由多個模組組成，所以要透過
 API QBNLPGMI (List ILE Program Information) 來顯示 模組資訊。


FILE  : QRPGLESRC
MEMBER: LSTMODINF
TYPE  : RPGLE
USAGE : CRTBNDRPG LSTMODINF
        CALL LSTMODINF ('LSTMODINF *LIBL     ')
        參數為 20 位，前十位為程式名稱，後十位為程式庫。
OS Version: 由於此範例以 V5R1 所支援的 free format 撰寫，所以此範例需要由 V5R1 
            後的 complier 編譯。 但你也可以自行修改為 V4R5 前的版本。


      * The DSPPGM command does not have the option to write information to an
      * outfile. To get this information programmatically, you have to use the
      * List ILE Program Information (QBNLPGMI) API.

      * The following ILE RPG program demonstrates retrieving the source file,
      * library, and member using this API:

     H DFTACTGRP(*NO) OPTION(*SRCSTMT)
      *
      * List ILE Program Information (QBNLPGMI) API
      *
     D QBNLPGMI        PR                  ExtPgm('QBNLPGMI')
     D  UserSpace                    20A   const
     D  Format                        8A   const
     D  ProgramName                  20A   const
     D  ErrorCode                  8000A   options(*varsize)

      *
      * Create User Space (QUSCRTUS) API
      *
     D QUSCRTUS        PR                  ExtPgm('QUSCRTUS')
     D  UserSpace                    20A   const
     D  ExtAttr                      10A   const
     D  InitSize                     10I 0 const
     D  InitValue                     1A   const
     D  PublicAuth                   10A   const
     D  Text                         50A   const
     D  Replace                      10A   const
     D  ErrorCode                  8000A   options(*varsize)

      *
      * Retrieve Pointer to User Space (QUSPTRUS) API
      *
     D QUSPTRUS        PR                  ExtPgm('QUSPTRUS')
     D  UserSpace                    20A   const
     D  Pointer                        *
     D  ErrorCode                  8000A   options(*varsize: *nopass)

      *
      * Delete User Space (QUSDLTUS) API
      *
     D QUSDLTUS        PR                  ExtPgm('QUSDLTUS')
     D   UsrSpc                      20A   const
     D   ErrorCode                 8000A   options(*varsize)

      *
      * Resend Message (QMHRSNEM) API
      *
     D QMHRSNEM        PR                  ExtPgm('QMHRSNEM')
     D   MsgKey                       4A   const
     D   ErrorCode                32766A   options(*varsize)
     D   ToStkEntry               32766A   options(*varsize: *nopass)
     D   ToStkEntryLn                10I 0 const options(*nopass)
     D   Format                       8A   const options(*nopass)
     D   FromEntry                     *   const options(*nopass)
     D   FromCounter                 10I 0 const options(*nopass)

      *
      * The following works like an *ENTRY PLIST:
      *
     D LstModInf       PR                  ExtPgm('LSTMODINF')
     D   PgmName                     20A   const
     D LstModInf       PI
     D   PgmName                     20A   const

      *
      * Header Information for List APIs
      *
     D p_ListHdr       s               *
     D ListHdr         DS                   BASED(p_ListHdr)
     D                                      qualified
     D                              124A
     D   Offset                      10I 0
     D   Size                        10I 0
     D   NoEntries                   10I 0
     D   EntrySize                   10I 0

      *
      *  List Entry for ILE Module Information
      *
     D p_Mod           S               *
     D Mod             DS                  based(p_Mod)
     D                                     qualified
     D   PgmName                     10A
     D   PgmLib                      10A
     D   Name                        10A
     D   Lib                         10A
     D   SrcName                     10A
     D   SrcLib                      10A
     D   SrcMbr                      10A
     D   Attr                        10A
     D   ModCrt                      13A
     D   SrcUpd                      13A

      *
      * Information needed to re-send a message
      *
     D Resend          ds                  qualified
     D   StackCnt                    10I 0 inz(2)
     D   StackQual                   20A   inz('*NONE     *NONE')
     D   IdLen                       10I 0 inz(7)
     D   StackID                      7A   inz('*')

      *
      * API Error Structure
      *
      *   Since "BytesProv" is set to zero, the API will
      *   send an escape message if an error occurs.
      *
     D NullError       ds                  qualified
     D   BytesProv                   10I 0 inz(0)
     D   BytesAvail                  10I 0

      *
      *  Local variables
      *
     D UsrSpc          c                   'MODLIST   QTEMP'
     D Entry           s             10I 0

      /free

          //
          //  a) Use the QUSCRTUS API to create a user space.
          //
          //  b) Use the QBNLPGMI API to list the modules
          //       that make up the ILE program to the user
          //       space.
          //
          //  c) Use the QUSPTRUS API to get a pointer to
          //       the user space.
          //
          //  If an error occurs, re-send the error message that
          //  the API generated to the program that called this
          //  one.
          //

          monitor;

              QUSCRTUS( UsrSpc
                      : *blanks
                      : 32 * 1024
                      : x'00'
                      : '*ALL'
                      : 'Temp UsrSpc for Module List'
                      : '*YES'
                      : NullError );

              QBNLPGMI( UsrSpc
                      : 'PGML0100'
                      : PgmName
                      : NullError );

              QUSPTRUS( UsrSpc : p_ListHdr );

          on-error;

              QMHRSNEM( *blanks
                      : NullError
                      : Resend
                      : %size(Resend)
                      : 'RSNM0100'
                      : *NULL
                      : 0 );

          endmon;


          //
          //  loop through the entries in the user space
          //

          for Entry = 0 to (ListHdr.NoEntries - 1);

              p_Mod = p_ListHdr
                    + ListHdr.Offset
                    + (Entry * ListHdr.EntrySize);

              //
              // At this point the MOD data structure contains
              // information for one of the modules in the
              // given program.
              //
              //    Mod.Name    = module name
              //    Mod.Lib     = library of module
              //    Mod.SrcName = source file name
              //    Mod.SrcLib  = source file library
              //    Mod.SrcMbr  = source member
              //

              // INSERT CODE THAT USES THESE FIELDS HERE

                    Dsply Mod.SrcName;
                    Dsply Mod.SrcLib ;
                    Dsply Mod.SrcMbr ;

          endfor;


          //
          // To clean up, delete the user space
          //

          monitor;
              QUSDLTUS( UsrSpc : NullError );
          on-error;
              QMHRSNEM( *blanks
                      : NullError
                      : Resend
                      : %size(Resend)
                      : 'RSNM0100'
                      : *NULL
                      : 0 );
          endmon;

          *inlr = *on;

      /end-free