Delphi does not come with a built-in way to make it easy to search for files. Instead, you need to make Windows API calls to
FindFirst and
FindNext. This method doesn't automatically take recursive searches into consideration either, you must implement this yourself.
There is always some confusion using this method, and I'm not here to explain all the different uses or to explain just how to use them. Instead, I have encapsulated this into a threaded component to perform the searching for you. Keep in mind this is designed to
Search for files recursively, not necessarily to just
List files in a directory.
The component's name is
TSearcher and it wraps a thread called
TSearcherThread. It does not keep a listing of the results it finds - instead, it triggers an event when a search result is found. Therefore, whenever you perform a search, you must be sure to assign an event handler. Installing this component to your palette is another story too, which I will not cover.
To actually use this component, supply a value for the properties
Directory and
Filter.
Directory is the root directory to perform the search, and
Filter is where you specify the file extensions to include. If
Filter is left blank, it will return all file types. Otherwise, to apply a filter, supply a string such as
.jpg;.jpeg;.gif;.png;.bmp. This will include image file types of JPG, JPEG, GIF, PNG, and BMP. Assign an event handler to the
OnResult property. The procedure should have parameters like this:
procedure TForm1.SearchResult(Sender: TSearcherThread; const Filename: String);. You may also wish to supply a value for
Timeout, which is the number of seconds before a search is timed out. The default value is 120 secons (2 minutes), so after 2 minutes the search will stop. A Timeout of 0 means there is no timeout.
After your properties have been supplied, to perform the actual search, call its
Start procedure. You can call
Stop at any time to abort the search. During the search, every result will be returned with the
OnResult event. The
OnStart and
OnStop events are triggered when the search either Starts or Stops. If you forcibly stop it, or when the search is completed, or when the search times out, the
OnStop event will always be called to notify you that it's done.
NOTE: This is not designed to search for files matching a filename. It is only intended to search recursively for files matching certain extensions. I have future plans for this component which involve more search options.
Here is the full source for this component:
FileSearcher.pas
Code:
unit FileSearcher;
interface
uses
Windows, Classes, SysUtils;
type
TSearcher = class;
TSearcherThread = class;
TSearchEvent = procedure(Sender: TSearcherThread) of object;
TSearchResultEvent = procedure(Sender: TSearcherThread;
const Filename: String) of object;
TSearcher = class(TComponent)
private
FThread: TSearcherThread;
FOnResult: TSearchResultEvent;
FOnStop: TSearchEvent;
FOnStart: TSearchEvent;
procedure SetDirectory(const Value: String);
procedure SetFilter(const Value: String);
procedure ThreadResult(Sender: TSearcherThread; const Filename: String);
procedure ThreadStart(Sender: TSearcherThread);
procedure ThreadStop(Sender: TSearcherThread);
function GetDirectory: String;
function GetFilter: String;
function GetTimeout: Integer;
procedure SetTimeout(const Value: Integer);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Start;
procedure Stop;
published
property Directory: String read GetDirectory write SetDirectory;
property Filter: String read GetFilter write SetFilter;
property Timeout: Integer read GetTimeout write SetTimeout;
property OnResult: TSearchResultEvent read FOnResult write FOnResult;
property OnStart: TSearchEvent read FOnStart write FOnStart;
property OnStop: TSearchEvent read FOnStop write FOnStop;
end;
TSearcherThread = class(TThread)
private
FLock: TRTLCriticalSection;
FDirectory: String;
FFilter: String;
FTimeout: Integer;
FStartTick: DWORD;
FActive: Boolean;
FSYNC_Filename: String;
FOnResult: TSearchResultEvent;
FOnStop: TSearchEvent;
FOnStart: TSearchEvent;
function GetDirectory: String;
function GetFilter: String;
procedure SetDirectory(const Value: String);
procedure SetFilter(const Value: String);
procedure FileSearch(const PathName, Extensions: string);
procedure DoResult(const AFilename: String);
procedure SYNC_OnResult;
function GetTimeout: Integer;
procedure SetTimeout(const Value: Integer);
function CheckTimeout: Boolean;
protected
procedure Execute; override;
public
constructor Create;
destructor Destroy; override;
procedure Start;
procedure Stop;
public
property Directory: String read GetDirectory write SetDirectory;
property Filter: String read GetFilter write SetFilter;
property Timeout: Integer read GetTimeout write SetTimeout;
property OnResult: TSearchResultEvent read FOnResult write FOnResult;
property OnStart: TSearchEvent read FOnStart write FOnStart;
property OnStop: TSearchEvent read FOnStop write FOnStop;
end;
implementation
{ TSearcher }
constructor TSearcher.Create(AOwner: TComponent);
begin
inherited;
FThread:= TSearcherThread.Create;
FThread.OnResult:= ThreadResult;
FThread.OnStart:= ThreadStart;
FThread.OnStop:= ThreadStop;
end;
destructor TSearcher.Destroy;
begin
Stop;
FThread.Free;
inherited;
end;
function TSearcher.GetDirectory: String;
begin
Result:= FThread.Directory;
end;
function TSearcher.GetFilter: String;
begin
Result:= FThread.Filter;
end;
function TSearcher.GetTimeout: Integer;
begin
Result:= FThread.Timeout;
end;
procedure TSearcher.SetDirectory(const Value: String);
begin
FThread.Directory := Value;
end;
procedure TSearcher.SetFilter(const Value: String);
begin
FThread.Filter := Value;
end;
procedure TSearcher.SetTimeout(const Value: Integer);
begin
FThread.Timeout:= Value;
end;
procedure TSearcher.Start;
begin
FThread.Start;
end;
procedure TSearcher.Stop;
begin
FThread.Stop;
end;
procedure TSearcher.ThreadResult(Sender: TSearcherThread;
const Filename: String);
begin
if Assigned(FOnResult) then
FOnResult(Sender, Filename);
end;
procedure TSearcher.ThreadStart(Sender: TSearcherThread);
begin
if Assigned(FOnStart) then
FOnStart(Sender);
end;
procedure TSearcher.ThreadStop(Sender: TSearcherThread);
begin
if Assigned(FOnStop) then
FOnStop(Sender);
end;
{ TSearcherThread }
constructor TSearcherThread.Create;
begin
inherited Create(True);
try
InitializeCriticalSection(FLock);
FDirectory:= '';
FFilter:= '';
FTimeout:= 120;
finally
Resume;
end;
end;
destructor TSearcherThread.Destroy;
begin
DeleteCriticalSection(FLock);
inherited;
end;
procedure TSearcherThread.DoResult(const AFilename: String);
begin
FSYNC_Filename:= AFilename;
Synchronize(SYNC_OnResult);
end;
procedure TSearcherThread.SYNC_OnResult;
begin
EnterCriticalSection(FLock);
if Assigned(FOnResult) then
FOnResult(Self, FSYNC_Filename);
LeaveCriticalSection(FLock);
end;
function TSearcherThread.CheckTimeout: Boolean;
begin
EnterCriticalSection(FLock);
Result:= (FActive) and (not Terminated);
if Result then begin
if FTimeout > 0 then begin
Result:= GetTickCount < FStartTick + (FTimeout * 1000);
end;
end;
LeaveCriticalSection(FLock);
end;
procedure TSearcherThread.FileSearch(const PathName: string; const Extensions: string);
const
FileMask = '*.*';
var
Rec: TSearchRec;
Path: string;
begin
Path := IncludeTrailingBackslash(PathName);
if FindFirst(Path + FileMask, faAnyFile - faDirectory, Rec) = 0 then
try
repeat
if not CheckTimeout then Break;
if Extensions <> '' then begin
if AnsiPos(ExtractFileExt(Rec.Name), Extensions) > 0 then begin
DoResult(Path + Rec.Name);
end;
end else begin
DoResult(Path + Rec.Name);
end;
until FindNext(Rec) <> 0;
finally
SysUtils.FindClose(Rec);
end;
if FindFirst(Path + '*.*', faDirectory, Rec) = 0 then
try
repeat
if not CheckTimeout then Break;
if ((Rec.Attr and faDirectory) <> 0) and (Rec.Name <> '.') and
(Rec.Name <> '..') then
FileSearch(Path + Rec.Name, Extensions);
until FindNext(Rec) <> 0;
finally
FindClose(Rec);
end;
end;
procedure TSearcherThread.Execute;
begin
while not Terminated do begin
if FActive then begin
try
if DirectoryExists(FDirectory) then begin //Sanity check
FStartTick:= GetTickCount;
FileSearch(FDirectory, FFilter);
end;
except
on e: exception do begin
end;
end;
Stop;
end;
Sleep(1);
end;
end;
function TSearcherThread.GetDirectory: String;
begin
EnterCriticalSection(FLock);
Result:= FDirectory;
LeaveCriticalSection(FLock);
end;
function TSearcherThread.GetFilter: String;
begin
EnterCriticalSection(FLock);
Result:= FFilter;
LeaveCriticalSection(FLock);
end;
function TSearcherThread.GetTimeout: Integer;
begin
EnterCriticalSection(FLock);
Result:= FTimeout;
LeaveCriticalSection(FLock);
end;
procedure TSearcherThread.SetDirectory(const Value: String);
begin
EnterCriticalSection(FLock);
if not FActive then
FDirectory:= Value;
LeaveCriticalSection(FLock);
end;
procedure TSearcherThread.SetFilter(const Value: String);
begin
EnterCriticalSection(FLock);
if not FActive then
FFilter:= Value;
LeaveCriticalSection(FLock);
end;
procedure TSearcherThread.SetTimeout(const Value: Integer);
begin
EnterCriticalSection(FLock);
FTimeout:= Value;
LeaveCriticalSection(FLock);
end;
procedure TSearcherThread.Start;
begin
EnterCriticalSection(FLock);
FActive:= True;
if Assigned(FOnStart) then
FOnStart(Self);
LeaveCriticalSection(FLock);
end;
procedure TSearcherThread.Stop;
begin
EnterCriticalSection(FLock);
if FActive then begin
if Assigned(FOnStop) then
FOnStop(Self);
FActive:= False;
end;
LeaveCriticalSection(FLock);
end;
end.
