You must be logged in to use the copy button.

        
**Free
ctl-opt
   copyright('Copyright JAS, Inc. 2024')
   nomain debug
   option(*srcstmt : *nodebugio ) ccsid(*char:*jobrun)
   decedit(*jobrun) alwnull(*usrctl)
   bnddir('JASTOOL');

//***********************************************************************************
//  PURPOSE: This application will execute CL command
// **********************************************************************************
//  COMPILE Module: CRTRPGMOD MODULE(*CURLIB/JSCLCMD) SRCFILE(*CURLIB/QRPGLESRC)
//                  SRCMBR(JSCLCMD) DBGVIEW(*SOURCE) REPLACE(*YES)
//  COMPILE SrvPgm: CRTSRVPGM SRVPGM(*CURLIB/JSCLCMD) EXPORT(*ALL) ACTGRP(*CALLER)
//                  OPTION(*DUPPROC)
// Bindding Dir...: ADDBNDDIRE BNDDIR(JASTOOL) OBJ((JSCLCMD))
// **********************************************************************************
// Declare the external procedure for system API
dcl-pr cl_Command int(10) extproc('system');
  *n Pointer options(*String:*Trim) value;
end-pr;

/copy qProtosrc,JS000PSDS

/define Get_Caller_pr
/copy qProtosrc,JSCALLSTK

/define Obj_Exists_PR
/copy qProtosrc,JSOBJEXIST

dcl-ds ds_Data qualified DtaAra('*libl/JSCLCMD');
  w_SendMSg char(1);
  w_User    char(10);
end-Ds;

// Main procedure to execute a CL command *******************************************
/define cl_cmd_pr
/copy qProtosrc,jsclCmd

dcl-proc cl_cmd export;

  /define cl_cmd_pi
  /copy qProtosrc,jsclCmd

  dcl-s w_Status   int(10)   inz;
  dcl-s w_command  char(150) inz;
  dcl-s cl_cmd     ind       inz(*off);

  //** Main ***************************************************************************
  // Check if the data area exists
  if not Obj_Exists('JSCLCMD' :'*DTAARA');
    // Create the Data Area
    w_Command = 'CRTDTAARA DTAARA(JSCLCMD)'
              + ' TYPE(*CHAR) LEN(11)' 
              + ' VALUE(''N          '')'
              + ' TEXT(''Exec CL Cmd Data Area'')';
    if cl_Command(w_Command) = 0;
      in ds_Data;
    endIf;
  else;
    in ds_Data;
  endIf;

  // Call the system API to execute the command
  w_Status = cl_Command(p_Command);
  if w_Status = 0;   // Command executed successfully
    cl_cmd = *on;

  // Command did not execute, notify the requester if specified
  elseif %upper(ds_Data.w_SendMsg) = 'Y' and
        (ds_Data.w_User = *blanks or %trim(ds_Data.w_User) = %trim(pgm_sts.##psUSR));
    cl_cmd = *off;
    w_command = %str(p_Command :%size(p_Command));
    callp SendMessage(w_Command);
  else;
    cl_cmd = *off;
  endif;

  return cl_cmd; // Return the w_Status
end-proc;

//************************************************************************************
// This is needed for debugging purposes to make sure that the CL command being works
// before moving my application to production system.
//************************************************************************************
dcl-proc SendMessage;
  dcl-pi *n;
    p_Text    char(50) const;
  end-pi;

  dcl-s w_Text    like(p_Text) inz;
  dcl-s w_Program char(10)     inz;

  w_Program = Get_Caller(4);           // Pos is 4 since procedure will added to the stack
  w_Text = 'Program (' + %trim(w_Program) + ') failed to execute.';

  dsply w_text;

  w_Text = %xlate(x'7D' :'`' :%trim(p_Text));
  dsply w_text;
  return;
end-proc;