Recursive filesearch
Revision as of 13:56, 30 May 2015 by Molly (talk | contribs) (→Recursive file matching, using Pascal functions (for comparison): Check-in a 2nd version for comparison, using Pascal functionality.)
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
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; // Indentination level for printing
var
ap : PAnchorPath;
error : longint; // Holds returncode 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 indentination 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.