source: trunk/Packages/Common/UFindFile.pas

Last change on this file was 2, checked in by chronos, 9 years ago
  • Added: TPakFile class for extraction PAK files from original game.
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('Common', [TFindFile]);
67end;
68
69constructor TFindFile.Create(AOwner: TComponent);
70begin
71 inherited Create(AOwner);
72 Path := IncludeTrailingBackslash(UTF8Encode(GetCurrentDir));
73 FileMask := '*.*';
74 FileAttr := [ffaAnyFile];
75 fSubFolder := False;
76 s := TStringList.Create;
77end;
78
79destructor TFindFile.Destroy;
80begin
81 s.Free;
82 inherited Destroy;
83end;
84
85procedure TFindFile.SetPath(Value: string);
86begin
87 if fPath <> Value then
88 begin
89 if Value <> '' then
90 if DirectoryExists(UTF8Decode(Value)) then
91 fPath := IncludeTrailingBackslash(Value)
92 else raise EDirNotFound.Create(SDirNotFound);
93 end;
94end;
95
96function TFindFile.SearchForFiles: TStringList;
97begin
98 s.Clear;
99 try
100 FileSearch(Path);
101 finally
102 Result := s;
103 end;
104end;
105
106procedure TFindFile.FileSearch(const InPath : string);
107var Rec : TSearchRec;
108 Attr : integer;
109begin
110 Attr := 0;
111 if ffaReadOnly in FileAttr then Attr := Attr + faReadOnly;
112 if ffaHidden in FileAttr then Attr := Attr + faHidden;
113 if ffaSysFile in FileAttr then Attr := Attr + faSysFile;
114 if ffaVolumeID in FileAttr then Attr := Attr + faVolumeID;
115 if ffaDirectory in FileAttr then Attr := Attr + faDirectory;
116 if ffaArchive in FileAttr then Attr := Attr + faArchive;
117 if ffaAnyFile in FileAttr then Attr := Attr + faAnyFile;
118
119 if SysUtils.FindFirst(UTF8Decode(inPath + FileMask), Attr, Rec) = 0 then
120 try
121 repeat
122 s.Add(inPath + UTF8Encode(Rec.Name));
123 until SysUtils.FindNext(Rec) <> 0;
124 finally
125 SysUtils.FindClose(Rec);
126 end;
127
128 If not InSubFolders then Exit;
129
130 if SysUtils.FindFirst(UTF8Decode(inPath + '*.*'), faDirectory, Rec) = 0 then
131 try
132 repeat
133 if ((Rec.Attr and faDirectory) > 0) and (Rec.Name <> '.')
134 and (Rec.Name <> '..') then
135 FileSearch(IncludeTrailingBackslash(inPath + UTF8Encode(Rec.Name)));
136 until SysUtils.FindNext(Rec) <> 0;
137 finally
138 SysUtils.FindClose(Rec);
139 end;
140end;
141
142end.
143
Note: See TracBrowser for help on using the repository browser.