在D6开发人员指南里的-TSearchThread代码自己看吧
unit SrchU;
interface
{$WARN SYMBOL_PLATFORM OFF}
uses Windows, Classes, StdCtrls, MemMap;
type
TSearchThread = class(TThread)
private
LB: TListbox;
CaseSens: Boolean;
FileNames: Boolean;
Recurse: Boolean;
SearchStr: string;
SearchPath: string;
FileSpec: string;
FSearchFile: string;
FWnd: HWND;
procedure DoSearch(const Path: string);
procedure FindAllFiles(const Path: string);
procedure FixControls;
procedure ScanForStr(const FName: string; var FileStr: string);
procedure SearchFile(const FName: string);
procedure SetSearchFile;
protected
procedure Execute; override;
public
constructor Create(CaseS, FName, Rec: Boolean; const Str, SPath,
FSpec: string; Wnd: HWND);
destructor Destroy; override;
end;
var
DDGM_ADDSTR: Cardinal;
implementation
uses SysUtils, Forms, Main, DDGStrUtils;
constructor TSearchThread.Create(CaseS, FName, Rec: Boolean; const Str,
SPath, FSpec: string; Wnd: HWND);
begin
CaseSens := CaseS;
FileNames := FName;
Recurse := Rec;
SearchStr := Str;
SearchPath := AddBackSlash(SPath);
FileSpec := FSpec;
FWnd := Wnd;
inherited Create(False);
end;
destructor TSearchThread.Destroy;
begin
FSearchFile := '';
Synchronize(SetSearchFile);
Synchronize(FixControls);
inherited Destroy;
end;
procedure TSearchThread.Execute;
var
SI: TSystemInfo;
begin
FreeOnTerminate := True; // set up all the fields
LB := MainForm.FileLB;
Priority := TThreadPriority(MainForm.SearchPri);
if not CaseSens then SearchStr := UpperCase(SearchStr);
GetSystemInfo(SI);
FindAllFiles(SearchPath); // process current directory
if Recurse then // if subdirs, then...
DoSearch(SearchPath); // recurse, otherwise...
end;
procedure TSearchThread.FixControls;
{ Enables controls in main form. Must be called through Synchronize }
begin
MainForm.EnableSearchControls(True);
end;
procedure TSearchThread.SetSearchFile;
{ Updates status bar with file name. Must be called through Synchronize }
begin
MainForm.StatusBar.Panels[1].Text := FSearchFile;
end;
procedure TSearchThread.ScanForStr(const FName: string; var FileStr: string);
{ Scans a FileStr of file FName for SearchStr }
var
Marker: string[1];
FoundOnce: Boolean;
FindPos: integer;
begin
FindPos := Pos(SearchStr, FileStr);
FoundOnce := False;
while (FindPos <> 0) and not Terminated do
begin
if not FoundOnce then
begin
{ use : only if not filename only }
if FileNames then
Marker := ''
else
Marker := ':';
{ add file to listbox }
PostMessage(FWnd, DDGM_ADDSTR,
Integer(StrNew(PChar(Format('File %s%s', [FName, Marker])))), 1);
FoundOnce := True;
end;
{ don't search for same string in same file if filenames only }
if FileNames then Exit;
{ Add line if not filename only }
PostMessage(FWnd, DDGM_ADDSTR, Integer(StrNew(PChar(GetCurLine(FileStr,
FindPos)))), 0);
FileStr := Copy(FileStr, FindPos + Length(SearchStr), Length(FileStr));
FindPos := Pos(SearchStr, FileStr);
end;
end;
procedure TSearchThread.SearchFile(const FName: string);
{ Searches file FName for SearchStr }
var
MMF: TMemMapFile;
SearchString: string;
begin
FSearchFile := FName;
Synchronize(SetSearchFile);
try
{ create memory mapped file }
MMF := TMemMapFile.Create(FName, fmOpenRead, 0, False, True);
try
SetString(SearchString, PChar(MMF.Data), MMF.Size);
finally
MMF.Free;
end;
if not CaseSens then SearchString := UpperCase(SearchString);
ScanForStr(FName, SearchString);
except
on EMMFError do
begin
PostMessage(FWnd, DDGM_ADDSTR,
Integer(StrNew(PChar(Format('Error reading file: %s', [FName])))), 0);
end;
end;
end;
procedure TSearchThread.FindAllFiles(const Path: string);
{ procedure searches Path subdir for files matching filespec }
var
SR: TSearchRec;
begin
{ find first file matching spec }
if FindFirst(Path + FileSpec, faArchive, SR) = 0 then
try
repeat
SearchFile(Path + SR.Name); // process file
until (FindNext(SR) <> 0) or Terminated; // find next file
finally
SysUtils.FindClose(SR); // clean up
end;
end;
procedure TSearchThread.DoSearch(const Path: string);
{ procedure recurses through a subdirectory tree starting at Path }
var
SR: TSearchRec;
begin
{ look for directories }
if FindFirst(Path + '*.*', faDirectory, SR) = 0 then
try
repeat
{ if it's a directory and not '.' or '..' then... }
if ((SR.Attr and faDirectory) <> 0) and (SR.Name[1] <> '.') and
not Terminated then
begin
FindAllFiles(Path + SR.Name + '/'); // process directory
DoSearch(Path + SR.Name + '/'); // recurse
end;
until (FindNext(SR) <> 0) or Terminated; // find next directory
finally
SysUtils.FindClose(SR); // clean up
end;
end;
initialization
DDGM_ADDSTR := RegisterWindowMessage('DDG.AddSearchString');
end.
