This procedure was written to check for the existence of a table on either the IFS or a network server. Using the c function Access for the IFS and for the network FTPing to the server and attempting a rename to itself.  Then checking the FTP output file for error.  This is just for an example.  Feel free to download the code and make changes as required.  Our hope is that you will come back and use the BLOG response process to re-post you example.

Objects:

  • CHKIFS
    • main processing code
  • CHKIFS_CP
    • copy book of the “pr”
  • CHKIFS_TST
    • An example of how to use the procedure

 

CHKIFS

[cc lang=”php”]

H NOMAIN EXPROPTS(*RESDECPOS)
H BNDDIR(‘QC2LE’)
* PROGRAM – CHKIFS
* PURPOSE – verify that a full path table on iFS exists
* WRITTEN – 03/19/2020
* AUTHOR – Jamie Flanary

/copy qprcsrc,COMMAND_CP
/copy qprcsrc,CHKIFS_CP

d DoesTableExist…
d s 10i 0 inz
d ERROR_FLAG s n inz
d File_Exists…
d c Const(0)
d MyUser s 10 inz
d MyPassword s 10 inz
d MySQlString s 256 inz varying
d pointer s *

d ProcessFlag s 1 inz
d Q s 1 inz(””)
d Read_Authority…
d c Const(4)
d RecordsInError s 10i 0 inz
d serverIp s 15 inz(‘10.0.0.0’)
d ThisFolder s 100a varying
d ThisDrawing s 100a varying
d token S 160A varying
d Write_Authority…
d c Const(2)
*
d access pr 10i 0 ExtProc(‘access’)
d szIFSFile * Value options(*STRING)
d nAccessMode 10i 0 value

*
* Begin Procedure
*
p DoesThisTableExist…

P B export
* Procedure Interface
d DoesThisTableExist…
d pi n
d Infullpath 1000 varying
*
d RunSQLInsert pr n
d String 256a varying const
*

dstrtok PR * ExtProc(‘strtok’)
d string * value options(*string)
d delim * Value Options(*string)
/free

Exec Sql Set Option –Naming = *Sys,
Commit = *None,
SRTSEQ = *LANGIDUNQ;
reset ProcessFlag;
// check the server first
if %subst(infullpath:1:2) = ‘\\’;
//\\rbsc-dc02 remove the server
infullpath = %subst(Infullpath:12);
// delete overrides to FTP tables
OneThousandLong = ‘DLTOVR FILE(INPUT) LVL(*JOB)’;
monitor;
runcommand(OneThousandLong);
on-error;
endmon;
OneThousandLong = ‘DLTOVR FILE(OUTPUT) LVL(*JOB)’;
monitor;
runcommand(OneThousandLong);
on-error;
endmon;

// delete the FTP tables
OneThousandLong = ‘DLTF FILE(QTEMP/INPUT)’;
monitor;

runcommand(OneThousandLong);
on-error;
endmon;

OneThousandLong = ‘DLTF FILE(QTEMP/OUTPUT)’;
monitor;
runcommand(OneThousandLong);
on-error;
endmon;

// create the ftp files
OneThousandLong = ‘CRTPF FILE(QTEMP/INPUT) ‘ +
‘ RCDLEN(256)’;
monitor;
runcommand(OneThousandLong);
on-error;
endmon;

// CRTDUPOBJ OBJ(OUTPUT) FROMLIB(*LIBL)
// OBJTYPE(*FILE) TOLIB(QTEMP) CST(*NO) TRG(*NO)

OneThousandLong = ‘CRTDUPOBJ OBJ(OUTPUT) FROMLIB(*LIBL) ‘ +
‘OBJTYPE(*FILE) TOLIB(QTEMP) CST(*NO) TRG(*NO)’;
monitor;
runcommand(OneThousandLong);
on-error;
endmon;

// override the input table
OneThousandLong =
‘OVRDBF FILE(INPUT) TOFILE(INPUT) OVRSCOPE(*JOB)’;
monitor;
runcommand(OneThousandLong);
on-error;
endmon;

// override the output table
OneThousandLong =
‘OVRDBF FILE(OUTPUT) TOFILE(QTEMP/OUTPUT) OVRSCOPE(*JOB)’;
monitor;
runcommand(OneThousandLong);

on-error;
endmon;

// populate the input file
MySqlString = ‘MyServerID    MyPassword;
RunSQLInsert(MYSqlString);

