mxFiles - Event basierte datei-suche

maximus · Beiträge: 896 Win XP, Suse 8.1 Delphi 4/7/8 alles prof

Hallo welt.

Heute gibs von mir eine unit zum event-basierten dateisuchen, in ganzen bäumen oder in einzelnen verzeichnissen! Im wesentlichen ist es eine kapselung der FindFirst und FindNext funktionen mit rekursion.

mxFiles:
Die folgenden funktionen und typen werden von der unit exportiert:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:

type 
  TFileAttribs = set of (faReadOnly,faHidden,faSysFile,faVolumeID,faDirectory,faArchive,faAnyFile);
  TFileFoundEvent = procedure(const fileName, Path: string; const SearchRec: TSearchRec; var goOn:boolean) of object;

function getFilesInDir(dirAndMask:string; OnFileFound:TFileFoundEvent ; fileAttribs:TFileAttribs):Integer;
function getDirTreeFiles(dirAndMask:string; OnFileFound:TFileFoundEvent ; fileAttribs:TFileAttribs; levels:integer = -1):cardinal;

Die benutzung ist sehr einfach, deshalb kann man schon mit wenigen befehlen die gesammte platte durchsuchen. Beim aufruf der getDirTreeFiles funktion wird ein event-handler mit übergeben, welcher dann gerufen wird, sobald eine datei gefunden wurde, die zu den anderen parametern dirAndMask und fileAttribs passt:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:

type
  TForm1 = class(TForm)
    ...
  public
    procedure FileFoundHandler(const fileName, Path: string; const SearchRec: TSearchRec; var goOn:boolean);
  end;

...
implementation
...

uses mxFiles;

