Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations TouchToneTommy on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How do I search for files in Delphi?

File Storage

How do I search for files in Delphi?

by  djjd47130  Posted    (Edited  )
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.

Register to add this FAQ to your archive
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top