Autor |
Beitrag |
maximus
Beiträge: 896
Win XP, Suse 8.1
Delphi 4/7/8 alles prof
|
Verfasst: So 23.11.03 14:16
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:
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:
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;
n := getDirTreeFiles('c:\*.txt', FileFoundHandler, [faDirectory, faArchive], 4); Memo1.Lines.Add(#13#10 + intToStr(n) + ' items found.'); end;
procedure TForm1.FileFoundHandler(const fileName, Path: string; const SearchRec: TSearchRec; var goOn:boolean); begin 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
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 mxFiles;
interface
uses typInfo, windows, SysUtils, types;
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
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 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 if (($10 and dirSearchRec.Attr) <> 0) and (dirSearchRec.Name <> '.') and (dirSearchRec.Name <> '..') then begin dec(level); findTreeFilesInner(dir+dirSearchRec.Name+PathDelim); 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
|
Verfasst: So 21.03.04 10:10
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 '\'
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;
interface
uses typInfo, windows, SysUtils, FileCtrl;
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
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 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 if (($10 and dirSearchRec.Attr) <> 0) and (dirSearchRec.Name <> '.') and (dirSearchRec.Name <> '..') then begin dec(level); findTreeFilesInner(dir+dirSearchRec.Name+'\'); 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
|
Verfasst: So 21.03.04 14:51
Danke für die D5 version!
_________________ mfg.
mâximôv
|
|
Yusha
Beiträge: 20
|
Verfasst: Mo 23.08.04 16:14
Titel: Filesuche mittels Thread in Delphi7
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:
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:
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; SearchRec: TSearchRec; goOn:boolean; attr:integer; dir:string; fileCount:Integer; dirAndMask:String;
protected procedure Execute();override; public function getFilesInDir ( dir_AndMask:string; fileAttribs:TFileAttribs ):Integer; constructor Create(owner:IFileHandler); end;
implementation
constructor TFileScanner.Create(owner:IFileHandler); begin inherited Create(true); Priority:=tpIdle; FreeOnTerminate:=true; handler:=owner; end;
function TFileScanner.getFilesInDir ( dir_AndMask:string; fileAttribs:TFileAttribs ):Integer; begin dirAndMask:=dir_AndMask; Execute(); result:=fileCount; end;
procedure TFileScanner.Execute(); begin goOn := true; attr:=$3F; 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. |
Dies ist mein allererstes Delhpi-Projekt - seid nachsichtig mit mir.
|
|
Yusha
Beiträge: 20
|
Verfasst: Mo 23.08.04 17:22
Titel: Blockiert aber trotzdem...
Kann mir jemand sagen, wiso das Trotzdem blockiert ?
|
|
maximus
Beiträge: 896
Win XP, Suse 8.1
Delphi 4/7/8 alles prof
|
Verfasst: Di 24.08.04 14:28
Titel: Re: Blockiert aber trotzdem...
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
...gleich mal testen.
_________________ mfg.
mâximôv
|
|
Yusha
Beiträge: 20
|
Verfasst: Fr 17.09.04 10:01
Titel: Dateisuche mittels Depth First Search Algorithmus
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.
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 begin try repeat if ((attr AND SearchRec.Attr)<> 0) and(SearchRec.Name <> '.') and(SearchRec.Name <> '..') then if (faDirectory AND SearchRec.Attr) <> 0 then begin tempNode:=TFileNode.Create(parent.AbsolutePath+SearchRec.Name+'\',SearchRec); parent.AddChild(tempNode); FileEventListener(true); FindInner(tempNode); end else begin tempNode:=TFileNode.Create(parent.AbsolutePath+SearchRec.Name,SearchRec); parent.AddChild(tempNode); FileEventListener(false); end; until FindNext(SearchRec) <> 0; finally FindClose(SearchRec); end; end; end;
begin resultNode:=TFileNode.Create(StartLocation); mask:='*.*'; attr:=faAnyFile; StateListener(self,ST_READ); FindInner(resultNode); StateListener(self,ST_IDLE); result:=resultNode; end; |
|
|
|