Recursive filesearch
Revision as of 14:57, 30 May 2015 by Molly (talk | contribs) (→Recursive file matching, using AROS native functions: Some typos corrected)
Another small code example i wanted to 'rescue' from aros-exec 'haystack'.
Original code was pasted in this post.
Recursive file matching, using AROS native functions
The code does a recursive file search using amigados specific calls to do so.
Program RecursiveFileMatchAROS;
{$MODE OBJFPC}{$H+}
uses
exec,
amigados,
SysUtils;
Procedure FileSearchAROS(const pathname, FileMask: string; const DoRecursive: boolean);
{
Routine based on thomas-rapps post ->
http://eab.abime.net/showpost.php?p=660659&postcount=5
FileSearch routine that can search directories recursive (no restrictions)
and match a given file pattern. The FileMask pattern is not applied to the
directory, only to the file.
This routine is by no means foolproof and definitely needs a bit more TLC.
}
Var
level : longint; // Indentation level for printing
var
ap : PAnchorPath;
error : longint; // Holds return code for AROS' match-functions
s : String; // Temp storage used for post entry-type printing
filename : String; // String holds current filename entry (only filename part)
filemaskTOK : pChar; // C-String, hold tokenized mask needed by AROS API
isMatch : Longbool; // Temp boolean placeholder to hold the match result
i : longint; // used for counting
begin
ap := AllocVec(sizeof(TAnchorPath) + 1024, MEMF_CLEAR);
if (ap <> nil) then
begin
ap^.ap_BreakBits := SIGBREAKF_CTRL_C;
ap^.ap_StrLen := 1024;
end;
level := 0;
error := MatchFirst(pchar(pathname), ap);
if (error = 0) and (ap^.ap_Info.fib_DirEntryType >= 0)
then ap^.ap_Flags := ap^.ap_Flags or APF_DODIR;
while (error = 0) do
begin
if ((ap^.ap_Flags and APF_DIDDIR) <> 0) then
begin
{ Leaving a directory entered below (APF_DODIR) }
dec(level);
ap^.ap_Flags := ap^.ap_Flags and not(APF_DIDDIR);
end
else
begin
{
Soft linked objects are returned by the scanner but they need
special treatments; we are merely ignoring them here in order
to keep this example simple
}
if (ap^.ap_Info.fib_DirEntryType <> ST_SOFTLINK) then
begin
{
provide for some indentation
}
for i := 0 to pred(level) do write(' ');
if (ap^.ap_Info.fib_DirEntryType < 0) then
begin
{ Initial postfix printing string is empty (=file) }
s := '';
{
According to AutoDocs/FileInfoBlock struct, we can now be certain
that we do not deal with a directory, but are dealing with an
actual file.
}
{ Use FileInfoBlock struct to retrieve filename of current entry }
Filename := ap^.ap_Info.fib_FileName;
{ do something nice, and emit the filename }
writeln('filename = ',filename);
{
Now we have a real filename (only) to work with. But
what should we do with it ? Is it even useful ?
We know we need the filename to match the given
filemask.
Is there perhaps a way to do this ? Lets try:
}
{ allocate heapmem for pchar: fpc business. Size taken from AutoDocs }
FileMaskTOK := stralloc((Length(FileMask) * 2) + 2);
{ create a tokenized filemask with a trickery cast. Size taken from AutoDocs }
ParsePatternNoCase(pchar(FileMask), FileMaskTOK, (Length(FileMask) * 2) + 2);
{ match a pattern }
IsMatch := MatchPatternNoCase(FileMaskTOK, pchar(FileName));
{ check the result, if matched then emit something }
if IsMatch then writeln('It seems that the above printed filename matches the filemask o/');
{ return allocated heapmem for pchar: fpc business }
strdispose(FileMaskTOK);
end
else s := ' (Dir)'; // Change postfix printing string to read directory
// Emit the current entry. ap_Buf contains the full path + filename
writeln(format('%s%s',[ap^.ap_Buf, s]));
{ If this is a directory, enter it }
if ((ap^.ap_Info.fib_DirEntryType >= 0) and DoRecursive) then
begin
ap^.ap_Flags := (ap^.ap_Flags or APF_DODIR);
{ For every directory entered, update indentation level accordingly }
inc(level);
end;
end;
end;
error := MatchNext(ap);
end;
MatchEnd(ap);
FreeVec(ap);
end;
Begin
WriteLn('enter');
FileSearchAROS('Ram:','#?.info', true);
Writeln('leave');
End.
Recursive file matching, using Pascal functions (for comparison)
program RecursiveFileMatchPAS;
{$MODE OBJFPC}{$H+}
uses
SysUtils,
fpMasks;
Const
AllWildMask = '#?';
Procedure FileSearchPAS(const pathname, FileMask: String; const DoRecursive: boolean);
{
Pascal recursive filesearch routine, based on the AROS' native version to
show the differences.
FileSearch routine that can search directories recursive (no restrictions)
and match a given file pattern. The FileMask pattern is not applied to the
directory, only to the file.
This routine is by no means foolproof and definitely needs a bit more TLC.
}
Const
Level : LongInt= 0; // Indentation level for printing
var
SR : TSearchRec; // FileSearch record, similar to AROS' AnchorPath
sPath : String; // Corrected path which is required for FPC
S : String; // Temp storage used for post entry-type printing
filename : String; // String holds current filename entry (only filename part)
FilemaskTOK : TMask; // Pascal class to hold mask needed by FPC to Match a wildcard
isMatch : Boolean; // Temp boolean placeholder to hold the match result
i : Longint; // used for counting
begin
{
Pascal's FindFirst/FindNext requires proper path ending, so provide it.
}
sPath := IncludeTrailingPathDelimiter(pathname);
{
small workaround to match AROS' native counterpart as FPC's native
implementation does not start matching the root path, rather files within.
}
if ( level = 0 ) then
begin
Writeln(sPath + ' (Dir)');
inc(level);
end;
{
Find anyfile on the given Path matching All possible filenames
}
if ( FindFirst(sPath + AllWildMask, faAnyFile, SR) = 0 ) then
repeat
{
Soft linked objects are returned by the scanner but they need
special treatments; we are merely ignoring them here in order
to keep this example simple
}
If ((SR.Attr and faSymLink) = 0) then
begin
{
provide for some indentation
}
for i := 0 to Pred(level) do write(' ');
{
If not directory (= FPC cross platform Alert!) then assume file.
It is not foolproof to assume we deal with a file as there are other
possible directory entry types on other platforms. As long as you run
this implementation on AROS things should work correctly )
}
if ((SR.Attr and faDirectory) = 0) then
begin
{ Initial postfix printing string is empty (=file) }
S := '';
{ Use TSearchRec struct to retrieve the name of the current entry }
Filename := SR.Name;
{ do something nice, and emit the filename }
writeln('filename = ', filename);
{ create mask in pascal to compare mask against current filename }
FilemaskTOK := TMask.Create(FileMask);
{ match the mask against the curent filename }
IsMatch := FileMaskTOK.Matches(FileName);
{ free mask memory. Very inefficient, comparable to AROS counterpart }
FileMaskTOK.Free;
{ check the result, if matched then emit something }
if IsMatch then writeln('It seems that the above printed filename matches the filemask o/');
end
else S := ' (Dir)'; // Change postfix printing string to read directory
{
Emit the current entry. name entry of TSearchrec contains only the
name, therefor construct things ourselves in order to get a complete
path + filename
}
Writeln(sPath + SR.Name + S);
{ If this is a directory, enter it }
if ((SR.Attr and faDirectory) <> 0) and DoRecursive then
begin
{ For every directory entered, update indentation level accordingly }
inc(level);
{
In opposite to AROS native implementation, for FPC we manually need
to call ourselves recursively.
Note that this can lead to stack issues. Increase stack accordingly.
}
FileSearchPAS(sPath + SR.Name, FileMask, DoRecursive);
{ For every directory leaving, update indentation level accordingly }
dec(level);
end;
end;
until ( FindNext(SR) <> 0 );
FindClose(SR);
end;
Begin
WriteLn('enter');
FileSearchPAS('Ram:','*.info', true);
Writeln('leave');
End.