procedure TForm1.Button1Click(Sender: TObject);
var n:integer;
begin
  Memo1.Lines.Clear;

  // Der 'levels' parameter gibt an auf wievielen verzeichniss-ebenen gesucht wird
  // bei -1 werden alle durchsucht

  n := getDirTreeFiles('c:\*.txt', FileFoundHandler, [faDirectory, faArchive], 4);  // suche starten

  Memo1.Lines.Add(#13#10 + intToStr(n) + ' items found.');
end;

procedure TForm1.FileFoundHandler(const fileName, Path: string; const SearchRec: TSearchRec; var goOn:boolean);
begin
  // goOn := false; // so könnte man die suche abbrechen

  Memo1.Lines.add(Path + fileName);

end;

Die datei-attribute sind in dem typ TFileAttribs gekapselt, um besseren zugang und konsistenz in delphi zu haben.

Die funktion getFilesInDir ist dass selbe in grün, nur ohne unterverzeichnisse!

Die sourcen eines ausführlichen beispielprogramms findet ihr hier [6kb]! Die unit ist auch mit dabei.

Die unit

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:

{-----------------------------------------------------------------------------
 Unit Name : mxFiles
 Author    : Max hub
 License   : OPEN - WITHOUT WARRANTY.
             Do not remove this header! 
             
             please send fixes, samples, etc.
             mx@eyer-systems.de                                                      
 
 Purpose   : File search!
 History   : 23.11.2003 - version 1.1
-----------------------------------------------------------------------------}  

unit mxFiles;

interface

uses typInfo, windows, SysUtils, types;

{file utils}

type 
  TFileAttribs = set of (faReadOnly,faHidden,faSysFile,faVolumeID,faDirectory,faArchive,faAnyFile);
  TFileFoundEvent = procedure(const fileName, Path: string; const SearchRec: TSearchRec; var goOn:boolean) of object;

function getFilesInDir(dirAndMask:string; OnFileFound:TFileFoundEvent ; fileAttribs:TFileAttribs):Integer;    
function getDirTreeFiles(dirAndMask:string; OnFileFound:TFileFoundEvent ; fileAttribs:TFileAttribs; levels:integer = -1):cardinal;

         
implementation 


{file utils}

function getFilesInDir(dirAndMask:string; OnFileFound:TFileFoundEvent ; fileAttribs:TFileAttribs):Integer;
var SearchRec: TSearchRec;
    goOn:boolean;
    Attr:integer;
    dir:string;
begin
  goOn := true;
  if faAnyFile in fileAttribs 
  then attr := $3F
  else attr := byte(fileAttribs); 
  result := -1;
  dir := ExtractFilePath(dirAndMask);
  if DirectoryExists(dir) then
  begin
    result := 0;
    if FindFirst(dirAndMask, Attr, SearchRec) = 0 then
    try
      repeat
        if ((Attr and SearchRec.Attr) <> 0) and (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
        begin
          inc(result);
          if assigned(OnFileFound) 
          then OnFileFound(SearchRec.Name,dir, SearchRec, goOn);              
        end;            
        if not goOn then break;
      until FindNext(SearchRec) <> 0;
    finally
      FindClose(SearchRec);
    end;
  end;
end;                                   


function getDirTreeFiles(dirAndMask:string; OnFileFound:TFileFoundEvent ; fileAttribs:TFileAttribs; levels:integer = -1):cardinal;
var mask:string;
    attr,level:integer;
    count:cardinal;
    goOn:boolean;    

    procedure findTreeFilesInner(dir:string);
    var SearchRec, dirSearchRec: TSearchRec;
    begin         
      if goOn and (level <> 0) then
      begin
        if FindFirst(dir+Mask, attr, SearchRec) = 0 then
        try          
          repeat // normal search files  
            if ((Attr and SearchRec.Attr) <> 0) and(SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
            begin         
              inc(count);
              if assigned(OnFileFound) then OnFileFound(SearchRec.Name, dir, SearchRec,goOn); 
              if not goOn then break;
            end;  
          until FindNext(SearchRec) <> 0;
        finally
          FindClose(SearchRec);
        end;            
        {---------------------------------------------}
        if FindFirst(dir+'*',$10,dirSearchRec) = 0 then
        try
          repeat // sub dir jumps
            if (($10 and dirSearchRec.Attr) <> 0) and (dirSearchRec.Name <> '.') and (dirSearchRec.Name <> '..') then
            begin
              dec(level);
              findTreeFilesInner(dir+dirSearchRec.Name+PathDelim); // main recursion  
              if not goOn then break;          
              inc(level);
            end;  
          until FindNext(dirSearchRec) <> 0;
          
        finally
          FindClose(dirSearchRec);
        end;
      end;  
    end;

begin
  goOn := true;
  count := 0;
  if faAnyFile in fileAttribs 
  then attr := $3F
  else attr := byte(fileAttribs);  
  mask := ExtractFileName(dirAndMask);
  level := levels;
  findTreeFilesInner(ExtractFilePath(dirAndMask));
  result := count;
end;    

end.

Vorschläge zur optimierung oder erweiterung sind sehr willkommen! Vielleicht hat jemand einen effizienten algorythmus zum suchen in dateien, den ich in die unit mit aufnehmen könnte? Dann wäre die unit nämlich 'komplett'

Viel spass damit und gebt mir feedback

//Edit
Inkonsistenz im parameter-style von getFilesInDir ausgebügelt --> version 1.1

mfg.

_________________
mfg.
mâximôv

lb · Beiträge: 27 Win98, win2000, winxp, linux D5,Kylix

Mit zwei kleinen Aenderungen habe ich das Programm bei mir zum laufen mit Delphi5 zum laufen gebracht:
1. unit types: error message: tupes.doc not found --> fuege zu uses unit FileCtrl hinzu
2. PathDelim: error message: not defined--> Ersetze PathDelim durch '\'

:lol:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:

unit mxFiles;

{-----------------------------------------------------------------------------
Unit Name : mxFiles
Author    : Max hub
License   : OPEN - WITHOUT WARRANTY.
             Do not remove this header!

             please send fixes, samples, etc.
             mx@eyer-systems.de

Purpose   : File search!
History   : 23.11.2003 - version 1.1
review    : Lutz Berger 21.03.04
-----------------------------------------------------------------------------}


interface

uses typInfo, windows, SysUtils, FileCtrl; //lb replaced types with FileCtrl

{file utils}

type  
  TFileAttribs = set of (faReadOnly,faHidden,faSysFile,faVolumeID,faDirectory,faArchive,faAnyFile);
  TFileFoundEvent = procedure(const fileName, Path: string; const SearchRec: TSearchRec; var goOn:boolean) of object;

function getFilesInDir(dirAndMask:string; OnFileFound:TFileFoundEvent ; fileAttribs:TFileAttribs):Integer;
function getDirTreeFiles(dirAndMask:string; OnFileFound:TFileFoundEvent ; fileAttribs:TFileAttribs; levels:integer = -1):cardinal;


implementation


{file utils}

function getFilesInDir(dirAndMask:string; OnFileFound:TFileFoundEvent ; fileAttribs:TFileAttribs):Integer; 
var SearchRec: TSearchRec;
    goOn:boolean; 
    Attr:integer; 
    dir:string;
begin 
  goOn := true; 
  if faAnyFile in fileAttribs  
  then attr := $3F
  else attr := byte(fileAttribs);  
  result := -1; 
  dir := ExtractFilePath(dirAndMask); 
  if DirectoryExists(dir) then
  begin
    result := 0; 
    if FindFirst(dirAndMask, Attr, SearchRec) = 0 then 
    try
      repeat 
        if ((Attr and SearchRec.Attr) <> 0) and (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then 
        begin 
          inc(result);
          if assigned(OnFileFound)  
          then OnFileFound(SearchRec.Name,dir, SearchRec, goOn);               
        end;             
        if not goOn then break;
      until FindNext(SearchRec) <> 0; 
    finally 
      FindClose(SearchRec); 
    end; 
  end;
end;                                    


function getDirTreeFiles(dirAndMask:string; OnFileFound:TFileFoundEvent ; fileAttribs:TFileAttribs; levels:integer = -1):cardinal; 
var mask:string;
    attr,level:integer;
    count:cardinal; 
    goOn:boolean;     

    procedure findTreeFilesInner(dir:string);
    var SearchRec, dirSearchRec: TSearchRec; 
    begin          
      if goOn and (level <> 0) then 
      begin 
        if FindFirst(dir+Mask, attr, SearchRec) = 0 then
        try           
          repeat // normal search files  
            if ((Attr and SearchRec.Attr) <> 0) and(SearchRec.Name <> '.') and (SearchRec.Name <> '..') then 
            begin          
              inc(count);
              if assigned(OnFileFound) then OnFileFound(SearchRec.Name, dir, SearchRec,goOn);  
              if not goOn then break; 
            end;   
          until FindNext(SearchRec) <> 0; 
        finally
          FindClose(SearchRec); 
        end;             
        {---------------------------------------------} 
        if FindFirst(dir+'*',$10,dirSearchRec) = 0 then 
        try
          repeat // sub dir jumps 
            if (($10 and dirSearchRec.Attr) <> 0) and (dirSearchRec.Name <> '.') and (dirSearchRec.Name <> '..') then 
            begin 
              dec(level); 
              findTreeFilesInner(dir+dirSearchRec.Name+'\'); // main recursion
              //lb 'PathDelim' was not defined , replaced with '\' 
              if not goOn then break;
              inc(level); 
            end;   
          until FindNext(dirSearchRec) <> 0;

        finally 
          FindClose(dirSearchRec); 
        end; 
      end;
    end;

begin 
  goOn := true; 
  count := 0;
  if faAnyFile in fileAttribs  
  then attr := $3F 
  else attr := byte(fileAttribs);   
  mask := ExtractFileName(dirAndMask); 
  level := levels;
  findTreeFilesInner(ExtractFilePath(dirAndMask));
  result := count; 
end;     

end.

Moderiert von Peter Lustig: Code- durch Delphi-Tags ersetzt

_________________
Aus dieser hohlen Gasse muss er kommen
Guesse Lutz

maximus · Beiträge: 896 Win XP, Suse 8.1 Delphi 4/7/8 alles prof

Danke für die D5 version!

_________________
mfg.
mâximôv

Yusha · Beiträge: 20

Hallo,

Vielen Dank für deinen Beitrag hier, hat mich im meinem Projekt sehr schnell weiter gebracht. Hier der Quellcode meiner Variante. Ich bin Objektorientiert rangangen und
hab das ganze in einem Thread laufen lassen- Damit die Anwendung nicht blockiert beim Suchen. Den Tree-Search hab ich erstmal rausgelassen, werde den wohl in einer neuen Klasse machen.

Das Konzept:

Im Konstrukter muss man angeben, wer der FileHandler ist. Der FileHandler kann eine beliebige Klasse sein, die das Interface IFileHandler implementiert:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:

unit Interface_1;

interface

uses
  FileCtrl, SysUtils;

type
  IFileHandler = interface
  ['{0FC84939-E2C1-405E-B52C-37BEB2CE8B9F}']

  procedure handleFile(rec:TSearchRec);
  end;

implementation

end.

An die proc handleFile schicke ich dann die Rec's.

Hier nun der Scanner an sich:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:

unit fileScanner;
interface
uses
  typInfo,
  windows,
  dialogs,
  SysUtils,
  FileCtrl,
  Classes,
  Interface_1,
  Types;
type
  TFileAttribs = set of (   faReadOnly,
                            faHidden,
                            faSysFile,
                            faVolumeID,
                            faDirectory,
                            faArchive);
  TFileScanner = class(TThread)

private
  handler:IFileHandler;    // Klasse, die handleFile() implementiert
  SearchRec: TSearchRec;
  goOn:boolean;
  attr:integer;
  dir:string;
  fileCount:Integer;
  dirAndMask:String;

protected
  procedure Execute();override; // Excecute-Fkt von TThread überschreiben

public
  function getFilesInDir  ( dir_AndMask:string;
                            fileAttribs:TFileAttribs
                          ):Integer;
  constructor Create(owner:IFileHandler);
end;

implementation

{----KONSTRUKTOR IMPLEMENTIERUNG------}
constructor TFileScanner.Create(owner:IFileHandler);
  begin
    inherited Create(true);
    Priority:=tpIdle;
    FreeOnTerminate:=true;
    handler:=owner;
  end;

{----THREAD STARTEN---------}
function TFileScanner.getFilesInDir  (  dir_AndMask:string;
                                        fileAttribs:TFileAttribs
                                      ):Integer;
  begin
    dirAndMask:=dir_AndMask;
    Execute();
    result:=fileCount;
  end;//getFilesInDir

{----ÜBERSCHREIBEN TTHREAD::EXECUTE-----}
procedure TFileScanner.Execute();
  begin
    goOn := true;
    attr:=$3F; //Setzen der Dateien, die angezeigt werden
    fileCount := -1;
    dir := ExtractFilePath(dirAndMask);
    if DirectoryExists(dir)
    then
      begin
        fileCount := 0;
        if FindFirst(dirAndMask, Attr, SearchRec) = 0
        then
          try
            repeat
              if (  (Attr and SearchRec.Attr) <> 0)
              and (SearchRec.Name <> '.')
              and (SearchRec.Name <> '..')
              then
                begin
                  inc(fileCount);
                  if assigned(handler)
                    then
                      handler.handleFile(SearchRec)
                    else
                      ShowMessage('no FileHandler!!');
                end;
              if not goOn then break;
            until FindNext(SearchRec) <> 0;
          finally
            FindClose(SearchRec);
          end;
      end;
  end;
end. // CLASS

Dies ist mein allererstes Delhpi-Projekt - seid nachsichtig mit mir.

Yusha · Beiträge: 20

Kann mir jemand sagen, wiso das Trotzdem blockiert ?

maximus · Beiträge: 896 Win XP, Suse 8.1 Delphi 4/7/8 alles prof

Moin Yusha,

schöne idee mit dem thread. Wobei ich mich frage ob es nicht probleme gibt wenn du das event an den hauptThread abschickst, da normalerweise müssen diese beiden threads synchronisiert werden sollten, weil die VCL nicht thread-save ist (hab da selbst nicht viel ahnung - schau dir mal entsprechende thread tuts an).

Yusha hat folgendes geschrieben:

Kann mir jemand sagen, wiso das Trotzdem blockiert ?

KA. Aber bei meiner variante hätte ein einfachen...
application.processMessages;...im event-handler auch ausgereicht um die anwendung nicht einfirieren zu lassen :wink:

...gleich mal testen.

_________________
mfg.
mâximôv

Yusha · Beiträge: 20

Hi,

Ich habe den Algorithmus noch ein wenig getuned und er ist nun noch schneller. Die Suche ist Teil eines grösseren Projektes, daher stell ich statt der ganzen Unit nur den interessanten Teil hier rein.
Es funktioniert so, das der Algorithmus zuerst in die Tiefe geht und alle Knoten auf eine Baum-Datenstruktur abbildet. Für meine Zwecke reicht eine Liste nicht aus. Ob es jetzt schneller ist, hab ich noch nicht gemessen, aber allgemein gilt der DFS als ziemlich fix.

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:

function TSearchEngine.GetFileTree(StartLocation:String):TFileNode;
var
  resultNode,tempNode:TFileNode;
  mask:String;
  attr:Integer;

  procedure FindInner(parent:TFileNode);
  var
    SearchRec:TSearchRec;
  begin
    if (FindFirst(parent.AbsolutePath+mask,attr,SearchRec) = 0)then//file found
      begin
      try
      repeat
        if ((attr AND SearchRec.Attr)<> 0)
        and(SearchRec.Name <> '.')
        and(SearchRec.Name <> '..') then
          if (faDirectory AND SearchRec.Attr) <> 0 then
            begin
            {Falls Verzeichniss gefunden.}
            tempNode:=TFileNode.Create(parent.AbsolutePath+SearchRec.Name+'\',SearchRec);
            parent.AddChild(tempNode); // add node to tree
            FileEventListener(true);//handle FileFoundEvent (dir = true)
            FindInner(tempNode); //recursion
            end
          else
            begin
            {Falls Datei gefunden.}
            tempNode:=TFileNode.Create(parent.AbsolutePath+SearchRec.Name,SearchRec);
            parent.AddChild(tempNode); // add leaf to tree
            FileEventListener(false);
            end;
      until FindNext(SearchRec) <> 0;
      finally FindClose(SearchRec);
      end;//try
    end;//end if file found
  end;

begin
  resultNode:=TFileNode.Create(StartLocation);
  mask:='*.*';
  attr:=faAnyFile;
  StateListener(self,ST_READ);
  FindInner(resultNode);
  StateListener(self,ST_IDLE);
  result:=resultNode;
end;

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme