source: trunk/Packages/Common/UFindFile.pas

Last change on this file was 6, checked in by chronos, 11 years ago
  • Přidáno: Okno s nastavením parametrů komunikace.
  • Přidáno: Pamatování si nastavení voleb.
  • Přidáno: Nyní lze stahovat nové operace, výpis dle časového rozmezí a měsíční výpisy.
File size: 3.5 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, FileCtrl;
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
57procedure Register;
58
59implementation
60
61resourcestring
62 SDirNotFound = 'Directory not found';
63
64procedure Register;
65begin
66 RegisterComponents('Samples', [TFindFile]);
67end;
68
69constructor TFindFile.Create(AOwner: TComponent);
70begin
71 inherited Create(AOwner);
72 Path := IncludeTrailingBackslash(UTF8Encode(GetCurrentDir));
73 FileMask := '*.*';
74 FileAttr := [ffaAnyFile];
75 s := TStringList.Create;
76end;
77
78destructor TFindFile.Destroy;
79begin
80 s.Free;
81 inherited Destroy;
82end;
83
84procedure TFindFile.SetPath(Value: string);
85begin
86 if fPath <> Value then
87 begin
88 if Value <> '' then
89 if DirectoryExists(UTF8Decode(Value)) then
90 fPath := IncludeTrailingBackslash(Value)
91 else raise EDirNotFound.Create(SDirNotFound);
92 end;
93end;
94
95function TFindFile.SearchForFiles: TStringList;
96begin
97 s.Clear;
98 try
99 FileSearch(Path);
100 finally
101 Result := s;
102 end;
103end;
104
105procedure TFindFile.FileSearch(const InPath : string);
106var Rec : TSearchRec;
107 Attr : integer;
108begin
109 Attr := 0;
110 if ffaReadOnly in FileAttr then Attr := Attr + faReadOnly;
111 if ffaHidden in FileAttr then Attr := Attr + faHidden;
112 if ffaSysFile in FileAttr then Attr := Attr + faSysFile;
113 if ffaVolumeID in FileAttr then Attr := Attr + faVolumeID;
114 if ffaDirectory in FileAttr then Attr := Attr + faDirectory;
115 if ffaArchive in FileAttr then Attr := Attr + faArchive;
116 if ffaAnyFile in FileAttr then Attr := Attr + faAnyFile;
117
118 if SysUtils.FindFirst(UTF8Decode(inPath + FileMask), Attr, Rec) = 0 then
119 try
120 repeat
121 s.Add(inPath + UTF8Encode(Rec.Name));
122 until SysUtils.FindNext(Rec) <> 0;
123 finally
124 SysUtils.FindClose(Rec);
125 end;
126
127 If not InSubFolders then Exit;
128
129 if SysUtils.FindFirst(UTF8Decode(inPath + '*.*'), faDirectory, Rec) = 0 then
130 try
131 repeat
132 if ((Rec.Attr and faDirectory) > 0) and (Rec.Name <> '.')
133 and (Rec.Name <> '..') then
134 FileSearch(IncludeTrailingBackslash(inPath + UTF8Encode(Rec.Name)));
135 until SysUtils.FindNext(Rec) <> 0;
136 finally
137 SysUtils.FindClose(Rec);
138 end;
139end;
140
141end.
142
Note: See TracBrowser for help on using the repository browser.