Difference between revisions of "Recursive filesearch"

From Freepascal Amiga wiki
Jump to: navigation, search
(initial content)
 
m (Recursive file matching, using AROS native functions: Some typos corrected)
 
(4 intermediate revisions by the same user not shown)
Line 1: Line 1:
Another small code example i wanted to 'resque' from aros-exec 'haystack'.
+
Another small code example i wanted to 'rescue' from aros-exec 'haystack'.
  
 
Original code was pasted in [http://aros-exec.org/modules/newbb/viewtopic.php?post_id=75487#forumpost75487 this] post.
 
Original code was pasted in [http://aros-exec.org/modules/newbb/viewtopic.php?post_id=75487#forumpost75487 this] post.
  
The code does a recursive filesearch using amigados specific calls to do so.
+
== Recursive file matching, using AROS native functions ==
  
Should be able to work with replacing unit use aros_exec with exec and aros_dos with amigados.
+
The code does a recursive file search using amigados specific calls to do so.
  
 
<source lang="pascal">
 
<source lang="pascal">
Program RecurseFilematch;  
+
Program RecursiveFileMatchAROS;
 
+
 
{$MODE OBJFPC}{$H+}  
 
{$MODE OBJFPC}{$H+}  
 
+
 
uses  
 
uses  
   aros_exec,  
+
   exec,  
   aros_dos,  
+
   amigados,  
 
   SysUtils;  
 
   SysUtils;  
 
+
 
+
 
+
Procedure FileSearchAROS(const pathname, FileMask: string; const DoRecursive: boolean);  
+
Procedure FileSearchAROS(const pathname, FileMask: string; const DoRecursive: boolean);
 
{  
 
{  
 
   Routine based on thomas-rapps post ->   
 
   Routine based on thomas-rapps post ->   
   http://eab.abime.net/showpost?p=660659&postcount=5  
+
   http://eab.abime.net/showpost.php?p=660659&postcount=5  
   FileSearch routine that can search directories recursive (no restrictions) and match  
+
   FileSearch routine that can search directories recursive (no restrictions)  
  a given file pattern. The pattern is not applied to the directory, only to the file.  
+
  and match a given file pattern. The FileMask pattern is not applied to the  
   This routine is not foolproof and definatly needs a bit more TLC.
+
  directory, only to the file.
  Sorry for the ugly code.  
+
   This routine is by no means foolproof and definitely needs a bit more TLC.  
 
}  
 
}  
  
 +
Var
 +
  level      : longint;    // Indentation level for printing
 
var   
 
var   
 
   ap          : PAnchorPath;  
 
   ap          : PAnchorPath;  
   error
+
   error       : longint;   // Holds return code for AROS' match-functions
  level, 
+
   s           : String;    // Temp storage used for post entry-type printing
  i          : longint;  
+
   filename    : String;    // String holds current filename entry (only filename part)  
 
+
   filemaskTOK : pChar;      // C-String, hold tokenized mask needed by AROS API
   s,                        // We need a temp string because fpc does not have a ? operator
+
   filename    : String;    // String to hold the filename (and only filename part)  
+
   filemaskTOK : pChar;      // C-String to hold the tokenized mask needed for AROS API Routine
+
 
   isMatch    : Longbool;  // Temp boolean placeholder to hold the match result  
 
   isMatch    : Longbool;  // Temp boolean placeholder to hold the match result  
 +
  i          : longint;    // used for counting
 
begin  
 
begin  
 
   ap := AllocVec(sizeof(TAnchorPath) + 1024, MEMF_CLEAR);  
 
   ap := AllocVec(sizeof(TAnchorPath) + 1024, MEMF_CLEAR);  
Line 46: Line 46:
 
     ap^.ap_StrLen    := 1024;   
 
     ap^.ap_StrLen    := 1024;   
 
   end;  
 
   end;  
 
+
 
   level := 0;  
 
   level := 0;  
 
+
   error := MatchFirst(pathname, ap);  
+
   error := MatchFirst(pchar(pathname), ap);  
 
+
 
   if (error = 0) and (ap^.ap_Info.fib_DirEntryType >= 0)  
 
   if (error = 0) and (ap^.ap_Info.fib_DirEntryType >= 0)  
 
     then ap^.ap_Flags := ap^.ap_Flags or APF_DODIR;  
 
     then ap^.ap_Flags := ap^.ap_Flags or APF_DODIR;  
 
+
 
   while (error = 0) do  
 
   while (error = 0) do  
 
   begin  
 
   begin  
Line 65: Line 65:
 
     begin  
 
     begin  
 
       {  
 
       {  
         Soft linked objects are returned by the scanner  
+
         Soft linked objects are returned by the scanner but they need  
        but they need special treatments; we are merely  
+
        special treatments; we are merely ignoring them here in order  
        ignoring them here in order to keep this example  
+
        to keep this example simple
        simple  
+
 
       }  
 
       }  
 
       if (ap^.ap_Info.fib_DirEntryType <> ST_SOFTLINK) then  
 
       if (ap^.ap_Info.fib_DirEntryType <> ST_SOFTLINK) then  
Line 76: Line 75:
 
         }  
 
         }  
 
         for i := 0 to pred(level) do write(' ');  
 
         for i := 0 to pred(level) do write(' ');  
 
