source: trunk/Packages/Common/FindFile.pas

Last change on this file was 75, checked in by chronos, 6 months ago
  • Modified: Removed U prefix from unit names.
  • Modified: Updated Common package.
File size: 3.6 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
25uses
26 SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
27
28type
29 EDirNotFound = class(Exception);
30
31 TFileAttrKind = (ffaReadOnly, ffaHidden, ffaSysFile, ffaVolumeID, ffaDirectory, ffaArchive, ffaAnyFile);
32 TFileAttrib = set of TFileAttrKind;
33
34 TFindFile = class(TComponent)
35 private
36 s : TStringList;
37 fSubFolder : boolean;
38 fAttr: TFileAttrib;
39 fPath : string;
40 fFileMask : string;
41 procedure SetPath(Value: string);
42 procedure FileSearch(const inPath : string);
43 public
44 constructor Create(AOwner: TComponent); override;
45 destructor Destroy; override;
46 function SearchForFiles: TStringList;
47 published
48 property FileAttr: TFileAttrib read fAttr write fAttr;
49 property InSubFolders : boolean read fSubFolder write fSubFolder;
50 property Path : string read fPath write SetPath;
51 property FileMask : string read fFileMask write fFileMask ;
52 end;
53
54const
55{$IFDEF WINDOWS}
56 FilterAll = '*.*';
57{$ENDIF}
58{$IFDEF UNIX}
59 FilterAll = '*';
60{$ENDIF}
61
62procedure Register;
63
64
65implementation
66
67resourcestring
68 SDirNotFound = 'Directory not found';
69
70procedure Register;
71begin
72 RegisterComponents('Common', [TFindFile]);
73end;
74
75constructor TFindFile.Create(AOwner: TComponent);
76begin
77 inherited Create(AOwner);
78 Path := IncludeTrailingBackslash(UTF8Encode(GetCurrentDir));
79 FileMask := FilterAll;
80 FileAttr := [ffaAnyFile];
81 s := TStringList.Create;
82end;
83
84destructor TFindFile.Destroy;
85begin
86 s.Free;
87 inherited;
88end;
89
90procedure TFindFile.SetPath(Value: string);
91begin
92 if fPath <> Value then
93 begin
94 if Value <> '' then
95 if DirectoryExists(UTF8Decode(Value)) then
96 fPath := IncludeTrailingBackslash(Value)
97 else raise EDirNotFound.Create(SDirNotFound);
98 end;
99end;
100
101function TFindFile.SearchForFiles: TStringList;
102begin
103 s.Clear;
104 try
105 FileSearch(Path);
106 finally
107 Result := s;
108 end;
109end;
110
111procedure TFindFile.FileSearch(const InPath : string);
112var Rec : TSearchRec;
113 Attr : integer;
114begin
115 Attr := 0;
116 if ffaReadOnly in FileAttr then Attr := Attr + faReadOnly;
117 if ffaHidden in FileAttr then Attr := Attr + 2; //faHidden; use constant to avoid platform warning
118 if ffaSysFile in FileAttr then Attr := Attr + 4; //faSysFile; use constant to avoid platform warning
119 // Deprecated: if ffaVolumeID in FileAttr then Attr := Attr + faVolumeID;
120 if ffaDirectory in FileAttr then Attr := Attr + faDirectory;
121 if ffaArchive in FileAttr then Attr := Attr + faArchive;
122 if ffaAnyFile in FileAttr then Attr := Attr + faAnyFile;
123
124 if SysUtils.FindFirst(inPath + FileMask, Attr, Rec) = 0 then
125 try
126 repeat
127 s.Add(inPath + Rec.Name);
128 until SysUtils.FindNext(Rec) <> 0;
129 finally
130 SysUtils.FindClose(Rec);
131 end;
132
133 If not InSubFolders then Exit;
134
135 if SysUtils.FindFirst(inPath + FilterAll, faDirectory, Rec) = 0 then
136 try
137 repeat
138 if ((Rec.Attr and faDirectory) > 0) and (Rec.Name <> '.')
139 and (Rec.Name <> '..') then
140 FileSearch(IncludeTrailingBackslash(inPath + Rec.Name));
141 until SysUtils.FindNext(Rec) <> 0;
142 finally
143 SysUtils.FindClose(Rec);
144 end;
145end;
146
147end.
Note: See TracBrowser for help on using the repository browser.