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);

//***********************************************************************************
//  PURPOSE: This application will check IFS object existence, read, write or execute
// **********************************************************************************
//  COMPILE Module: CRTRPGMOD MODULE(*CURLIB/JSIFSOBJEX) SRCFILE(*CURLIB/QRPGLESRC)
//                  SRCMBR(JSIFSOBJEX) DBGVIEW(*SOURCE) REPLACE(*YES)
//  COMPILE SrvPgm: CRTSRVPGM SRVPGM(*CURLIB/JSIFSOBJEX) EXPORT(*ALL) ACTGRP(*CALLER)
//  Bindding Dir:   ADDBNDDIRE BNDDIR(JASTOOL) OBJ((JSIFSOBJEX))
// **********************************************************************************
/define ifs_Obj_Exists_PR
/copy qProtosrc,JSIFSOBJEX

dcl-proc ifs_Obj_Exists export;

  /define ifs_Obj_Exists_PI
  /copy qProtosrc,JSIFSOBJEX

  dcl-pr Object_Exists int(10) ExtProc('access');
    *n Pointer Options(*String:*trim) value;  // Path + file

    // 0 = File Exist
    // 1 = execute or search
    // 2 = Write access
    // 4 = Read access
    *n int(10)                        value;  // Access mode
  end-pr;

  dcl-s ifs_Obj_Exists ind     inz(*off);
  dcl-s w_Return       int(10) inz;
  dcl-s w_Access       int(10) inz;

  // Main procedure *******************************************************************
  if %parms >= %parmnum(p_Access);
    w_Access = p_Access;

  else; // Default this function to checking of file exists
    w_Access = 0;
  endIf;

  w_Return = Object_Exists(p_Object :w_Access);
  Select;
  When w_Access = 0 and w_Return = 0;  // (File Exists)
    ifs_Obj_Exists = *on;
  When w_Access = 1 and w_Return = 1;  // (Execute or search permission)
    ifs_Obj_Exists = *on;

  When w_Access = 2 and w_Return = 2;  // (Write access permission)
    ifs_Obj_Exists = *on;

  When w_Access = 4 and w_Return = 4;  // (Read access permission)
    ifs_Obj_Exists = *on;

  Other;                               // Error or unknown status
    ifs_Obj_Exists = *off;
  endSl;

  return ifs_Obj_Exists;
end-proc;