+
 
         if (ap^.ap_Info.fib_DirEntryType < 0) then  
 
         if (ap^.ap_Info.fib_DirEntryType < 0) then  
 
         begin  
 
         begin  
           s := '';  { no ? operator: results in dumb code to mimic the behaviour }
+
          { Initial postfix printing string is empty (=file) }
 
+
           s := '';   
 +
 
           {  
 
           {  
             According to AutoDocs/FileInfoBlock struct, we can now  
+
             According to AutoDocs/FileInfoBlock struct, we can now be certain
             be certain that we do not deal with a directory, but are  
+
             that we do not deal with a directory, but are dealing with an  
            dealing with an actual file.
+
             actual file.  
            So if we can find a way to determine the name of the
+
             file then we could do nice things with it, such as 
+
            emitting the name.  
+
 
           }  
 
           }  
           { get the name }  
+
 
 +
           { Use FileInfoBlock struct to retrieve filename of current entry }  
 
           Filename := ap^.ap_Info.fib_FileName;  
 
           Filename := ap^.ap_Info.fib_FileName;  
 +
 
           { do something nice, and emit the filename }  
 
           { do something nice, and emit the filename }  
 
           writeln('filename = ',filename);  
 
           writeln('filename = ',filename);  
 
+
 
           {  
 
           {  
 
             Now we have a real filename (only) to work with. But   
 
             Now we have a real filename (only) to work with. But   
Line 101: Line 100:
 
             Is there perhaps a way to do this ? Lets try:                   
 
             Is there perhaps a way to do this ? Lets try:                   
 
           }  
 
           }  
 +
 
           { allocate heapmem for pchar: fpc business. Size taken from AutoDocs }  
 
           { allocate heapmem for pchar: fpc business. Size taken from AutoDocs }  
 
           FileMaskTOK := stralloc((Length(FileMask) * 2) + 2);  
 
           FileMaskTOK := stralloc((Length(FileMask) * 2) + 2);  
 +
 
           { create a tokenized filemask with a trickery cast. Size taken from AutoDocs }  
 
           { create a tokenized filemask with a trickery cast. Size taken from AutoDocs }  
 
           ParsePatternNoCase(pchar(FileMask), FileMaskTOK, (Length(FileMask) * 2) + 2);  
 
           ParsePatternNoCase(pchar(FileMask), FileMaskTOK, (Length(FileMask) * 2) + 2);  
 +
 
           { match a pattern }  
 
           { match a pattern }  
           IsMatch := MatchPatternNoCase(FileMaskTOK, FileName);  
+
           IsMatch := MatchPatternNoCase(FileMaskTOK, pchar(FileName));  
           { check the result, if we match we emit the name, or you can do whatever with it }  
+
 
 +
           { check the result, if matched then emit something }
 
           if IsMatch then writeln('It seems that the above printed filename matches the filemask o/');           
 
           if IsMatch then writeln('It seems that the above printed filename matches the filemask o/');           
 +
 
           { return allocated heapmem for pchar: fpc business }           
 
           { return allocated heapmem for pchar: fpc business }           
 
           strdispose(FileMaskTOK);  
 
           strdispose(FileMaskTOK);  
 
         end   
 
         end   
         else s := ' (Dir)'; { no ? operator: results in dumb code to mimic the behaviour }
+
         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]));  
 
         writeln(format('%s%s',[ap^.ap_Buf, s]));  
 
+
 
         { If this is a directory, enter it }  
 
         { If this is a directory, enter it }  
 
         if ((ap^.ap_Info.fib_DirEntryType >= 0) and DoRecursive) then  
 
         if ((ap^.ap_Info.fib_DirEntryType >= 0) and DoRecursive) then  
 
         begin  
 
         begin  
           ap^.ap_Flags := (ap^.ap_Flags or APF_DODIR);  
+
           ap^.ap_Flags := (ap^.ap_Flags or APF_DODIR);
 +
 
 +
          { For every directory entered, update indentation level accordingly }
 
           inc(level);  
 
           inc(level);  
 
         end;  
 
         end;  
 
+
 
       end;  
 
       end;  
 
     end;  
 
     end;  
 
     error := MatchNext(ap);  
 
     error := MatchNext(ap);  
 
+
 
   end;  
 
   end;  
 
   MatchEnd(ap);  
 
   MatchEnd(ap);  
 
   FreeVec(ap);  
 
   FreeVec(ap);  
 
end;  
 
end;  
 +
 +
 +
 +
Begin
 +
  WriteLn('enter');
 +
 +
  FileSearchAROS('Ram:','#?.info', true);
 +
 +
  Writeln('leave');
 +
End.
 +
</source>
  
 +
== Recursive file matching, using Pascal functions (for comparison) ==
 +
<source lang="pascal">
 +
program RecursiveFileMatchPAS;
  
 +
{$MODE OBJFPC}{$H+}
  
Begin
+
uses
   WriteLn('start');  
+
   SysUtils,
 +
  fpMasks;
  
   FileSearchAROS('Ram:','#?.info', true);  
+
Const
 +
   AllWildMask = '#?';
  
  Writeln('end');  
+
Procedure FileSearchPAS(const pathname, FileMask: String; const DoRecursive: boolean);
End.
+
{
 +
  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.
 
</source>
 
</source>

Latest revision as of 13:57, 30 May 2015

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.