{ 
	An example of Delphi visual component for directory search.
	Wrapper for a standard Pascal FindFirst/FindNext folder enumeration functionality.
	
	( 2003  Igor Klepoch )
}

unit UDirSearch;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;


type
  TNotifyNewFileEvent = procedure(Sender: TObject; FName : string) of object;
  TDirSearch = class(TComponent)
  private
    FFileMask: string;
    FNewFile : TNotifyNewFileEvent;
    FDirName: string;
    FileAttrs : integer;
    FSearchSubdirectory: boolean;
    procedure SetFileMask(const Value: string);
    procedure SetDirName(const Value: string);
    procedure SetNewFile(const Value: TNotifyNewFileEvent);
    procedure SetSearchSubdirectory(const Value: boolean);
  published
    procedure LoadDir (LDir : string);
    property NewFile : TNotifyNewFileEvent read FNewFile write SetNewFile;
    property FileMask : string read FFileMask write SetFileMask;
    property DirName : string read FDirName write SetDirName;
    property SearchSubdirectory : boolean read FSearchSubdirectory write SetSearchSubdirectory;
  public
    procedure StartSearch;
    constructor Create(AOwner: TComponent); override; 
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TDirSearch]);
end;

{ TDirSearch }

function NormalDir (DirName : string) : string;
begin
  if copy(DirName, length(DirName), 1) = '\' then
    result := DirName
  else
    result := DirName + '\';
end;

constructor TDirSearch.Create(AOwner: TComponent);
begin
  FFileMask := '*.*';
  FSearchSubdirectory := true;
  inherited Create(AOwner);
end;

procedure TDirSearch.LoadDir (LDir : string);
var
    ADir : string;
    sr : TSearchRec;

procedure MAddNewItem;
begin
// is it subdirectory ? Open it.
    if FSearchSubdirectory then
      if ((sr.Attr and faDirectory) > 0) and (sr.name[1] <> '.') then begin
        LoadDir (NormalDir(LDir) + sr.Name + '\');
        exit;
      end;

    if (length(sr.Name) > 0) and (sr.Name[1] <> '.') then
      if assigned (NewFile) then
        NewFile (self, Adir + sr.Name);
end;

begin
  Adir := NormalDir (LDir);
  if FSearchSubdirectory then begin
    FileAttrs := faHidden + faSysFile + faArchive + faDirectory;
    if FindFirst(ADir + '*.*', FileAttrs, sr) = 0 then begin
      if sr.attr and faDirectory > 0 then MAddNewItem;
      while FindNext(sr) = 0 do begin
        if sr.attr and faDirectory > 0 then MAddNewItem;
      end;
      FindClose(sr);
    end;
  end;

  FileAttrs := faAnyFile + faHidden + faSysFile + faArchive + faDirectory;
  if FindFirst(ADir + FFileMask, FileAttrs, sr) = 0 then begin
    if sr.attr and faDirectory = 0 then MAddNewItem;
    while FindNext(sr) = 0 do begin
      if sr.attr and faDirectory = 0 then MAddNewItem;
    end;
    FindClose(sr);
  end;
end;

procedure TDirSearch.SetDirName(const Value: string);
begin
  FDirName := NormalDir(Value);
end;


procedure TDirSearch.SetFileMask(const Value: string);
begin
  FFileMask := Value;
end;

procedure TDirSearch.SetNewFile(const Value: TNotifyNewFileEvent);
begin
  FNewFile := Value;
end;

procedure TDirSearch.SetSearchSubdirectory(const Value: boolean);
begin
  FSearchSubdirectory := Value;
end;

procedure TDirSearch.StartSearch;
begin
    LoadDir (FDirName);
end;

end.