This procedure searches the IFS tree structure (including sub-directories) for files and directories having a name that matches the mask 🙂
When a matching file or directory is found, a ‘File Found’ procedure is called. The ‘File Found’ procedure is one that you supply to process the found file/directory. An example of a ‘File Found’ procedure is supplied.
Compared to the original FindFiles() procedure, that I published back in August 2016 (can be found here), a minor bug have been fixed and a new option to have directory names matched against the filename mask has been added. Last, but not least, the procedure has been converted to Totally Free RPG.
The source members, coded in Totally Free RPG, are available as PC text file source members in a zip file.
Download:
- Source members as text files: FindFilSourcesV2
The zip file contains the source members. Extract the source files and transfer them to your IBM i.
To use and compile this module, you will need two of my other routines:
- Convert to Upper and Lower case
You can download that here. - Split Filename
You can download that here.
As the APIs that FindFiles() calls returns file/object time and date in Unix format, I have included a function to convert from the Unix format to a TimeStamp. The function is called CnvUTimeToTS() and is listed in the example program.
To start a search for files/objects, you must call the FindFiles() procedure with the parameters:
FindFiles(starting_path: mask: mask_subdirs: search_subdirs: files_found_procedure_pointer)
Where the parameters are:
-
-
- starting_path
The path to start the search. This can be a IFS or QSYS path. FindFiles() works on both. - mask
The mask which found files must match. You can pass these values to return all files/objects:
‘*.*’
‘*’
‘ ‘
You can enter the mask in upper or lower case. FindFiles() is case insensitive. If you enter ‘*abc*.*’ the files ‘ABC.TXT’, ‘ABCDEFG.TXT’, ‘AbCdEfG.tXt’, ‘XYZABC.TXT’, ‘DEFAbcGHI.CSV’ are found. - mask_subdirs
Indicator for comparing found directories against ‘mask’.
If set to *On, directories found will have their names compared to the mask. If there is a match, the FileFound() callback procedure will be called.
If set to *Off, directories will not be compared against the ‘mask’. The FileFound() callback will be called for the directory regardless of match in name or not. - search_subdirs
Indicator for search of sub-directories:
*On – Sub-directories will be searched too.
*Off – Only the directory in starting_path will be searched. - pointer
This must be a procedure pointer to a File Found procedure you write. It will be called for each file/directory found.
- starting_path
-
FindFiles() returns an indicator:
- *On
The search was terminated as the return value of the user supplied FileFound() function was set to *On. - *Off
The search terminated successful. Well, maybe there was reported errors to FileFound() but the function returned *Off.
Have fun 🙂
Listing 1, member FINDFIL_PR, type RPGLE:
**Free
//
// FindFil_Pr
// ----------
// Prototypes for FindFiles() function.
//
// Jesper Wachs, Version 2, August 2018:
// Added parameter for indicating if folder names should be matched
// against file specs as well.
// Converted to Totally Free RPG.
//
// Jesper Wachs, Version 1, August 2016.
//
// The source member are delivered 'as is'.
//
// Neither Jesper Wachs nor anyone else who has been involved in
// the creation, production or delivery of this source code shall be
// liable for any direct, indirect, consequential or incidental
// damages (including damages for loss of business profits,
// business interruption, loss of business information, and the
// like) arising out of the use or inability to use such product
// even if Jesper Wachs has been advised of the possibility of
// such damages.
//
Dcl-PR FindFiles Ind;
iStartPath Char(250) Value;
iFileMask Char(25) Value;
iMaskDir Ind Value;
iDoSubDirs Ind Value;
iFoundProc Pointer(*Proc) Value;
End-PR;
//
// The function FindFiles must be called with these parameters:
//
// FindFiles(
// starting_path: The path to start the search. This can
// be a IFS or QSYS path. FindFiles() work
// on both.
// file_mask: The mask which found files must match.
// You can pass these values to return all
// files/objects:
// '*.*'
// '*'
// ' '
// You can enter the mask in upper or
// lower case. FindFiles() is case
// insensitive. If you enter '*abc*.*'
// The files 'ABC.TXT', 'ABCDEFG.TXT',
// 'AbCdEfG.tXt' are found.
// mask_dir: Indicator for comparing found
// directories against 'file_mask'.
// If set to *On, directories found will
// have their names compared to the file
// mask. If there is a match, the
// FileFound() callback procedure will be
// called.
// If set to *Off, directories will not be
// compared against the 'file_mask'. The
// FileFound() callback will be called for
// the directory.
// search_subdirs: Indicator for search of subfolders:
// *On - Subfolders will be searched too.
// *Off - Only the folder in
// starting_path will be searched.
// pointer This must be a procedure pointer to
// a procedure you write that will be
// called for each file/directory found.
// )
//
// If FindFiles() returns *On, it means that the user supplied
// FileFound() function returned *On to terminate the search.
// Otherwise, FindFiles() returns *Off.
//
// Examples:
// To find all files with extension txt i /home and subdirs:
// FindFiles('/home': '*.txt': *On: *On: %PAddr('MYFILEFOUND'))
//
// To find all objects of type *PGM in JWTOOLS:
// FindFiles('/qsys.lib/jwtools.lib': '*.pgm': *Off: *Off:
// %PAddr('MYFILEFOUND'))
// Please note, that when searching a library other that QSYS it is
// a waiste of CPU time to specify *On for subfolders.
//
// To find all *DTAARA in the QSYS file system:
// FindFiles('/qsys.lib': '*.dtaara': *On: *Off:
// %PAddr('MYFILEFOUND'))
// Here the subdir option is set to *ON because all libraries reside
// in QSYS.
Listing 2, member FINDFIL, type RPGLE:
**Free
Ctl-Opt NoMain BndDir('QC2LE');
//
// FindFil
// -------
// Function to search for files in a path with a filename mask.
//
// Jesper Wachs, Version 2, August 2018.
// Corrected bug that found dirs was always matched against
// file specifications. Now, it is an option. iMaskDir if set
// *On, the File Found Callback routine will be called only
// if the found directory matches the file name
// specifications.
// Converted to Totally Free RPG.
//
// Jesper Wachs, Version 1, August 2016.
//
// The source member are delivered 'as is'.
//
// Neither Jesper Wachs nor anyone else who has been involved in
// the creation, production or delivery of this source code shall be
// liable for any direct, indirect, consequential or incidental
// damages (including damages for loss of business profits,
// business interruption, loss of business information, and the
// like) arising out of the use or inability to use such product
// even if Jesper Wachs has been advised of the possibility of
// such damages.
//
// Copymember for exported functions.
// ----------------------------------
/copy qrpglesrc,findfil_pr
//
// Copymember(s) for imported functions.
// -------------------------------------
/copy qrpglesrc,splitfn_pr
/copy qrpglesrc,lucase_pr
//
// Prototypes for local functions.
// -------------------------------
Dcl-PR FileNameMatch Ind;
iEntryName Char(100) Value;
iFindFNPart Char(50) Value;
iFindFNLen Packed(3:0) Value;
iFindFNType Packed(1:0) Value;
iFindEXPart Char(50) Value;
iFindEXLen Packed(3:0) Value;
iFindEXType Packed(1:0) Value;
End-PR;
Dcl-PR FindFilesWork Ind;
iStartPath Char(250) Value;
iFileMask Char(25) Value;
iMaskDir Ind Value;
iDoSubDirs Ind Value;
iFoundProc Pointer(*Proc) Value;
iFindFNPart Char(50) Value;
iFindFNLen Packed(3:0) Value;
iFindFNType Packed(1:0) Value;
iFindEXPart Char(50) Value;
iFindEXLen Packed(3:0) Value;
iFindEXType Packed(1:0) Value;
End-PR;
Dcl-PR FindFilesType Char(25);
iNamePart Char(25) Value;
oFindType Packed(1:0);
End-PR;
Dcl-PR IsDir Ind;
Mode Uns(10) Value;
End-PR;
Dcl-PR ErrNo Int(10:0);
End-PR;
//
// Constants
// ---------
Dcl-C FTALL Const(1);
Dcl-C FTIN Const(2);
Dcl-C FTEQ Const(3);
Dcl-C FTLEFT Const(4);
Dcl-C FTRIGHT Const(5);
//
// Exported funtions.
// ------------------
//
// FindFiles
// ---------
// Searches a path for files containing a file mask.
// For each file found that matches, the 'found' function is called
// for the processing of the file found.
//
// FindFiles is the top level function of a number of functions used.
// It takes care of figuring out what kind of file mask to look for
// and sets up a number of work fields that are passed to the actual
// search routine. This gives the best performance as this work is
// only done once.
//
Dcl-Proc FindFiles Export;
Dcl-PI FindFiles Ind;
iStartPath Char(250) Value;
iFileMask Char(25) Value;
iMaskDir Ind Value;
iDoSubDirs Ind Value;
iFoundProc Pointer(*Proc) Value;
End-PI;
Dcl-S FindFNPart Char(50);
Dcl-S FindEXPart Char(50);
Dcl-S FindFNType Packed(1:0);
Dcl-S FindEXType Packed(1:0);
Dcl-S FindFNLen Packed(3:0);
Dcl-S FindEXLen Packed(3:0);
//
// Three file masks that means we must look for all files.
//
If iFileMask = '*' or
iFileMask = '*.*' or
iFileMask = ' ';
FindFNType = ftAll;
FindEXType = ftAll;
Else;
// We must compare the found files to the file mask. We call
// SplitFN to split the name and extension part of the file
// mask.
CallP SplitFN(iFileMask:
FindFNPart:
FindEXPart);
// Set values for match on name part of filename.
FindFNPart = UCase(
FindFilesType(FindFNPart:
FindFNType));
FindFNLen = %Len(%TrimR(FindFNPart));
// Set values for match on extension part of filename.
FindEXPart = UCase(
FindFilesType(FindEXPart:
FindEXType));
FindEXLen = %Len(%TrimR(FindEXPart));
EndIf;
// Call the actual search routine with all the search parameters.
Return FindFilesWork(iStartPath:
iFileMask:
iMaskDir:
iDoSubDirs:
iFoundProc:
FindFNPart:
FindFNLen:
FindFNType:
FindEXPart:
FindEXLen:
FindEXType);
End-Proc FindFiles;
//
// Internal functions.
// -------------------
//
// FindFilesWork
// -------------
// This function does all the actual search work.
//
Dcl-Proc FindFilesWork;
Dcl-PI FindFilesWork Ind;
iStartPath Char(250) Value;
iFileMask Char(25) Value;
iMaskDir Ind Value;
iDoSubDirs Ind Value;
iFoundProc Pointer(*Proc) Value;
iFindFNPart Char(50) Value;
iFindFNLen Packed(3:0) Value;
iFindFNType Packed(1:0) Value;
iFindEXPart Char(50) Value;
iFindEXLen Packed(3:0) Value;
iFindEXType Packed(1:0) Value;
End-PI;
// Prototype for the dynamic function that will be called for each
// entry found matching the file mask.
Dcl-PR VirtFileFound Ind ExtProc(VirtProcPtr);
iPath Char(250) Value;
iFileName Char(100) Value;
iIsDir Ind Value;
iStatDS Value Like(StatDS);
iErrNo Int(10:0) Value;
End-PR;
Dcl-S VirtProcPtr Pointer(*Proc);
//
// Prototypes for API procedures
//
Dcl-PR LStat Int(10:0) ExtProc('lstat');
*N Pointer Value Options(*String);
*N Pointer Value;
End-PR;
Dcl-PR OpenDir Pointer ExtProc('opendir');
*N Pointer Value Options(*String);
End-PR;
Dcl-PR ReadDir Pointer ExtProc('readdir');
*N Pointer Value;
End-PR;
Dcl-PR CloseDir Int(10:0) ExtProc('closedir');
*N Pointer Value;
End-PR;
// Local work fields.
// Stat data structure returned by procedure lstat()
Dcl-DS StatDS Len(128);
st_mode Uns(10);
st_ino Uns(10);
st_nlink Uns(5);
reserved1 Char(2);
st_uid Uns(10);
st_gid Uns(10);
st_size Uns(10);
st_atime Uns(10);
st_mtime Uns(10);
st_ctime Uns(10);
st_dev Uns(10);
st_blksize Int(10:0);
st_allocsize Int(10:0);
st_objtype Char(10);
reserved2 Char(2);
st_codepage Uns(5);
st_reserved1 Char(62);
st_ino_genid Uns(10);
End-DS;
// DirEntry data structure returned by procedure readdir()
Dcl-DS DirEntry Based(PtrToEntry);
d_reserved1 Char(16);
d_filengenid Uns(10);
d_fileno Uns(10);
d_reclen Uns(10);
d_reserved3 Int(10:0);
d_reserved_4 Char(6);
d_reserved5 Char(2);
d_ccsid Int(10:0);
d_country_id Char(2);
d_languageid Char(3);
d_nls_reserv Char(3);
d_namelen Uns(10);
d_name Char(640);
End-DS;
Dcl-DS APIErr;
ErrSiz BinDec(8:0) Pos(1) Inz(256);
ErrLen BinDec(8:0) Pos(5) Inz(0);
ErrMic Char(7) Pos(9);
ErrNbr Char(1) Pos(16);
ErrDta Char(256) Pos(17);
End-DS;
Dcl-S ReturnDir Pointer;
Dcl-S PtrToEntry Pointer;
Dcl-S EntryIsDir Ind;
Dcl-S EntryName Char(100);
Dcl-S EntryPath Char(250);
Dcl-S NewStartPath Char(250);
Dcl-S Res Int(10:0);
Dcl-S ReturnInt Int(10:0);
Dcl-S ReturnCode Ind Inz(*Off);
// Setup how to call when a file is found.
VirtProcPtr = iFoundProc;
// Make sure that iStartPath ends with a '/'.
If %SubSt(iStartPath: %Len(%TrimR(
iStartPath)): 1) <> '/';
iStartPath = %TrimR(iStartPath) + '/';
EndIf;
// Open directory
ReturnDir = OpenDir(%TrimR(iStartPath));
// If error occurred when opening directory tell it to FilesFind.
If ReturnDir = *Null;
// Get the error code for what went wrong.
Return VirtFileFound(iStartPath:
'.':
*Off:
*Allx'00':
ErrNo);
EndIf;
// Read first entry and then enter loop to process each entry in
// the directory.
PtrToEntry = readdir(ReturnDir);
// Loop though all directory entries.
DoW PtrToEntry <> *Null;
EntryName = %Str(%Addr(d_name));
// We skip the processing of the current directory.
If EntryName <> '.';
// We will tell FindFiles that we have found the indicator for
// parent directory. It is up to FindFiles to use it or bypass it.
If EntryName = '..';
If VirtFileFound(iStartPath:
EntryName:
*On:
StatDS:
*Zeros) = *On;
ReturnCode = *On;
Leave;
EndIf;
Else;
// Get information about the entry.
EntryPath = %TrimR(iStartPath) +
EntryName;
ReturnInt = LStat(%TrimR(EntryPath):
%Addr(StatDS));
// Is entry a directory?
EntryIsDir = IsDir(st_mode);
// Does the entry name match the file mask?
If iMaskDir = *Off and EntryIsDir = *On or
FileNameMatch(EntryName:
iFindFNPart:
iFindFNLen:
iFindFNType:
iFindEXPart:
iFindEXLen:
iFindEXType) = *On;
// Call the supplied FileFound() function.
If VirtFileFound(iStartPath:
EntryName:
EntryIsDir:
StatDS:
ReturnInt) = *On;
ReturnCode = *On;
Leave;
EndIf;
EndIf;
EndIf;
EndIf;
// Read the next entry from the directory.
PtrToEntry = ReadDir(ReturnDir);
EndDo;
// Close directory.
CallP CloseDir(ReturnDir);
// Have we been asked to terminate?
If ReturnCode = *On;
Return *On;
EndIf;
// Look for sub dirs?
If iDoSubDirs = *On;
ReturnDir = OpenDir(%TrimR(iStartPath));
// No reason the check the pointer, as we just did above.
PtrToEntry = ReadDir(ReturnDir);
// Loop though all directory entries.
DoW PtrToEntry <> *Null;
EntryName = %Str(%Addr(d_name));
If EntryName <> '.' and EntryName <> '..';
EntryPath = %TrimR(iStartPath) +
%TrimR(EntryName);
ReturnInt = LStat(%Addr(EntryPath):
%Addr(StatDS));
If ReturnInt = *Zeros and
IsDir(st_mode) = *On;
NewStartPath = %TrimR(iStartPath) +
EntryName;
// FindFilesWork, the function we are in right now, is called
// recursively.
If FindFilesWork(NewStartPath:
iFileMask:
iMaskDir:
iDoSubDirs:
iFoundProc:
iFindFNPart:
iFindFNLen:
iFindFNType:
iFindEXPart:
iFindEXLen:
iFindEXType) = *On;
ReturnCode = *On;
Leave;
EndIf;
EndIf;
EndIf;
PtrToEntry = ReadDir(ReturnDir);
EndDo;
// Close directory.
CallP CloseDir(ReturnDir);
EndIf;
Return ReturnCode;
End-Proc FindFilesWork;
// FindFilesType
// -------------
// This function figures out how the file mask is to be compared to
// the files found. It sets up a number of work fields once in order
// for processing the files as fast as possible.
Dcl-Proc FindFilesType;
Dcl-PI FindFilesType Char(25);
iNamePart Char(25) Value;
oFindType Packed(1:0);
End-PI;
Dcl-S OutPart Char(25);
// Find out where the asterix are located.
// FileName.
If iNamePart = '*';
oFindType = ftAll;
Else;
If %SubSt(iNamePart: 1: 1) = '*';
If %SubSt(iNamePart: %Len(%TrimR(
iNamePart)): 1) = '*';
oFindType = ftIn;
Else;
oFindType = ftRight;
EndIf;
Else;
// The mask might be blank!
If %TrimR(iNamePart) = '';
oFindType = ftEq;
Else;
If %SubSt(iNamePart: %Len(%TrimR(
iNamePart)): 1) = '*';
oFindType = ftLeft;
Else;
oFindType = ftEq;
EndIf;
EndIf;
EndIf;
// Remove asterix from the Filename field.
OutPart = iNamePart;
If %SubSt(OutPart: 1: 1) = '*';
OutPart = %SubSt(OutPart: 2:
%Len(OutPart) - 1);
EndIf;
If %TrimR(OutPart) = '';
// Do nothing
Else;
If %SubSt(OutPart: %Len(
%TrimR(OutPart)): 1) = '*';
%SubSt(OutPart: %Len(%TrimR(
OutPart)): 1) = ' ';
EndIf;
EndIf;
EndIf;
Return OutPart;
End-Proc FindFilesType;
// FileNameMatch
// -------------
// The functions compares a filename/directory entry to the file mask.
Dcl-Proc FileNameMatch;
Dcl-PI FileNameMatch Ind;
iEntryName Char(100) Value;
iFindFNPart Char(50) Value;
iFindFNLen Packed(3:0) Value;
iFindFNType Packed(1:0) Value;
iFindEXPart Char(50) Value;
iFindEXLen Packed(3:0) Value;
iFindEXType Packed(1:0) Value;
End-PI;
Dcl-S wName Char(50);
Dcl-S wExt Char(50);
Dcl-S sName Char(50);
Dcl-S sMask Char(50);
Dcl-S sMaskLen Packed(3:0);
Dcl-S sType Packed(1:0);
Dcl-S sMatch Ind;
Dcl-S sTemp Packed(3:0);
Dcl-S FNMatch Ind;
Dcl-S EXMatch Ind;
// If file mask is set to include all, then return with value that
// indicates a match.
If iFindFNType = ftAll and
iFindEXType = ftAll;
Return *On;
Else;
CallP SplitFN(iEntryName: wName: wExt);
// Does the Name part of the filename match?
sName = UCase(wName);
sMask = iFindFNPart;
sMaskLen = iFindFNLen;
sType = iFindFNType;
Exsr Compare;
FNMatch = sMatch;
// Does the Extension part of the filename match?
sName = UCase(wExt);
sMask = iFindEXPart;
sMaskLen = iFindEXLen;
sType = iFindEXType;
Exsr Compare;
EXMatch = sMatch;
// Set the return value if the name and extension matches the file
// mask.
If FNMatch = *On and EXMatch = *On;
Return *On;
Else;
Return *Off;
EndIf;
EndIf;
// Do the comparison.
BegSr Compare;
// -------------------
// No reason to waste time if the mask is All.
If sType = ftAll;
sMatch = *On;
Else;
sMatch = *Off;
Select;
// Mask is '*abc*'.
When sType = ftIn;
If %Scan(%Trim(sMask): sName) > 0;
sMatch = *On;
EndIf;
// Mask is 'abc'.
When sType = ftEq;
If sMask = sName;
sMatch = *On;
EndIf;
// Mask is 'abc*'.
When sType = ftLeft;
If %SubSt(sName: 1: sMaskLen) =
sMask;
sMatch = *On;
EndIf;
// Mask is '*abc'.
When sType = ftRight;
sTemp = %Len(%TrimR(sName));
If sTemp >= sMaskLen;
sTemp = sTemp - sMaskLen + 1;
If %SubSt(sName: sTemp: sMaskLen) =
sMask;
sMatch = *On;
EndIf;
EndIf;
EndSl;
EndIf;
EndSr;
End-Proc FileNameMatch;
// IsDir
// -----
// This function tests file mode to see if a file is a directory.
Dcl-Proc IsDir;
Dcl-PI IsDir Ind;
St_Mode Uns(10) Value;
End-PI;
If %BitAnd(St_Mode :x'01f000') = 16384;
Return *On;
Else;
Return *Off;
EndIf;
End-Proc IsDir;
// Get Error Number
// ----------------
// The fuction gets the API errorcode and return it in a nice manner.
Dcl-Proc ErrNo;
Dcl-PI ErrNo Int(10:0);
End-PI;
Dcl-PR cErrNo Pointer ExtProc('__errno');
End-PR;
Dcl-S p_errno Pointer;
Dcl-S RetVal Int(10:0) Based(p_errno);
p_errno = cErrNo;
Return RetVal;
End-Proc;
Listing 3, member FINDFIL_EX, type RPGLE:
**Free
//
// FindFil_Ex
// ----------
// Example program for the FindFiles() function.
//
// Jesper Wachs, Version 2, August 2018.
// Added parameter for indicating if folder names should be matched
// against file specs as well.
// Converted to Totally Free RPG.
//
// Jesper Wachs, Version 1, August 2016.
//
// To successful compile this program, you must have downloaded and
// compiled these two functions from my website:
// - LUCase
// - SplitFN
//
// You will find then in the 'ILE RPG Stuff' section.
//
// The source member are delivered 'as is'.
//
// Neither Jesper Wachs nor anyone else who has been involved in
// the creation, production or delivery of this source code shall be
// liable for any direct, indirect, consequential or incidental
// damages (including damages for loss of business profits,
// business interruption, loss of business information, and the
// like) arising out of the use or inability to use such product
// even if Jesper Wachs has been advised of the possibility of
// such damages.
//
// Copymember for imported functions.
// ----------------------------------
/copy qrpglesrc,findfil_pr
// Prototypes for local functions.
// -------------------------------
Dcl-PR FileFound Ind;
iPath Char(250) Value;
iFileName Char(100) Value;
iIsDir Ind Value;
iStatDS Value Like(StatDS);
iErrNo Int(10:0) Value;
End-PR;
Dcl-PR CnvUTimeToTS TimeStamp;
sTime Uns(10:0) Const;
End-PR;
// Work fields.
// ------------
Dcl-DS StatDS Len(128);
st_mode Uns(10);
st_ino Uns(10);
st_nlink Uns(5);
reserved1 Char(2);
st_uid Uns(10);
st_gid Uns(10);
st_size Uns(10);
st_atime Uns(10);
st_mtime Uns(10);
st_ctime Uns(10);
st_dev Uns(10);
st_blksize Int(10:0);
st_allocsize Int(10:0);
st_objtype Char(10);
reserved2 Char(2);
st_codepage Uns(5);
st_reserved1 Char(62);
st_ino_genid Uns(10);
End-DS;
Dcl-S Msg Char(50);
// Main line of program.
// ---------------------
// This is the call to the actual file search function.
If FindFiles('/qsys.lib/jwtools.lib':
'*.pgm': *On:
*Off:
%PAddr(FileFound)) = *On;
Msg = 'Search was terminated';
Else;
Msg = 'Search was successful';
EndIf;
Dsply Msg;
*InLR = *On;
Return;
//
// FileFound
// ---------
// This function is a 'callback' function. It is called every time
// a file is found that matches the search mask.
//
Dcl-Proc FileFound;
Dcl-PI FileFound Ind;
iPath Char(250) Value;
iFileName Char(100) Value;
iIsDir Ind Value;
iStatDS Value Like(StatDS);
iErrNo Int(10:0) Value;
End-PI;
// Prototype for API that returns the text for an error number.
Dcl-PR StrError Pointer ExtProc('strerror');
ErrNum Int(10:0) Value;
End-PR;
// Stat data structure parsed on the call. For the meaning of each
// field, search the net :-)
Dcl-DS StatDS Len(128);
st_mode Uns(10);
st_ino Uns(10);
st_nlink Uns(5);
reserved1 Char(2);
st_uid Uns(10);
st_gid Uns(10);
st_size Uns(10);
st_atime Uns(10);
st_mtime Uns(10);
st_ctime Uns(10);
st_dev Uns(10);
st_blksize Int(10:0);
st_allocsize Int(10:0);
st_objtype Char(10);
reserved2 Char(2);
st_codepage Uns(5);
st_reserved1 Char(62);
st_ino_genid Uns(10);
End-DS;
// Work fields
Dcl-S p_errmsg Pointer;
Dcl-S Msg Char(50);
Dcl-S Stamp TimeStamp;
Dcl-S ReturnCode Ind Inz(*Off);
// If an error occurred, then display that error.
If iErrNo <> *Zeros;
p_errmsg = StrError(iErrNo);
Msg = 'Error reading ' +%TrimR(iPath) +
': ' + %Str(p_errmsg);
Dsply Msg;
Else;
// In this example, we ignore the parent dir.
If iFileName <> '..';
If iIsDir = *On;
Msg = 'Dir.:';
Else;
Msg = 'File:';
EndIf;
Msg = %TrimR(Msg) + ' '+ %TrimR(iPath) +
%TrimR(iFileName);
Dsply Msg;
// As iStatDS is merly a string field, we must convert to StatDS
// structure to get each field.
StatDS = iStatDS;
// Call convert routine to get a 'good old timestamp' of when the
// file was last modified.
Stamp = CnvUTimeToTS(st_mtime);
Msg = 'Last modified: ' + %Char(Stamp);
Dsply Msg;
EndIf;
EndIf;
Return ReturnCode;
End-Proc FileFound;
// CnvUTimeToTS
// ------------
// Convert Unix time field into TimeStamp field taking into account
// the local time zone.
Dcl-Proc CnvUTimeToTS;
Dcl-PI CnvUTimeToTS TimeStamp;
iTime Uns(10:0) Const;
End-PI;
Dcl-PR LocalTime Pointer ExtProc('localtime');
TimeVal Pointer Value;
End-PR;
Dcl-DS tm Based(tmP);
tm_sec Int(10:0);
tm_min Int(10:0);
tm_hour Int(10:0);
tm_mday Int(10:0);
tm_mon Int(10:0);
tm_year Int(10:0);
tm_wday Int(10:0);
tm_yday Int(10:0);
tm_isdst Int(10:0);
End-DS;
Dcl-S tmP Pointer;
Dcl-S wTime Uns(10:0);
Dcl-S nStamp Zoned(20:0);
Dcl-S oStamp TimeStamp Inz(z'0001-01-01-01.01.01.000000');
wTime = iTime;
tmP = LocalTime(%Addr(wTime));
If tmP <> *Null;
nStamp = tm_year + 1900;
nStamp = nStamp * 100;
nStamp = nStamp + tm_mon + 1;
nStamp = nStamp * 100;
nStamp = nStamp + tm_mday;
nStamp = nStamp * 100;
nStamp = nStamp + tm_hour;
nStamp = nStamp * 100;
nStamp = nStamp + tm_min;
nStamp = nStamp * 100;
nStamp = nStamp + tm_sec;
nStamp = nStamp * 1000000;
oStamp = %TimeStamp(nStamp: *ISO);
EndIf;
Return oStamp;
End-Proc CnvUTimeToTS;
If you have installed Jesper’s ToolBox for IBM i you can use the Make member in Listing 4 to compile the module and the example program.
Listing 4, member FINDFIL_MK, type TXT:
; ; FindFil_Mk ; ---------- ; MAKE member for FindFiles() module and example program. ; ; Jesper Wachs, August 2016. ; ; ; Variables defined once and used though out make member. ; v &lib jwtools v &srclib jwtools v &debug *source ; ; Check and possibly build FindFil module. ; v &mod findfil o &srclib &mod *module u &srclib qrpglesrc *file &mod ci dltmod &srclib/&mod c crtrpgmod &srclib/&mod srcfile(&srclib/qrpglesrc) dbgview(&debug) ; ; Check and possibly build FindFil_Ex module. ; v &mod findfil_ex o &srclib &mod *module u &srclib qrpglesrc *file &mod ci dltmod &srclib/&mod c crtrpgmod &srclib/&mod srcfile(&srclib/qrpglesrc) dbgview(&debug) ; ; Build main program. ; v &pgm findfil_ex o &lib &pgm *pgm u &srclib findfil_ex *module u &srclib findfil *module u &srclib splitfn *module u &srclib lucase *module ci DltPgm &lib/&pgm c CrtPgm &lib/&pgm module(&srclib/&pgm &srclib/findfil + &srclib/splitfn &srclib/lucase)