source: branches/generator/Packages/Common/UFindFile.pas

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