Difference between revisions of "Recursive filesearch"

From Freepascal Amiga wiki
Jump to: navigation, search
m (small layout update + preperations + typo corrected)
(Recursive file matching, using AROS native functions: Updated recursive file match example using AROS API (should compile out of the box now).)
Line 8: Line 8:
  
 
<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.php?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;    // Indentination level for printing
 
var   
 
var   
 
   ap          : PAnchorPath;  
 
   ap          : PAnchorPath;  
   error
+
   error       : longint;   // Holds returncode 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 indentination 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  
 
Begin  
   WriteLn('start');  
+
   WriteLn('enter');  
 
+
 
   FileSearchAROS('Ram:','#?.info', true);  
 
   FileSearchAROS('Ram:','#?.info', true);  
 
+
   Writeln('end');  
+
   Writeln('leave');  
 
End.
 
End.
 
 
</source>
 
</source>
  

Revision as of 14:50, 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;    // 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)