Solved

Problems with FindFileInTree!!!

Posted on 1998-06-17
3
337 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

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
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…
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …
Attackers love to prey on accounts that have privileges. Reducing privileged accounts and protecting privileged accounts therefore is paramount. Users, groups, and service accounts need to be protected to help protect the entire Active Directory …

685 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