(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTFileCollector;

interface

uses Classes, AHMSystemClass;

type
  TAHMOnFileFound = Procedure(Sender : TObject;FileOrPath : String;var Continue : Boolean) of Object;
  TAHMFileCollector = class(TAHMExecuteComponent)
  private
    FDoContinue : Boolean;
    FOnFileFound: TAHMOnFileFound;
    FDoSubdirectories : Boolean;
    FOnDirectoryFound: TAHMOnFileFound;
    FInitialDirectory: String;
    FFileMask: String;
    FLocatedObjects : TStrings;
    FOnStart: TNotifyevent;
    FOnDone: TNotifyevent;
    procedure SetLocatedObjects(value : TStrings);
  protected
  public
    constructor Create (AOwner: TComponent);  override;
    destructor Destroy; override;
    Function Execute : Boolean; override;
    Function Scandirectory(const dir: string;fmask:String): Boolean;
  published
    property OnDirectoryFound: TAHMOnFileFound read FOnDirectoryFound write FOnDirectoryFound;
    property OnFileFound: TAHMOnFileFound read FOnFileFound write FOnFileFound;
    property LocatedObjects: TStrings read FLocatedObjects write SetLocatedObjects;
    property InitialDirectory: String read FInitialDirectory write FInitialDirectory;
    property FileMask: String read FFileMask write FFileMask;
    property OnStart : TNotifyevent read FOnStart write FOnStart;
    property OnDone : TNotifyevent read FOnDone write FOnDone;
    property DoSubDirectories : Boolean read FDoSubDirectories write FDoSubdirectories default True;
  end;

implementation

uses Forms,SysUtils;

constructor TAHMFileCollector.Create (AOwner: TComponent);
begin
  Inherited Create(AOwner);
  FLocatedObjects:=TStringlist.create;
  FDoSubdirectories:=true;
end;

destructor TAHMFileCollector.Destroy;
begin
  FLocatedObjects.free;
  inherited destroy;
end;

procedure TAHMFileCollector.SetLocatedObjects(value : TStrings);
begin
  FLocatedObjects.assign(value);
end;

Function TAHMFileCollector.Execute : Boolean;
Var FMask : String;
begin
  FDoContinue:=True;
  if assigned(FOnStart) then FOnStart(self);
  FLocatedObjects.clear;
  if FInitialDirectory = '' then FInitialDirectory := GetCurrentDir;
  if FInitialDirectory [Length (FInitialDirectory)] <> '\' then
     FInitialDirectory := FInitialDirectory + '\';
     FInitialDirectory := ExtractFileDir (FInitialDirectory);
  if FInitialDirectory [Length (FInitialDirectory)] <> '\' then
     FInitialDirectory := FInitialDirectory + '\';
  try
    FMask:=FFileMask;
    while pos(';',FMask)>0 do
    begin
      result:=scandirectory(FInitialDirectory,Copy(FMask,1,Pos(';',FMask)-1));
      Delete(FMask,1,Pos(';',FMask));
    end;
    result:=scandirectory(FInitialDirectory,FMask);
  finally
    if assigned(FOnDone) then FOnDone(self);
  end;
end;

Function TAHMFileCollector.Scandirectory (const dir: string;FMask : String): Boolean;
var
 f: TSearchRec;
 status: integer;
 file_list: TStringList;
 dir_list: TStringList;
 i: integer;

begin
  result:=false;
  Application.ProcessMessages;
  if Assigned (FOnDirectoryFound) then FOnDirectoryFound (self,Dir,FDoContinue);
  if not(FDoContinue) then exit;
  file_list := TStringList.Create;
  file_list.Sorted := True;
  dir_list := TStringList.Create;
  dir_list.Sorted := True;
  dir_list.BeginUpdate;
  status := FindFirst (dir + '*.*', faAnyFile, f);
  while status = 0 do with f do
  begin
    if ((faDirectory and Attr) <> 0) and (Name <> '.') and (Name <> '..')
      then dir_list.Add (dir + Name + '\');
    status := FindNext (f);
  end;
  FindClose (f);
  dir_list.EndUpdate;
  file_list.BeginUpdate;
  status := FindFirst (dir + FMask, faAnyFile, f);
  while status = 0 do with f do
  begin
    if ((faDirectory and Attr) = 0) and ((faVolumeID and Attr) = 0)
      then file_list.Add (dir + Name);
    status := FindNext (f);
  end;
  FindClose (f);
  file_list.EndUpdate;
  for i := 0 to file_list.Count - 1 do
  if FDoContinue then
  begin
    FLocatedObjects.add(file_list.Strings[i]);
    result:=true;
    if Assigned (FOnFileFound) then FOnFileFound(self,file_list.Strings[i],FDoContinue);
  end;
  if FDoSubdirectories then
  for i := 0 to dir_list.Count - 1 do
    if FDoContinue then scandirectory(dir_list.Strings [i],FMask);
  file_list.Free;
  dir_list.Free;

end;

end.

