Recursive filesearch

From Freepascal Amiga wiki
Jump to: navigation, search

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.