source: DockManagement/FindFile.pas

Last change on this file was 5, checked in by chronos, 12 years ago
File size: 3.4 KB
Line 
1{TFindFile
2
3Article:
4http://delphi.about.com/library/weekly/aa052300a.htm
5
6Tired of using FindFirst, Next and Close?
7Come see how to encapsulate all those functions
8in a single "find-files-recursively" component.
9It's easy to use, free and with code.
10
11
12********************************************
13Zarko Gajic
14About.com Guide to Delphi Programming
15http://delphi.about.com
16email: delphi.guide@about.com
17********************************************
18
19}
20
21unit FindFile;
22
23interface
24
25{$WARN UNIT_PLATFORM OFF}
26{$WARN SYMBOL_PLATFORM OFF}
27{$WARN SYMBOL_DEPRECATED OFF}
28uses
29 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, FileCtrl;
30
31type
32 TFileAttrKind = (ffaReadOnly, ffaHidden, ffaSysFile, ffaVolumeID, ffaDirectory, ffaArchive, ffaAnyFile);
33 TFileAttr = set of TFileAttrKind;
34
35 TFindFile = class(TComponent)
36 private
37 s : TStringList;
38
39 fSubFolder : boolean;
40 fAttr: TFileAttr;
41 fPath : string;
42 fFileMask : string;
43
44 procedure SetPath(Value: string);
45 procedure FileSearch(const inPath : string);
46 public
47 constructor Create(AOwner: TComponent); override;
48 destructor Destroy; override;
49
50 function SearchForFiles: TStringList;
51 published
52 property FileAttr: TFileAttr read fAttr write fAttr;
53 property InSubFolders : boolean read fSubFolder write fSubFolder;
54 property Path : string read fPath write SetPath;
55 property FileMask : string read fFileMask write fFileMask ;
56 end;
57
58procedure Register;
59
60implementation
61
62procedure Register;
63begin
64 RegisterComponents('Samples', [TFindFile]);
65end;
66
67constructor TFindFile.Create(AOwner: TComponent);
68begin
69 inherited Create(AOwner);
70 Path := IncludeTrailingBackslash(GetCurrentDir);
71 FileMask := '*.*';
72 FileAttr := [ffaAnyFile];
73 s := TStringList.Create;
74end;
75
76destructor TFindFile.Destroy;
77begin
78 s.Free;
79 inherited Destroy;
80end;
81
82procedure TFindFile.SetPath(Value: string);
83begin
84 if fPath <> Value then
85 begin
86 if Value <> '' then
87 if DirectoryExists(Value) then
88 fPath := IncludeTrailingBackslash(Value);
89 end;
90end;
91
92function TFindFile.SearchForFiles: TStringList;
93begin
94 s.Clear;
95 try
96 FileSearch(Path);
97 finally
98 Result := s;
99 end;
100end;
101
102procedure TFindFile.FileSearch(const InPath : string);
103var Rec : TSearchRec;
104 Attr : integer;
105begin
106 Attr := 0;
107 if ffaReadOnly in FileAttr then Attr := Attr + faReadOnly;
108 if ffaHidden in FileAttr then Attr := Attr + faHidden;
109 if ffaSysFile in FileAttr then Attr := Attr + faSysFile;
110 if ffaVolumeID in FileAttr then Attr := Attr + faVolumeID;
111 if ffaDirectory in FileAttr then Attr := Attr + faDirectory;
112 if ffaArchive in FileAttr then Attr := Attr + faArchive;
113 if ffaAnyFile in FileAttr then Attr := Attr + faAnyFile;
114
115 if SysUtils.FindFirst(inPath + FileMask, Attr, Rec) = 0 then
116 try
117 repeat
118 s.Add(inPath + Rec.Name);
119 until SysUtils.FindNext(Rec) <> 0;
120 finally
121 SysUtils.FindClose(Rec);
122 end;
123
124 If not InSubFolders then Exit;
125
126 if SysUtils.FindFirst(inPath + '*.*', faDirectory, Rec) = 0 then
127 try
128 repeat
129 if ((Rec.Attr and faDirectory) > 0) and (Rec.Name<>'.') and (Rec.Name<>'..') then
130 begin
131 FileSearch(IncludeTrailingBackslash(inPath + Rec.Name));
132 end;
133 until SysUtils.FindNext(Rec) <> 0;
134 finally
135 SysUtils.FindClose(Rec);
136 end;
137end;
138
139end.
140
Note: See TracBrowser for help on using the repository browser.