An updated version of these procedures can be found here.
This function searches the IFS for files and directories having a name that matches the mask 🙂
When a matching file is found, a ‘File Found’ function/procedure is called. The ‘File Found’ function/procedure is one that you supply. An example is supplied.
The four source members are available in an installation package you can download here. You will get a zip file containing a executable JAR file (requires Java V1.8 or newer). Unzip the JAR file and run it. You will be presented for a series of screen that will install the four members to the file QRPGLESRC in library JWTOOLS. If the library and/or source file does not exist, they will created.
To use and compile this module, you will need two of my other routines:
- Convert to Upper and Lower case
You can download that from this page. - Split Filename
You can download that here.
Have fun 🙂
Listing 1, member FINDFIL_PR, type RPGLE:
* * FindFil_Pr * ---------- * Prototypes for FindFiles() function. * d FindFiles Pr 1n d iStartPath 250a Value d iFileMask 25a Value d iDoSubDirs 1n Value d iFoundProc * ProcPtr Value * * 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. * 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. * 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: %PAddr('MYFILEFOUND')) * * To find all objects of type *PGM in JWTOOLS: * FindFiles('/qsys.lib/jwtools.lib': '*.pgm': *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: %PAddr('MYFILEFOUND')) * Here the subdir option is set to *ON because all libraries reside * in QSYS. *
Listing 2, member FINDFIL, type RPGLE:
h NoMain BndDir('QC2LE') * * FindFil * ------- * Function to search for files in a path with a filename mask. * * Jesper Wachs, August 2016. * * Copymember for exported functions. * ---------------------------------- d/copy qrpglesrc,findfil_pr * * Copymember(s) for imported functions. * ------------------------------------- d/copy qrpglesrc,splitfn_pr d/copy qrpglesrc,lucase_pr * * Prototypes for local functions. * ------------------------------- * d FileNameMatch Pr 1n d iEntryName 100a Value d iFindFNPart 50a Value d iFindFNLen 3p 0 Value d iFindFNType 1p 0 Value d iFindEXPart 50a Value d iFindEXLen 3p 0 Value d iFindEXType 1p 0 Value * d FindFilesWork Pr 1n d iStartPath 250a Value d iFileMask 25a Value d iDoSubDirs 1n Value d iFoundProc * ProcPtr Value d iFindFNPart 50a Value d iFindFNLen 3p 0 Value d iFindFNType 1p 0 Value d iFindEXPart 50a Value d iFindEXLen 3p 0 Value d iFindEXType 1p 0 Value * d FindFilesType Pr 25a d iNamePart 25a Value d oFindType 1p 0 * d IsDir Pr 1n d Mode 10u 0 Value * d ErrNo Pr 10i 0 * * Constants * --------- d ftAll c Const(1) d ftIn c Const(2) d ftEq c Const(3) d ftLeft c Const(4) d ftRight c 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. * P FindFiles B Export d FindFiles Pi 1n d iStartPath 250a Value d iFileMask 25a Value d iDoSubDirs 1n Value d iFoundProc * ProcPtr Value * d FindFNPart s 50a d FindEXPart s 50a d FindFNType s 1p 0 d FindEXType s 1p 0 d FindFNLen s 3p 0 d FindEXLen s 3p 0 * * Three file masks that means we must look for all files. * c c If iFileMask = '*' or c iFileMask = '*.*' or c iFileMask = ' ' c EVal FindFNType = ftAll c EVal FindEXType = ftAll c 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. * c CallP SplitFN(iFileMask: c FindFNPart: c FindEXPart) * * Set values for match on name part of filename. * c EVal FindFNPart = UCase( c FindFilesType(FindFNPart: c FindFNType)) c EVal FindFNLen = %Len(%TrimR(FindFNPart)) * * Set values for match on extension part of filename. * c EVal FindEXPart = UCase( c FindFilesType(FindEXPart: c FindEXType)) c EVal FindEXLen = %Len(%TrimR(FindEXPart)) * c EndIf * * Call the actual search routine with all the search parameters. * c Return FindFilesWork(iStartPath: c iFileMask: c iDoSubDirs: c iFoundProc: c FindFNPart: c FindFNLen: c FindFNType: c FindEXPart: c FindEXLen: c FindEXType) * P FindFiles E * * Internal functions. * ------------------- * * FindFilesWork * ------------- * This function does all the actual search work. * P FindFilesWork B d FindFilesWork Pi 1n d iStartPath 250a Value d iFileMask 25a Value d iDoSubDirs 1n Value d iFoundProc * ProcPtr Value d iFindFNPart 50a Value d iFindFNLen 3p 0 Value d iFindFNType 1p 0 Value d iFindEXPart 50a Value d iFindEXLen 3p 0 Value d iFindEXType 1p 0 Value * * Prototype for the dynamic function that will be called for each * file found matching the file mask. * d VirtFileFound Pr 1n ExtProc(VirtProcPtr) d iPath 250a Value d iFileName 100a Value d iIsDir 1n Value d iStatDS Value Like(StatDS) d iErrNo 10i 0 Value * d VirtProcPtr s * ProcPtr * * Prototype for API procedures * d LStat Pr 10i 0 ExtProc('lstat') d * Value d * Value * d OpenDir Pr * ExtProc('opendir') d * Value Options(*String) * d ReadDir Pr * ExtProc('readdir') d * Value * d CloseDir Pr 10i 0 ExtProc('closedir') d * Value * * Local work fields. * * Stat data structure returned by procedure lstat() * d StatDS Ds 128 d st_mode 10U 0 d st_ino 10U 0 d st_nlink 5U 0 d reserved1 2A d st_uid 10U 0 d st_gid 10U 0 d st_size 10U 0 d st_atime 10U 0 d st_mtime 10U 0 d st_ctime 10U 0 d st_dev 10U 0 d st_blksize 10I 0 d st_allocsize 10I 0 d st_objtype 10A d reserved2 2A d st_codepage 5U 0 d st_reserved1 62A d st_ino_genid 10U 0 * * DirEntry data structure returned by procedure readdir() * d DirEntry Ds d d_reserved1 16A d d_filengenid 10U 0 d d_fileno 10U 0 d d_reclen 10U 0 d d_reserved3 10I 0 d d_reserved_4 6A d d_reserved5 2A d d_ccsid 10I 0 d d_country_id 2A d d_languageid 3A d d_nls_reserv 3A d d_namelen 10U 0 d d_name 640A * d APIErr Ds d ErrSiz 1 4b 0 Inz(256) d ErrLen 5 8b 0 Inz(0) d ErrMic 9 15 d ErrNbr 16 16 d ErrDta 17 272 * d ReturnDir s * d PtrToEntry s * d RtnEntry s Based(PtrToEntry) Like(DirEntry) d EntryName s 100a d EntryPath s 250a d NewStartPath s 250a d Res s 10i 0 d ReturnInt s 10i 0 d ReturnCode s 1n Inz(*Off) * d Null s 1A Inz(X'00') * * Setup how to call when a file is found. * c EVal VirtProcPtr = iFoundProc * * Open directory * c EVal ReturnDir = OpenDir(%TrimR(iStartPath)) * * If error occurred when opening directory tell it to FilesFind. * c If ReturnDir = *Null * * Get the error code for what went wrong. * c Return VirtFileFound(iStartPath: c '.': c IsDir(st_mode): c *Allx'00': c ErrNo) c Endif * * Read first entry and then enter loop to process each entry in * the directory. * C EVal PtrToEntry = readdir(ReturnDir) * * Loop though all directory entries. * C DoW PtrToEntry <> *Null * C Eval DirEntry = RtnEntry C Eval EntryName = %Str(%Addr(d_name)) * * We skip the processing of the current directory. * c 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. * c If EntryName = '..' c If VirtFileFound(iStartPath: c EntryName: c *On: c StatDS: c *Zeros) = *On c EVal ReturnCode = *On c Leave c EndIf c Else * * Does the entry name match the file mask? * c If FileNameMatch(EntryName: c iFindFNPart: c iFindFNLen: c iFindFNType: c iFindEXPart: c iFindEXLen: c iFindEXType) = *On C Eval EntryPath = %TrimR(iStartPath) + '/' + C %TrimR(EntryName) + Null * * Get information about the entry. * C Eval ReturnInt = LStat(%Addr(EntryPath): C %Addr(StatDS)) * * Call the supplied FileFound() function. * c If VirtFileFound(iStartPath: c EntryName: c IsDir(st_mode): c StatDS: c ReturnInt) = *On c EVal ReturnCode = *On c Leave c EndIf * c EndIf c EndIf c EndIf * * Read the next entry from the directory. * c EVal PtrToEntry = ReadDir(ReturnDir) * c Enddo * * Close directory. * c CallP CloseDir(ReturnDir) * * Have we been asked to terminate? * c If ReturnCode = *On c Return *On c EndIf * * Look for sub dirs? * c If iDoSubDirs = *On c EVal ReturnDir = OpenDir(%TrimR(iStartPath)) * * No reason to check the pointer, as we just did above. * c EVal PtrToEntry = ReadDir(ReturnDir) * * Loop though all directory entries. * C DoW PtrToEntry <> *Null * C Eval DirEntry = RtnEntry C Eval EntryName = %Str(%Addr(d_name)) c If EntryName <> '.' and EntryName <> '..' * C Eval EntryPath = %TrimR(iStartPath) + '/' + C %TrimR(EntryName) + Null C Eval ReturnInt = LStat(%Addr(EntryPath): C %Addr(StatDS)) c If ReturnInt = *Zeros and c IsDir(st_mode) = *On c EVal NewStartPath = %TrimR(iStartPath) + '/' + c EntryName * * FindFilesWork, the function we are in right now, is called * recursively. * c If FindFilesWork(NewStartPath: c iFileMask: c iDoSubDirs: c iFoundProc: c iFindFNPart: c iFindFNLen: c iFindFNType: c iFindEXPart: c iFindEXLen: c iFindEXType) = *On c EVal ReturnCode = *On c Leave c EndIf c EndIf c EndIf * C EVal PtrToEntry = ReadDir(ReturnDir) * c EndDo * * Close directory. * c CallP CloseDir(ReturnDir) * c EndIf * c Return ReturnCode * P FindFilesWork E * * 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. * P FindFilesType B d FindFilesType Pi 25a d iNamePart 25a Value d oFindType 1p 0 * d OutPart s 25a * * Find out where the asterix are located. * * FileName. * c If iNamePart = '*' c EVal oFindType = ftAll c Else c If %SubSt(iNamePart: 1: 1) = '*' c If %SubSt(iNamePart: %Len(%TrimR( c iNamePart)): 1) = '*' c EVal oFindType = ftIn c Else c EVal oFindType = ftRight c EndIf c Else c If %SubSt(iNamePart: %Len(%TrimR( c iNamePart)): 1) = '*' c EVal oFindType = ftLeft c Else c EVal oFindType = ftEq c EndIf c EndIf * * Remove asterix from the Filename field. * c EVal OutPart = iNamePart c If %SubSt(OutPart: 1: 1) = '*' c EVal OutPart = %SubSt(OutPart: 2: c %Len(OutPart) - 1) c EndIf c If %SubSt(OutPart: %Len( c %TrimR(OutPart)): 1) = '*' c EVal %SubSt(OutPart: %Len(%TrimR( c OutPart)): 1) = ' ' c EndIf c EndIf * c Return OutPart * P FindFilesType E * * FileNameMatch * ------------- * The functions compares a filename/directory entry to the file mask. * P FileNameMatch B d FileNameMatch Pi 1n d iEntryName 100a Value d iFindFNPart 50a Value d iFindFNLen 3p 0 Value d iFindFNType 1p 0 Value d iFindEXPart 50a Value d iFindEXLen 3p 0 Value d iFindEXType 1p 0 Value * d wName s 50a d wExt s 50a * d sName s 50a d sMask s 50a d sMaskLen s 3p 0 d sType s 1p 0 d sMatch s 1n d sTemp s 3p 0 * d FNMatch s 1n d EXMatch s 1n * d * * If file mask is set to include all, then return with value that * indicates a match. * c If iFindFNType = ftAll and c iFindEXType = ftAll c Return *On c Else * c CallP SplitFN(iEntryName: wName: wExt) * * Does the Name part of the filename match? * c EVal sName = UCase(wName) c EVal sMask = iFindFNPart c EVal sMaskLen = iFindFNLen c EVal sType = iFindFNType c ExSr Compare c EVal FNMatch = sMatch * * Does the Extension part of the filename match? * c EVal sName = UCase(wExt) c EVal sMask = iFindEXPart c EVal sMaskLen = iFindEXLen c EVal sType = iFindEXType c ExSr Compare c EVal EXMatch = sMatch * * Set the return value if the name and extension matches the file * mask. * c If FNMatch = *On and EXMatch = *On c Return *On c Else c Return *Off c EndIf * c EndIf * * Do the comparison. * c Compare BegSr * ------------------- * No reason to waste time if the mask is All. * c If sType = ftAll c EVal sMatch = *On c Else c EVal sMatch = *Off * c Select * * Mask is '*abc*'. * c When sType = ftIn c If %Scan(%Trim(sMask): sName) > 0 c EVal sMatch = *On c EndIf * * Mask is 'abc'. * c When sType = ftEq c If sMask = sName c EVal sMatch = *On c EndIf * * Mask is 'abc*'. * c When sType = ftLeft c If %SubSt(sName: 1: sMaskLen) = c sMask c EVal sMatch = *On c EndIf * * Mask is '*abc'. * c When sType = ftRight c EVal sTemp = %Len(%TrimR(sName)) c If sTemp >= sMaskLen c EVal sTemp = sTemp - sMaskLen + 1 c If %SubSt(sName: sTemp: sMaskLen) = c sMask c EVal sMatch = *On c EndIf c EndIf * c EndSl * c EndIf c EndSr * * P FileNameMatch E * * IsDir * ----- * This function tests file mode to see if a file is a directory. * P IsDir B d IsDir Pi 1n d St_Mode 10u 0 Value * d Ds d DirMode 1 4u 0 d Byte1 1 1a d Byte2 2 2a d Byte3 3 3a d Byte4 4 4a * * Turn off bits. * c EVal DirMode = St_Mode * c BitOff x'FF' Byte1 c BitOff x'FE' Byte2 c BitOff x'0F' Byte3 c BitOff x'FF' Byte4 * * Compare the resutlt to x0040000, and return True or False. * c If DirMode = 16384 c Return *On c Else c Return *Off c EndIf * P IsDir E * * Get Error Number * ---------------- * The fuction gets the API errorcode and return it in a nice manner. * P ErrNo B d ErrNo Pi 10i 0 * d cErrNo Pr * ExtProc('__errno') * d p_errno s * d RetVal s 10i 0 Based(p_errno) * c EVal p_errno = cErrNo c Return RetVal * P E *
Listing 3, member FINDFIL_EX, type RPGLE:
* * FindFil_Ex * ---------- * Example program for the FindFiles() function. * * Jesper Wachs, 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. * * Copymember for imported functions. * ---------------------------------- d/copy qrpglesrc,findfil_pr * * Prototypes for local functions. * ------------------------------- d FileFound Pr 1n d iPath 250a Value d iFileName 100a Value d iIsDir 1n Value d iStatDS Value Like(StatDS) d iErrNo 10i 0 Value * d CnvUTimeToTS Pr z d sTime 10u 0 Const * * Work fields. * ------------ d StatDS Ds 128 d st_mode 10U 0 d st_ino 10U 0 d st_nlink 5U 0 d reserved1 2A d st_uid 10U 0 d st_gid 10U 0 d st_size 10U 0 d st_atime 10U 0 d st_mtime 10U 0 d st_ctime 10U 0 d st_dev 10U 0 d st_blksize 10I 0 d st_allocsize 10I 0 d st_objtype 10A d reserved2 2A d st_codepage 5U 0 d st_reserved1 62A d st_ino_genid 10U 0 * d Msg s 50a * * Main line of program. * --------------------- * This is the call to the actual file search function. Please note * that this call is for V4R5 and earlier: * c If FindFiles('/www': c '*.htm*': c *On: c %PAddr('FILEFOUND')) = *On c EVal Msg = 'Search was terminated' c Else c EVal Msg = 'Search was successful' c EndIf * c Msg Dsply * * This is the call to the actual file search function. Please note * that this call is for V5R1 and later: * c** If FindFiles('/www': c** '*.htm': c** *On: c** %PAddr(FileFound): c** ErrMsg) = *On * c EVal *InLR = *On c Return * * Exported funtions. * ------------------ * * FileFound * --------- * This function is a 'callback' function. It is called every time * a file is found that matches the search mask. * * Please note, that for V4R5 and before, you must declare this * function with keyword Export. This is not needed for V5R1 and * later. * P FileFound B Export d FileFound Pi 1n * * This is the path where the file was found. d iPath 250a Value * * This is the file (or directory) that was found. d iFileName 100a Value * * Directory indicator. If *On it is a directory that is found. * If *Off it is a file that is found. d iIsDir 1n Value * * StatDS structure for the file found. d iStatDS Value Like(StatDS) * * If an error occurred during the read of the directory or the * access to the file, then this is the error number. * * Errors are NOT reported back up the call stack. d iErrNo 10i 0 Value * * Prototype for API that returns the text for an error number. * d StrError Pr * ExtProc('strerror') d ErrNum 10i 0 Value * * Stat data structure parsed on the call. For the meaning of each * field, search the net :-) * d StatDS Ds 128 d st_mode 10U 0 d st_ino 10U 0 d st_nlink 5U 0 d reserved1 2A d st_uid 10U 0 d st_gid 10U 0 d st_size 10U 0 d st_atime 10U 0 d st_mtime 10U 0 d st_ctime 10U 0 d st_dev 10U 0 d st_blksize 10I 0 d st_allocsize 10I 0 d st_objtype 10A d reserved2 2A d st_codepage 5U 0 d st_reserved1 62A d st_ino_genid 10U 0 * d p_errmsg s * d Msg s 50a d Stamp s z d ReturnCode s 1n Inz(*Off) * * If an error occurred, then display that error. * c If iErrNo <> *Zeros c EVal p_errmsg = StrError(iErrNo) c EVal Msg = 'Error reading ' +%TrimR(iPath) + c ': ' + %Str(p_errmsg) c Msg Dsply c EVal ReturnCode = *On c Else * * In this example, we ignore the parent dir. * c If iFileName <> '..' * c If iIsDir = *On c EVal Msg = 'Dir.:' c Else c EVal Msg = 'File:' c EndIf * c EVal Msg = %TrimR(Msg) + ' '+ %TrimR(iPath) + c '/' + %TrimR(iFileName) c Msg Dsply * * As iStatDS is merly a string field, we must convert to StatDS * structure to get each field. * c EVal StatDS = iStatDS * * Call convert routine to get a 'good old timestamp' of when the * file was last modified. * c EVal Stamp = CnvUTimeToTS(st_mtime) c EVal Msg = 'Last modified: ' + %Char(Stamp) * c Msg Dsply * c EndIf c EndIf * c Return ReturnCode * P FileFound E * * CnvUTimeToTS * ------------ * Convert Unix time field into TimeStamp field taking into account * the local time zone. * P CnvUTimeToTS B d CnvUTimeToTS Pi z d iTime 10u 0 Const * d LocalTime Pr * ExtProc('localtime') d TimeVal * Value * d tm Ds Based(tmP) d tm_sec 10I 0 d tm_min 10I 0 d tm_hour 10I 0 d tm_mday 10I 0 d tm_mon 10I 0 d tm_year 10I 0 d tm_wday 10I 0 d tm_yday 10I 0 d tm_isdst 10I 0 * d tmP s * * d wTime s 10u 0 d nStamp s 20s 0 d oStamp s z Inz(z'0001-01-01-01.01.01.000000') * c EVal wTime = iTime c EVal tmP = LocalTime(%Addr(wTime)) * c If tmP <> *Null * c EVal nStamp = tm_year + 1900 c EVal nStamp = nStamp * 100 c EVal nStamp = nStamp + tm_mon + 1 c EVal nStamp = nStamp * 100 c EVal nStamp = nStamp + tm_mday c EVal nStamp = nStamp * 100 c EVal nStamp = nStamp + tm_hour c EVal nStamp = nStamp * 100 c EVal nStamp = nStamp + tm_min c EVal nStamp = nStamp * 100 c EVal nStamp = nStamp + tm_sec c EVal nStamp = nStamp * 1000000 * c *ISO Move nStamp oStamp * c EndIf * c Return oStamp * P CnvUTimeToTS E *
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)