midrange.com code scratchpad
Name:
program
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
06/20/2023 06:29:15 am
IP:
Logged
Description:
program fthat captures program call details along with their associated module, service program, library, and source file names:
Code:
  1. **FREE
  2.  
  3. ctl-opt option(*srcstmt:*nodebugio) dftactgrp(*no);
  4.  
  5. dcl-ds ApiReceiver;
  6.   ApiNum packed(10: 0);
  7.   ApiName char(10);
  8.   CalledModule char(10);
  9.   CalledModuleLibrary char(10);
  10.   ServiceProgram char(10);
  11.   ServiceProgramLibrary char(10);
  12.   SourceFileLibrary char(10);
  13.   SourceFile char(10);
  14. end-ds;
  15.  
  16. dcl-ds ApiParams qualified template;
  17.   Receiver char(256) varying;
  18.   ReceiverLength packed(10: 0);
  19.   ProgramName char(10) const;
  20.   ReferenceType char(10) const;
  21. end-ds;
  22.  
  23. dcl-ds CallHierarchy qualified;
  24.   Caller char(10);
  25.   CalledProgram char(10);
  26.   CalledModule char(10);
  27.   CalledModuleLibrary char(10);
  28.   ServiceProgram char(10);
  29.   ServiceProgramLibrary char(10);
  30.   SourceFileLibrary char(10);
  31.   SourceFile char(10);
  32. end-ds;
  33.  
  34. dcl-s ReferenceList likeDS(ApiReceiver) dim(100);
  35. dcl-s NumReferences packed(10: 0);
  36. dcl-s DriverProgram char(10);
  37. dcl-s OutputFile char(10) inz('CALL_DETAILS');
  38. dcl-s ErrorFlag ind inz(*Off);
  39.  
  40. DriverProgram = 'YOUR_DRIVER_PROGRAM';
  41.  
  42. dsply 'Enter the driver program name:';
  43. rqsdta DriverProgram;
  44.  
  45. callp CallProgramReferences(ReferenceList : NumReferences : DriverProgram);
  46.  
  47. if (NumReferences > 0);
  48.   dsply 'Referenced Programs:';
  49.   for i = 1 to NumReferences;
  50.     dsply ReferenceList(i).ApiName;
  51.     write CallHierarchy;
  52.   endfor;
  53. else;
  54.   dsply 'No referenced programs found for ' + DriverProgram;
  55. endif;
  56.  
  57. if (ErrorFlag);
  58.   dsply 'Errors occurred during program call tracing.';
  59. else;
  60.   dsply 'Program call tracing completed successfully.';
  61. endif;
  62.  
  63. *INLR = *ON;
  64.  
  65. // Subprocedure to retrieve program references
  66. dcl-proc CallProgramReferences;
  67.   dcl-pi *n;
  68.     Receiver likeDS(ApiReceiver) dim(500);
  69.     ReceiverLength packed(10: 0);
  70.     ProgramName char(10) const;
  71.   end-pi;
  72.  
  73.   dcl-s Index packed(10: 0);
  74.   dcl-s NextProgram char(10);
  75.   dcl-ds ProgramInfo qualified;
  76.     ProgramName char(10);
  77.     LibraryName char(10);
  78.     SourceFileLibrary char(10);
  79.     SourceFile char(10);
  80.   end-ds;
  81.  
  82.   // Add current program to the receiver list
  83.   Receiver(Index).ApiName = ProgramName;
  84.   Index += 1;
  85.  
  86.   // Call QBNRPRV API to retrieve program references
  87.   ApiParams.ReceiverLength = %size(ApiParams.Receiver);
  88.   ApiParams.ProgramName = ProgramName;
  89.   ApiParams.ReferenceType = 'PRVALL';
  90.  
  91.   callp 'QBNRPRV' ApiParams;
  92.  
  93.   // Traverse through the received programs and call recursively for each program
  94.   for Index = 1 to ApiParams.ReceiverLength;
  95.     NextProgram = ApiParams.Receiver(Index).ApiName;
  96.     if (NextProgram <> '');
  97.       // Retrieve program information
  98.       callp GetProgramInfo(ProgramInfo : NextProgram);
  99.  
  100.       // Store the program details in the output file
  101.       CallHierarchy.Caller = ProgramName;
  102.       CallHierarchy.CalledProgram = ProgramInfo.ProgramName;
  103.       CallHierarchy.CalledModule = ApiParams.Receiver(Index).CalledModule;
  104.       CallHierarchy.CalledModuleLibrary = ApiParams.Receiver(Index).CalledModuleLibrary;
  105.       CallHierarchy.ServiceProgram = ApiParams.Receiver(Index).ServiceProgram;
  106.       CallHierarchy.ServiceProgramLibrary = ApiParams.Receiver(Index).ServiceProgramLibrary;
  107.       CallHierarchy.SourceFileLibrary = ProgramInfo.SourceFileLibrary;
  108.       CallHierarchy.SourceFile = ProgramInfo.SourceFile;
  109.       write CallHierarchy;
  110.  
  111.       // Call recursively for the called program
  112.       callp CallProgramReferences(Receiver : ReceiverLength : NextProgram);
  113.     endif;
  114.   endfor;
  115.  
  116.   return;
  117. end-proc;
  118.  
  119. // Subprocedure to retrieve program information
  120. dcl-proc GetProgramInfo;
  121.   dcl-pi *n;
  122.     ProgramInfo likeDS(ProgramInfo);
  123.     ProgramName char(10) const;
  124.   end-pi;
  125.  
  126.   dcl-s ProgramAttributes char(264);
  127.   dcl-s ProgramAttributeOffset packed(10: 0) inz(16);
  128.   dcl-s AttributeType char(10);
  129.   dcl-s AttributeLength packed(10: 0);
  130.   dcl-s AttributeValue char(200);
  131.   dcl-s ReturnCode packed(10: 0);
  132.  
  133.   callp 'QCLRPGMI' ProgramAttributes
  134.                    ProgramName
  135.                    ProgramAttributeOffset
  136.                    ReturnCode;
  137.  
  138.   // Loop through the program attributes
  139.   dow (ProgramAttributeOffset > 0);
  140.     // Retrieve the attribute type
  141.     AttributeType = %subst(ProgramAttributes: ProgramAttributeOffset + 1: 10);
  142.  
  143.     // Retrieve the attribute length
  144.     AttributeLength = %bin(%subst(ProgramAttributes: ProgramAttributeOffset + 13: 4));
  145.  
  146.     // Retrieve the attribute value
  147.     AttributeValue = %subst(ProgramAttributes: ProgramAttributeOffset + 17: AttributeLength);
  148.  
  149.     // Store the program information based on attribute type
  150.     select;
  151.       when (AttributeType = 'MODNAME   ');
  152.         ProgramInfo.ProgramName = AttributeValue;
  153.       when (AttributeType = 'SRCFILE   ');
  154.         ProgramInfo.SourceFile = %subst(AttributeValue: 1: 10);
  155.         ProgramInfo.SourceFileLibrary = %subst(AttributeValue: 11: 10);
  156.       when (AttributeType = 'SRCLIB    ');
  157.         ProgramInfo.SourceFileLibrary = AttributeValue;
  158.       when (AttributeType = 'LIBRARY   ');
  159.         ProgramInfo.LibraryName = AttributeValue;
  160.     endsl;
  161.  
  162.     // Calculate the offset for the next attribute
  163.     ProgramAttributeOffset += AttributeLength + 17;
  164.   enddo;
  165.  
  166.   return;
  167. end-proc;
  168.  
© 2004-2019 by midrange.com generated in 0.004s valid xhtml & css