Module
Path
C:\PROJEKT\PSearch\PsEngine.pas
Last Modified
2007-05-17 15:58:28
Comments
Classes
 TPatternSearcher |
The TPatternSearcher class is the real "engine" in this application.
It quickly searches for strings in many files.
|
Procedures
Types (non-class, non-interface)
Global Variables
 gStopped |
Boolean |
gStopped : boolean;
|
- |
Constants
 sfAll |
sfAll (TSearchedFiles)
|
Interfaced |
Enumerated constants for searhed files |
| sfOnlyDelphi |
sfOnlyDelphi (TSearchedFiles)
|
Interfaced |
- |
| sfOnlyInc |
sfOnlyInc (TSearchedFiles)
|
Interfaced |
Enumerated constants for searhed files |
| sfOnlySql |
sfOnlySql (TSearchedFiles)
|
Interfaced |
Enumerated constants for searhed files |
| sfOnlyTxt |
sfOnlyTxt (TSearchedFiles)
|
Interfaced |
- |
| sfOnlyVB |
sfOnlyVB (TSearchedFiles)
|
Interfaced |
- |
| sfOnlyWeb |
sfOnlyWeb (TSearchedFiles)
|
Interfaced |
Enumerated constants for searhed files |
Module Source
1 unit PsEngine; // declaration of unit
2 // This is the main module containing the search engine
3 // to find text, search in files of these types:
4 // - all
5 // - *.inc
6 // - *.asp *.htm
7 // - *.sql
8 // - *.dfm *.dpk *.dpr *.pas
9 // - *.bas *.cls *.frm *.vbp
10 // - *.txt
11
12 (*$I GDEFINE.INC*)
13
14 interface
15
16 uses
17 Classes, GHtml;
18
19 type
20 // enumerated constants for searhed files
21 TSearchedFiles = (sfAll, sfOnlyInc, sfOnlyWeb, sfOnlySql,
22 sfOnlyDelphi, sfOnlyVB, sfOnlyTxt);
23
24 TSearchedFilesSet = set of TSearchedFiles;
25
26 // The TPatternSearcher class is the real "engine" in this application.
27 // It quickly searches for strings in many files.
28 TPatternSearcher = class
29 private
30 FStartDir : string;
31 FPattern : string;
32 FIncludeSubFolders : boolean;
33 FListAllSearchedFiles : boolean;
34 FCaseSensitive : boolean;
35
36 FSearchedFiles : TSearchedFilesSet;
37
38 FLog : TStrings;
39 FSearchInfo : TList;
40
41 FNumMatches : integer;
42 FNumFilesSearched : integer;
43 FNumFilesMatches : integer;
44
45 FLenPattern : integer;
46
47 FilePaths : TStringList;
48 SL : TStringList;
49
50 FEvaluation : boolean;
51
52 private
53 procedure SearchWithPos(const Path : string); // searches with Pos (intf)
54 procedure SearchWithUC(const Path : string);
55 public
56 constructor Create(const StartDir, Pattern : string;
57 IncludeSubFolders, ListAllSearchedFiles, CaseSensitive : boolean;
58 SearchedFiles : TSearchedFilesSet; Log : TStrings;
59 SearchInfo : TList; AnEvaluation : boolean);
60
61 destructor Destroy; override;
62 procedure Search;
63 end;
64
65 var
66 gStopped : boolean;
67
68 implementation
69
70 uses
71 Forms, Dialogs, SysUtils, StStrL, StBase, StUtils, SsBase, GTimer;
72
73 constructor TPatternSearcher.Create(const StartDir, Pattern : string;
74 IncludeSubFolders, ListAllSearchedFiles, CaseSensitive : boolean;
75 SearchedFiles : TSearchedFilesSet; Log : TStrings;
76 SearchInfo : TList; AnEvaluation : boolean);
77 begin
78 inherited Create;
79 FStartDir := StartDir;
80 FPattern := Pattern;
81 FIncludeSubFolders := IncludeSubFolders;
82 FListAllSearchedFiles := ListAllSearchedFiles;
83 FCaseSensitive := CaseSensitive;
84
85 FSearchedFiles := SearchedFiles;
86
87 FLog := Log;
88 FSearchInfo := SearchInfo;
89
90 FLenPattern := Length(FPattern);
91 FEvaluation := AnEvaluation;
92
93 FilePaths := TStringList.Create;
94 SL := TStringList.Create;
95 end;
96
97 destructor TPatternSearcher.Destroy;
98 begin
99 SL.Free;
100 FilePaths.Free;
101 inherited Destroy;
102 end;
103
104 procedure TPatternSearcher.Search;
105 // main search method, calls SearchWithPos or SearchWithUC
106 var
107 Len, I : integer;
108 RootDir, Ext, S : string;
109 TM : TTimeMeasurer;
110 DoFile : boolean;
111 begin
112 try
113 FNumFilesSearched := 0;
114 FNumFilesMatches := 0;
115 FNumMatches := 0;
116
117 RootDir := FStartDir;
118 Len := Length(RootDir);
119
120 if Len > 3 then // not for "C:\"
121 if RootDir[Len] = '\' then
122 RootDir := copy(RootDir, 1, Len-1);
123
124 if FIncludeSubFolders then
125 S := ' with subfolders'
126 else
127 S := '';
128
129 FLog.Add('');
130 FLog.Add('--- Searching '+RootDir+S+' for pattern "'+FPattern+'" at '+DateTimeToStr(Now)+' ---');
131 FLog.Add('');
132
133 StartTimer(TM);
134 EnumerateFiles(RootDir, FilePaths, FIncludeSubFolders, nil);
135
136 for I := 0 to FilePaths.Count-1 do
137 begin
138 Application.ProcessMessages;
139
140 if gStopped then
141 begin
142 FLog.Add('');
143 FLog.Add('--- Search aborted by user ---');
144 Abort;
145 end;
146
147 if not IsDirectory(FilePaths[I]) then
148 begin
149 DoFile := false;
150
151 if sfAll in FSearchedFiles then
152 DoFile := true
153 else
154 begin
155 Ext := JustExtensionL(FilePaths[I]);
156
157 if (sfOnlyInc in FSearchedFiles) and SameText(Ext, 'inc') then
158 DoFile := true
159 else
160 if (sfOnlyWeb in FSearchedFiles) and (SameText(Ext, 'asp') or
161 SameText(Ext, 'htm')) then
162 DoFile := true
163 else
164 if (sfOnlySql in FSearchedFiles) and SameText(Ext, 'sql') then
165 DoFile := true
166 else
167 if (sfOnlyDelphi in FSearchedFiles) and (SameText(Ext, 'dfm') or
168 SameText(Ext, 'dpk') or SameText(Ext, 'dpr') or SameText(Ext, 'pas')) then
169 DoFile := true
170 else
171 if (sfOnlyVB in FSearchedFiles) and (SameText(Ext, 'bas') or
172 SameText(Ext, 'cls') or SameText(Ext, 'frm') or
173 SameText(Ext, 'vbp')) then
174 DoFile := true
175 else
176 if (sfOnlyTxt in FSearchedFiles) and
177 (SameText(Ext, 'txt') or SameText(Ext, 'config') or SameText(Ext, 'ini')) then
178 DoFile := true;
179 end;
180
181 if DoFile then
182 begin
183 inc(FNumFilesSearched);
184
185 if FCaseSensitive then
186 SearchWithPos(FilePaths[I])
187 else
188 SearchWithUC(FilePaths[I]);
189
190 if FEvaluation and (FNumMatches = 3) then
191 Exit;
192 end;
193 end;
194 end;
195
196 finally
197 FLog.Add('');
198 FLog.Add('--- Searched '+IntToStr(FNumFilesSearched)+' files in '+StopTimer(TM)+' seconds ---');
199 FLog.Add('--- Found '+IntToStr(FNumMatches)+' matches in '+IntToStr(FNumFilesMatches)+' files ---');
200
201 if FEvaluation then
202 FLog.Add('--- Unregistered evaluation version! Only 3 first matches are reported ---');
203 end;
204 end;
205
206 procedure TPatternSearcher.SearchWithPos(const Path : string);
207 // case-sensitive search method
208 var
209 I, Posn : integer;
210 S, T, W : string;
211 First : boolean;
212 begin
213 if FListAllSearchedFiles then
214 FLog.Add('Searching '+Path); // write this, even if no match found
215
216 SL.LoadFromFile(Path);
217 First := true;
218
219 for I := 0 to SL.Count-1 do
220 begin
221 S := SL[I];
222 Posn := 1;
223
224 while (Posn <> 0) and (Length(S) > 0) do
225 begin
226 Posn := Pos(FPattern, S);
227
228 if Posn <> 0 then
229 begin
230 if First then
231 begin
232 if not FListAllSearchedFiles then // now OK to write, match found..
233 FLog.Add('Searching '+Path);
234
235 FLog.Add('');
236 inc(FNumFilesMatches);
237 First := false;
238 end;
239
240 inc(FNumMatches);
241 str(I+1:4, W);
242
243 S := copy(S, Posn, Length(S)-Posn+1); // copy to end of line
244 FLog.Add(' Line '+W+': '+S);
245 S := copy(S, FLenPattern+1, Length(S)-(FLenPattern+1)+1);
246
247 if FEvaluation and (FNumMatches = 3) then
248 Exit;
249 end;
250 end;
251 end;
252
253 if not First then
254 FLog.Add('');
255 end;
256
257 procedure TPatternSearcher.SearchWithUC(const Path : string);
258 // not case-sensitive search method
259 var
260 I : integer;
261 S, T, W : string;
262 First : boolean;
263 Posn : cardinal;
264 begin
265 if FListAllSearchedFiles then
266 FLog.Add('Searching '+Path); // write this, even if no match found
267
268 SL.LoadFromFile(Path);
269 First := true;
270
271 for I := 0 to SL.Count-1 do
272 begin
273 S := SL[I];
274
275 if Length(S) > 0 then
276 begin
277 while SearchUC(S[1], Length(S), FPattern[1], FLenPattern, Posn) do
278 begin
279 T := S;
280 S := copy(S, Posn+1, Length(S)-Posn+1);
281
282 if First then
283 begin
284 if not FListAllSearchedFiles then // now OK to write, match found..
285 FLog.Add('Searching '+Path);
286
287 FLog.Add('');
288 inc(FNumFilesMatches);
289 First := false;
290 end;
291
292 inc(FNumMatches);
293 str(I+1:4, W);
294
295 T := copy(T, Posn+1, Length(T)-Posn+1);
296 FLog.Add(' Line '+W+': '+T);
297 S := copy(S, 2, Length(S)-1);
298
299 if FEvaluation and (FNumMatches = 3) then
300 Exit;
301 end;
302 end;
303 end;
304
305 if not First then
306 FLog.Add('');
307 end;
308
309 end.
Module Calls (2 levels)
-
Module Called-By (2 levels)
PsEngine
PsForm┘
ts┘
Search
TSearchedFiles