/if defined(*crtbndrpg) H dftactgrp(*No) actgrp(*NEW) /endif H bnddir('QC2LE') * Prototype and PI for this program: * Prints the value of the module's PCML, or "***NOTFOUND***" if * the PCML was not in the module. D dspPcmlFromModule... D pr extpgm('DSPPCMLR') 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 psds sds D errmsg 7a overlay(psds:40) D qualname ds qualified based(TypeDef) D obj 10a D lib 10a D Qbn_Interface_Entry_t... D ds qualified based(typedef) * 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(typedef) 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 i s 10i 0 D entry_off s 10i 0 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 0 const 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; entry_off = rcvr.offset_First_Entry; for i = 1 to rcvr.Number_Entries; pEntry = pRcvr + entry_off; entry_off = entry.Offset_Next_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; endfor; 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