RPGIV @ Work

A unique site for RPG and System i Lovers

Welcome!

Hi, this site will provide all what you need in System i and RPG developments.

My Name is Chamara Withanachchi, System i Expert and RPG Developer. And in the field for last 11 years.

I hope you will find lot of valuable information from this site

Extract the PCML info with QBNRPII Print E-mail
User Rating: / 1
PoorBest 
Written by Chamara Withanachchi   

Command to display the PCML in an program, and the RPGLE command processing program. The RPG program calls the QBNRPII API to get the information. (To get PCML into an RPG or COBOL program, specify PGMINFO(*YES *MODULE) on the compile command.)


  CMD ('Display the PCML in a module') 
            PARM      KWD(OBJ) TYPE(QUALOBJ) PROMPT('Object + 
                          containing module') 
            PARM      KWD(MODULE) TYPE(QUALMOD) DFT(*ALLBNDMOD) + 
                          SNGVAL((*ALLBNDMOD *ALLBNDMOD)) + 
                          PROMPT('Module') 
            PARM      KWD(OBJTYPE) TYPE(*CHAR) LEN(10) RSTD(*YES) + 
                          DFT(*PGM) VALUES(*PGM *SRVPGM) + 
                          SPCVAL((*PGM *PGM) (*SRVPGM *SRVPGM)) + 
                          PROMPT('Object type') CHOICE('*PGM *SRVPGM') 
            PARM      KWD(STATSONLY) TYPE(*CHAR) LEN(10) RSTD(*YES) + 
                          DFT(*NO) VALUES(*NO *YES) + 
                          SPCVAL((*NO *NO) (*YES *YES)) + 
                          PROMPT('Show stats only') CHOICE('*NO *YES') 
  
  QUALOBJ:      QUAL TYPE(*NAME)              + 
                EXPR(*YES)                    + 
                LEN(10) 
          QUAL TYPE(*NAME)                    + 
                EXPR(*YES)                    + 
                LEN(10)                       + 
                DFT(*LIBL)                    + 
                SPCVAL((*CURLIB *CURLIB)      + 
                      (*LIBL *LIBL))          + 
                PROMPT('Library') 
  QUALMOD:      QUAL TYPE(*NAME)              + 
                EXPR(*YES)                    + 
                LEN(10) 
          QUAL TYPE(*NAME)                    + 
                EXPR(*YES)                    + 
                LEN(10)                       + 
                DFT(*ANY)                     + 
                SPCVAL((*ANY *ANY))           + 
                PROMPT('Library') 


      /if defined(*crtbndrpg) 
    H dftactgrp(*No) actgrp(*NEW) 
      /endif 
    H bnddir('QC2LE') 
  
    D psds          sds 
    D  errmsg                      7a    overlay(psds:40) 
  
    D qualname       ds                  qualified based(template) 
    D  obj                        10a 
    D  lib                        10a 
  
      * Prints the value of the module's PCML, or "***NOTFOUND***" if 
      * the PCML was not in the module. 
    D dspPcmlFromModule... 
    D                pr                  extpgm('DSPPCMLMD') 
    D  objQual                           likeds(qualname) const 
    D  modQual                           likeds(qualname) const 
    D  objType                    10a    const 
    D  statsOnly                  10a    const 
  
    D dspPcmlFromModule... 
    D                pi 
    D  objQual                           likeds(qualname) const 
    D  modQual                           likeds(qualname) const 
    D  objType                    10a    const 
    D  statsOnly                  10a    const 
  
    D buffer          s        65535a    based(bufPtr) 
  
    D Qbn_Interface_Entry_t... 
    D                ds                  qualified based(template) 
      * Offset from start of receiver 
    D  Offset_Next_Entry... 
    D                              10i 0 
    D  Module_Name... 
    D                              10a 
    D  Module_Library... 
    D                              10a 
    D  Interface_Info_CCSID... 
    D                              10i 0 
    D  Interface_Info_Type... 
    D                              10i 0 
      * Offset from start of receiver 
    D  Offset_Interface_Info... 
    D                              10i 0 
    D  Interface_Info_Length_Ret... 
    D                              10i 0 
    D  Interface_Info_Length_Avail... 
    D                              10i 0 
  
    D Qbn_PGII0100_t  ds                 qualified based(template) 
    D  Bytes_Returned... 
    D                              10i 0 
    D  Bytes_Available... 
    D                              10i 0 
    D  Obj_Name... 
    D                              10a 
    D  Obj_Lib_Name... 
    D                              10a 
    D  Obj_Type... 
    D                              10a 
    D  Reserved3... 
    D                               2a 
    D  Offset_First_Entry... 
    D                              10i 0 
    D  Number_Entries... 
    D                              10i 0 
  
    D errcode        ds                  qualified 
    D  bytesprov                   10i 0 inz(0) 
    D  bytesavail                  10i 0 
  
      * Define the initial storage for the first call to the API 
    D tempRcvr        ds                 likeds(Qbn_PGII0100_t) 
    D rcvr            ds                 likeds(Qbn_PGII0100_t) 
    D                                    based(pRcvr) 
    D pRcvr          s               *   inz(*null) 
  
    D entry          ds                  likeds(Qbn_Interface_Entry_t) 
    D                                    based(pEntry) 
    D pEntryData      s              * 
  
    D data            s            50a   based(pData) 
    D line            s            80a   varying 
    D off            s              6p 0 
    D lenRemaining    s            10i 0 
    D len            s             10i 0 
  
    D memcpy          pr             *   extproc('__memcpy') 
    D  rcvr                          *   value 
    D  src                           *   value 
    D  len                         10u 0 value 
  
    D print          pr 
    D  msg                           *   value options(*string) 
  
      * Prototype for QBNRPII (Retrieve Program Interface Information) 
      * The receiver might be larger than the RPG limit of 64K 
      * so we'll just define it as the structure header, but actually 
      * pass a larger receiver 
    D QBNRPII        pr                 extpgm('QBNRPII') 
    D  Receiver_variable... 
    D                                   likeds(Qbn_PGII0100_t) 
    D  Length_of_receiver_variable... 
    D                              10i 0const 
    D  Format_name... 
    D                               8a  const 
    D  Qualified_object_name... 
    D                                   likeds(qualname) const 
    D  Object_Type... 
    D                              10a  const 
    D  Qualified_bound_module_name... 
    D                                   likeds(qualname) const 
    D  Error_code... 
    D                                   likeds(errcode) 
      /free 
  
        // print parms 
        print ('Printing PCML info'); 
        print ('  Object: ' + %trim(objQual.lib) + '/' + objQual.obj 
            + objType); 
        if (modQual.lib = *blank); 
          print ('  Module: ' + modQual.obj); 
        else; 
          print ('  Module: ' + %trim(modQual.lib) + '/' + modQual.obj); 
        endif; 
  
        // call the API once, to see how much storage to allocate 
        callp(e) QBNRPII (tempRcvr : %size(tempRcvr) : 'RPII0100' 
              :  objQual : objType : modQual : errcode); 
        if %error; 
          print ('  Error ' + errmsg + ' retrieving info'); 
          exsr cleanup; 
          return; 
        endif; 
  
        print ('  Length of information: ' 
              + %char(tempRcvr.Bytes_Available)); 
        if statsOnly = '*YES'; 
          exsr cleanup; 
          return; 
        endif; 
  
        if tempRcvr.Bytes_Available <= tempRcvr.Bytes_Returned; 
          pRcvr = %addr(tempRcvr); 
        else; 
          pRcvr = %alloc(tempRcvr.Bytes_Available); 
          callp(e) QBNRPII (rcvr : tempRcvr.Bytes_Available : 'RPII0100' 
              :  objQual : objType : modQual : errcode); 
        endif; 
        if %error 
        or rcvr.Number_Entries = 0; 
          print ('  Information not found'); 
          exsr cleanup; 
          return; 
        endif; 
  
        pEntry = pRcvr + rcvr.offset_First_Entry; 
        pEntryData = pRcvr + entry.Offset_Interface_Info; 
        lenremaining = entry.Interface_Info_Length_Ret; 
        print ('  Length of data: ' 
              + %char(entry.Interface_Info_Length_Ret)); 
  
        if lenRemaining = 0; 
          exsr cleanup; 
          return; 
        endif; 
        off = 0; 
        dow lenRemaining > 0; 
          len = lenRemaining; 
          if len > %size(data); 
              len = %size(data); 
          endif; 
          pData = pEntryData + off; 
          line = %editc(off:'N') + ':  ' + %subst(data : 1: len); 
          print (line); 
          off = off + len; 
          lenRemaining = lenRemaining - len; 
        enddo; 
        exsr cleanup; 
        return; 
  
        //--------------------------------------- 
        // S U B R O U T I N E S 
        //--------------------------------------- 
        begsr cleanup; 
          if  pRcvr <> *null 
          and pRcvr <> %addr(tempRcvr); 
              dealloc(n) pRcvr; 
          endif; 
        endsr; 
  
      /end-free 
  
    P print          b 
    D print          pi 
    D  msg                          *  value options(*string) 
    D printf         pr                extproc('printf') 
    D  template                     *  value options(*string) 
    D  msg                          *  value options(*string : *nopass) 
    D newline        c                 x'15' 
      /free 
        printf ('%s' + newline : msg); 
      /end-free 
    P print          e 


Thanks to Barbara Morris
<Previous   Next>