source: FileSystem/UFindFile.pas

Last change on this file was 93, checked in by george, 13 years ago
  • Moved: File handling related units moved to FileSystem directory.
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 UFindFile;
22
23interface
24
25uses
26 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, FileCtrl;
27
28type
29 EDirNotFound = class(Exception);
30
31 TFileAttrKind = (ffaReadOnly, ffaHidden, ffaSysFile, ffaVolumeID, ffaDirectory, ffaArchive, ffaAnyFile);
32 TFileAttr = set of TFileAttrKind;
33
34 TFindFile = class(TComponent)
35 private
36 s : TStringList;
37
38 fSubFolder : boolean;
39 fAttr: TFileAttr;
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: TFileAttr 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
57procedure Register;
58
59implementation
60
61procedure Register;
62begin
63 RegisterComponents('Samples', [TFindFile]);
64end;
65
66constructor TFindFile.Create(AOwner: TComponent);
67begin
68 inherited Create(AOwner);
69 Path := IncludeTrailingBackslash(GetCurrentDir);
70 FileMask := '*.*';
71 FileAttr := [ffaAnyFile];
72 s := TStringList.Create;
73end;
74
75destructor TFindFile.Destroy;
76begin
77 s.Free;
78 inherited Destroy;
79end;
80
81procedure TFindFile.SetPath(Value: string);
82begin
83 if fPath <> Value then
84 begin
85 if Value <> '' then
86 if DirectoryExists(UTF8Decode(Value)) then
87 fPath := IncludeTrailingBackslash(Value)
88 else raise EDirNotFound.Create('Adresář nenalezen');
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(UTF8Decode(inPath + FileMask), Attr, Rec) = 0 then
116 try
117 repeat
118 s.Add(inPath + UTF8Encode(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(UTF8Decode(inPath + '*.*'), faDirectory, Rec) = 0 then
127 try
128 repeat
129 if ((Rec.Attr and faDirectory) > 0) and (Rec.Name <> '.')
130 and (Rec.Name <> '..') then
131 FileSearch(IncludeTrailingBackslash(inPath + UTF8Encode(Rec.Name)));
132 until SysUtils.FindNext(Rec) <> 0;
133 finally
134 SysUtils.FindClose(Rec);
135 end;
136end;
137
138end.
139
Note: See TracBrowser for help on using the repository browser.