// need to CD down to the table
//seperate out the folders from the table
// finish in morning
pointer = strtok(%trim(InFullpath) : ‘\’);
dow (pointer <> *null);
token = %trim(%str(pointer));
pointer = strtok(*null: ‘\’);
ThisFolder = %trim(token);
// write to input here if we dont find a “.” in the name
if %scan(‘.’:ThisFolder) = *zeros;
MySqlString = ‘CD ‘ + ThisFolder;
RunSQLInsert(MYSqlString);
endif;

enddo;
ThisDrawing = ThisFolder;

// rename to itself as a test
MySqlString = ‘rename ‘ +Q+ThisDrawing+Q+’ ‘ +Q+ThisDrawing+Q;
RunSQLInsert(MYSqlString);

// rename to itself as a test
MySQlString = ‘quit’;
RunSQLInsert(MySqlString);

// start FTP

OneThousandLong = ‘FTP ‘ +Q + %trim(ServerIP) + Q;
monitor;
runcommand(OneThousandLong);
on-error;
endmon;

// sql the output table looking for total failure
// 550 The system cannot find the file specified.
reset RecordsInError;
exec sql
select coalesce(count(*),0)
into :RecordsInError
FROM output
where substr(outputtext,1,3) = ‘550’ ;

// set error flag if error found
if recordsInError > *zeros;
DoesTableExist = 999;
else;
DoesTableExist = 0;
endif;

else;
// validate the IFS
DoesTableExist =
access(infullpath : File_Exists);

endif;

//
// * F_OK = File Exists
// * R_OK = Read Access
// * W_OK = Write Access
// * X_OK = Execute or Search
// **********************************************************************
// D F_OK C 0
// D R_OK C 4
// D W_OK C 2
// D X_OK C 1
//

if DoesTableExist = *zeros;
ProcessFlag = *off;
else;
ProcessFlag = *on;
endif;

return ProcessFlag;
/end-free
p DoesThisTableExist…
p e
*————————————————————-
* ReadIFSTable – Subprocedure To Read The IFS File
*————————————————————-
p RunSQLInsert b export
d RunSQLInsert pi n
d InputString 256a varying const

d Erro_Flag s n inz

reset Error_Flag;

exec sql
insert into input
values(:MySQLString);

Return Error_Flag;

*———————————————————
p RunSQLInsert E

[/cc]

CHKIFS_CP

[cc lang=”php”]

* CHKOIFS_CP – run a command from RPG program
d DoesThisTableExist…
d pr n
d Infullpath 1000a varying

[/cc]

CHKIFS_TST

[cc lang=”php”]

H DFTACTGRP(*NO) OPTION(*SRCSTMT: *NODEBUGIO) BNDDIR(‘UTILITIES’)
/copy qprcsrc,CHKIFS_CP

d MyFolderPath s 1000 varying
d MyErrorBack s n Inz

/Free
// /home/Engineering/Customer/BRAAS/R50-23114/R50-23114-1.PDF
//
reset MyErrorBack;
MyFolderPath = ‘/home/Engineering/Customer/’ +
‘BRAAS/R50-23114/R50-23114-1.PDF’;
MyErrorback = DoesThisTableExist(MyFolderPath);

reset MyErrorBack;
MyFolderPath = ‘/home/jamie/’ +
‘QPRTJOB/QSECOFR/000648_000444_NLSTXT_07062018_00????.PDF’;
MyErrorback = DoesThisTableExist(MyFolderPath);

// \\rbsc-dc02\Engineering\DRAWINGS\New Building\120914 LAYOUT.pdf
reset MyErrorBack;
MyFolderPath = ‘\\rbsc-dc02\Engineering\DRAWINGS\’ +
‘New Building\Racks 2013.dwg’;
MyErrorback = DoesThisTableExist(MyFolderPath);

// \\rbsc-dc02\Engineering\DRAWINGS\New Building\noFound.pdf
reset MyErrorBack;
MyFolderPath = ‘\\rbsc-dc02\Engineering\DRAWINGS\’ +
‘New Building\Notfound.pdf’;
MyErrorback = DoesThisTableExist(MyFolderPath);

*inlr = *on;

[/cc]

Check Object on IFS or Server
Check Object on IFS or Server

Use this procedure to determine if IFS or Server object exists.

 

 

Check IFS/Server for a document
Tagged on: