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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
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<span style="color: #0000ff;">'</span>;
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 &lt;&gt; *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 &gt; *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

CHKIFS_CP

1
2
3
4
* CHKOIFS_CP - run a command from RPG program
d DoesThisTableExist...
d pr n
d Infullpath 1000a varying

CHKIFS_TST

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
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;
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:

Leave a Reply

Your email address will not be published. Required fields are marked *