Solved

Problems with FindFileInTree!!!

Posted on 1998-06-17
3
330 Views
Last Modified: 2012-05-04
I am looking for a syntax example of FindFileInTree...
Example:

I may want to find out if a certain file, say  "Test.txt" is existing in a tree where the I select the "Main"-directory. If the file exists in more than one place( withing the tree), I would like to find all the paths for the file "Test.txt"....

Is this possible?
I run Delphi Developer 2.0...

Thanx!
/Erik N
0
Comment
Question by:Erik N
  • 2
3 Comments
 
LVL 3

Accepted Solution

by:
vladika earned 200 total points
ID: 1353383
Try

function FindFileInTree(Dir: string; FileName: string; FoundFiles: TStrings): Integer;

  function AddSlash(S: string): string;
  var L: Integer;
  begin
    Result := S;
    L := Length(Result);
    if (L > 0) and (Result[L] <> '\') then Result := Result + '\';
  end;

  procedure InternalFind(SubDir: string);
  var SearchRec: TSearchRec;
      Found: Integer;
      FoundSubDir, FoundFileName: string;
  begin
   // scan all dir
    SubDir := AddSlash(SubDir);
    Found := FindFirst(SubDir+'*.*', faDirectory, SearchRec);
    while Found = 0 do
    begin
      FoundSubDir := SearchRec.Name;
      if ((SearchRec.Attr and faDirectory) <> 0) and
        (FoundSubDir <> '.') and (FoundSubDir <> '..')
      then
        InternalFind(SubDir+FoundSubDir);
      Found := FindNext(SearchRec);
    end;
    FindClose(SearchRec);

   // scan current dir
    Found := FindFirst(SubDir+FileName, faAnyFile, SearchRec);
    while Found = 0 do
    begin
      FoundFileName := SearchRec.Name;
      if (FoundFileName <> '.') and (FoundFileName <> '..') then
        // add found files to stringlist
        FoundFiles.Add(SubDir+FoundFileName);
      Found := FindNext(SearchRec);
    end;
    FindClose(SearchRec);
  end;

begin
  FoundFiles.Clear;
  InternalFind(Dir);
  Result := FoundFiles.Count;
end;


How to use:

procedure TForm1.Button1Click(Sender: TObject);
var S: TStrings;
begin
  S := TStringList.Create;
  try
    FindInTree('c:\test', 'test.txt', S); // search test.txt in dir c:\test
// ....... Your code
//  for example
//  Memo.Lines := S;
  finally
    S.Free;
  end;
end;

0
 
LVL 10

Expert Comment

by:Jacco
ID: 1353384
I have worked out an example. It shows how to use recursion to search the directory tree. And it shows how to implement a TThread object to take care of the searching:

The most important method is TFindFile.FindFile:

It first searches for files mathing the search.
The searches all directories and recurses to itself.

This is the unit for the TThread object TFindFile

*** begin of code ***
unit Unit2;

interface

uses
  Classes,StdCtrls,SysUtils;

type
  TFindFile = class(TThread)
  private
    { Private declarations }
    procedure FindFile(const AStartDir : String; const ASearchString : String; AMemo : TMemo);
    procedure ShowFound;
    procedure ShowDir;
  protected
    procedure Execute; override;
  public
    FStartDir : String;
    FSearchString : String;
    FMemo : TMemo;
    FFound : String;
    FLabel : TLabel;
    FPath : String;
  end;

implementation

procedure TFindFile.ShowFound;
begin
  FMemo.Lines.Add(FFound);
end;

procedure TFindFile.ShowDir;
begin
  FLabel.Caption:=FPath;
end;
procedure TFindFile.FindFile(const AStartDir : String; const ASearchString : String; AMemo : TMemo);
var
  sr : TSearchRec;
  r : Integer;
begin
  r:=FindFirst(AStartDir+ASearchString,faAnyFile,sr);
  while r = 0 do begin
    FFound:=AStartDir+sr.Name;
    Synchronize(ShowFound);
    r := FindNext(sr);
  end;
  FindClose(sr);
  r:=FindFirst(AStartDir+'*',faAnyFile,sr);
  while r = 0 do begin
    if (sr.Attr and faDirectory <> 0) and (sr.Name<>'.') and (sr.Name<>'..') then begin
      FPath:=AStartDir+sr.Name+'\';
      Synchronize(ShowDir);
      FindFile(AStartDir+sr.Name+'\',ASearchString,AMemo);
    end;
    r:=FindNext(sr);
  end;
  FindClose(sr);
end;

procedure TFindFile.Execute;
begin
  FindFile(FStartDir,FSearchString,FMemo);
end;

end.
*** end of code ***

To show how to use the TTheard ovbject TFind file here is an example form unit:

*** begin of code ***
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    btnSearch: TButton;
    mmResult: TMemo;
    Label1: TLabel;
    btnStop: TButton;
    edStartDir: TEdit;
    edSearchString: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    procedure btnSearchClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
  private
    { Private declarations }
    ff : TFindFile;
    procedure SearchFile(
      const StartDir : String;
      const SearchString : String;
      AMemo : TMemo;
      ALabel : TLabel   );
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.SearchFile(const StartDir : String; const SearchString : String; AMemo : TMemo; ALabel : TLabel);
begin
  ff:=TFindFile.Create(True);
  with ff do begin
    FStartDir := StartDir;
    FSearchString := SearchString;
    FMemo := AMemo;
    FLabel:=ALabel;
    btnSearch.Enabled:=False;
    btnStop.Enabled:=True;
    Suspended:=False;
  end;
end;

procedure TForm1.btnSearchClick(Sender: TObject);
begin
  mmResult.Lines.Clear;
  SearchFile(edStartDir.Text,edSearchString.Text,mmResult,Label1);
end;

procedure TForm1.btnStopClick(Sender: TObject);
begin
  ff.Suspend;
  ff.Free;
  btnStop.Enabled := False;
  btnSearch.Enabled := True;
end;

end.
*** end of code ***

The form file of this unit is the following:

*** begin of code ***
object Form1: TForm1
  Left = 209
  Top = 126
  Width = 530
  Height = 300
  Caption = 'Form1'
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 8
    Top = 104
    Width = 417
    Height = 13
    AutoSize = False
    Caption = 'Label1'
  end
  object Label2: TLabel
    Left = 8
    Top = 160
    Width = 33
    Height = 13
    Caption = 'Startdir'
  end
  object Label3: TLabel
    Left = 8
    Top = 184
    Width = 32
    Height = 13
    Caption = 'Label3'
  end
  object btnSearch: TButton
    Left = 8
    Top = 128
    Width = 75
    Height = 25
    Caption = 'Search'
    TabOrder = 0
    OnClick = btnSearchClick
  end
  object mmResult: TMemo
    Left = 8
    Top = 8
    Width = 417
    Height = 89
    Lines.Strings = (
      'mmResult')
    TabOrder = 1
  end
  object btnStop: TButton
    Left = 88
    Top = 128
    Width = 75
    Height = 25
    Caption = 'Stop'
    Enabled = False
    TabOrder = 2
    OnClick = btnStopClick
  end
  object edStartDir: TEdit
    Left = 104
    Top = 160
    Width = 225
    Height = 21
    TabOrder = 3
    Text = 'C:\'
  end
  object edSearchString: TEdit
    Left = 104
    Top = 184
    Width = 225
    Height = 21
    TabOrder = 4
    Text = '*.Txt'
  end
end
*** end of code ***

Hope this answered your question

Regards Jacco
0
 
LVL 10

Expert Comment

by:Jacco
ID: 1353385
vladika: just too late :)

Mine implements it in a thread, but the search is the same.
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Windows Drag & Drop Location 2 94
Delphi 10 Seattle Dataset Actions 5 79
Send message from delphi to whatsapp, is it possible? 3 1,193
When i run adoquery my application freezes 26 152
This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
This Micro Tutorial will teach you how to censor certain areas of your screen. The example in this video will show a little boy's face being blurred. This will be demonstrated using Adobe Premiere Pro CS6.
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, just open a new email message. In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…

863 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

25 Experts available now in Live!

Get 1:1 Help Now