[Back to DIRS SWAG index]  [Back to Main SWAG index]  [Original]

{
 Can any one tell me a way to make pascal (TP 6.0) search a
 complete drive, including all subdirectories, even ones
 that are not in the path, looking For a specific File
 extension?  I.E., having the Program search For *.DOC and
 saving that to a Text File?

 Here's part of a package I'm putting together.  You'd use it like this:

}

{File Test.Pas}

Uses
  Dos, Foreach;

Procedure PrintAllDocs;

  Procedure PrintFile(Var Dir: DirStr; Var S : SearchRec); Far;
  begin
    Writeln('Found File ',Dir,S.Name);
  end;

begin
  ForEachFile('c:\*.doc',  { Give the mask where you want to start looking }
              0, 0,        { Specify File attributes here; you'll just get
                             normal Files With 0 }
              True,        { Search recursively }
              @PrintFile); { Routine to call For each File }
end;

begin
  PrintAllDocs;
end.


{Unit ForEach}

Unit ForEach;

{ Unit With a few different "foreach" Functions. }
{ This extract contains only ForEachFile. }

Interface

Uses
  Dos;

Type
  FileStr = String[12];
  TFileAction = Procedure(Var Dir : DirStr;
                          Var S : SearchRec; ConText : Word);

Procedure ForEachFile(Mask : PathStr; { File wildcard mask, including path }
                      Attr : Byte; { File attributes }
                      Match : Byte; { File attributes which
                                             must match attr exactly }
                      Subdirs : Boolean; { Whether to search recursively }
                      Action : Pointer);
{ Calls the Far local Procedure Action^ For each File found.
  Action^ should be a local Procedure With declaration
    Procedure Action(Var Path : String; Var S : SearchRec); Far;
  or, if not a local Procedure,
    Procedure Action(Var Path : String; Var S : SearchRec; Dummy : Word); Far;
  Each time Action is called S will be filled in For a File matching
  the search criterion.
}

Implementation

Function CallerFrame : Word;
{ Returns the BP value of the caller's stack frame; used For passing
  local Procedures and Functions around. Taken from Borland's Outline
  Unit. }
  Inline(
    $8B/$46/$00                   { MOV   AX,[BP] }
    );


  { ******** File routines ********* }

Procedure ForEachFile(Mask    : PathStr; { File wildcard mask }
                      Attr    : Byte;    { File attributes }
                      Match   : Byte;    { Attributes which must match }
                      Subdirs : Boolean; { Whether to search recursively }
                      Action  : Pointer);{ Action; should point to
                                           a TFileAction local Far Procedure }
Var
  CurrentDir : DirStr;
  Doit       : TFileAction Absolute Action;
  Frame      : Word;

  Procedure DoDir;
  { Tests all Files in current directory.  Assumes currentdir has trailing
    backslash }
  Var
    S : SearchRec;
  begin
    FindFirst(CurrentDir + Mask, Attr, S);
    While DosError = 0 do
    begin
      if (S.Attr and Match) = (Attr and Match) then
        Doit(CurrentDir, S, Frame);
      FindNext(S);
    end;
  end;

  Function RealDir(Name : FileStr) : Boolean;
  begin
    RealDir := (Name <> '.') and (Name <> '..');
  end;

  Procedure AddBackslash;
  begin
    CurrentDir := CurrentDir + '\';
  end;

  Procedure DoAllDirs;
  Var
    S         : SearchRec;
    OldLength : Byte;

    Procedure AddSuffix(Suffix : FileStr); { Separate proc to save stack space }
    begin
      CurrentDir := Copy(CurrentDir, 1, OldLength) + Suffix;
    end;

  begin
    OldLength := Length(CurrentDir);
    DoDir;
    AddSuffix('*.*');
    FindFirst(CurrentDir, Directory, S);
    While DosError = 0 do
    begin
      if S.Attr = Directory then
      begin
        if RealDir(S.Name) then
        begin
          AddSuffix(S.Name);
          AddBackslash;
          DoAllDirs;            { do directory recursively }
        end;
      end;
      FindNext(S);
    end;
  end;

Var
  Name : NameStr;
  Ext  : ExtStr;

begin                           { ForEachFile }
  FSplit(Mask, CurrentDir, Name, Ext);
  Mask := Name+Ext;
  Frame := CallerFrame;
  if CurrentDir[Length(CurrentDir)] <> '\' then
    AddBackslash;
  if Subdirs then
    DoAllDirs
  else
    DoDir;
end;

end.

[Back to DIRS SWAG index]  [Back to Main SWAG index]  [Original]