delphi - 递归文件搜索线程

Question

我有一个搜索文件的例程:

procedure RecSearch(const sPathName, sFile : String; const subDir : Boolean);
var
   sr    : TSearchRec;
   sPath : String;
begin
   Application.ProcessMessages;
   sPath:=IncludeTrailingBackslash(sPathName);
   if FindFirst(sPath + sFile, faAnyFile - faDirectory, sr) = 0 then
   repeat
      lstBox.Items.Add(sPath + sr.Name); // send files into a ListBox
   until FindNext(sr) <> 0;
   FindClose(sr);

   If not subDir then Exit;

   if FindFirst(sPath + '*.*', faDirectory, sr) = 0 then
   repeat
      if ((sr.Attr and faDirectory) <> 0)  and (sr.Name<>'.') and (sr.Name<>'..') then
         RecSearch(sPath + sr.Name, sFile, True);
   until FindNext(sr) <> 0;
   FindClose(sr);
end;

我的问题是我想使用可以完成所有工作的线程，但我无法完成它

我尝试了这个，它只在当前/选定的目录中搜索，而不在子目录中搜索

const
  WM_ThreadDoneMsg = WM_User + 8;

type TfrmSearch = class;

CSearchThread = class(TThread)
   private
      OwnerForm      : TfrmSearch;
      cntFFound      : Integer;
      inPath, inFile : String;
      inFileAttr     : Integer;
      inFileSize     : LongInt;
      procedure RecSearch(const sPath, sFile : String; const subDir : Boolean);
      procedure AddFile;
   protected
      procedure Execute; override;
   published
      constructor Create(owner : TfrmSearch);
      destructor  Destroy; override;
end;

TfrmSearch = class(TForm)
...
   edPath: TEdit;
   edSearchFor: TEdit;
   chkSubfolders: TCheckBox;
   lvFiles: TListView;
...
   private
   public
      srcThread : CSearchThread;
      procedure SearchThreadDone(var msg : TMessage); message WM_ThreadDoneMsg;
end;

var
  frmSearch: TfrmSearch;

implementation

{$R *.dfm}

constructor CSearchThread.Create(owner : TfrmSearch);
begin
   inherited Create(True);
   OwnerForm:=owner;
   FreeOnTerminate:=True;
   Suspended:=False;
   Priority:=tpHigher;
   cntFFound:=0;
   // clear previous entryes
   ownerForm.lvFiles.Clear;
   ownerForm.StatusBar.Panels[0].Text:='';
end;

destructor CSearchThread.Destroy;
begin
   PostMessage(OwnerForm.Handle, WM_ThreadDoneMsg, Self.ThreadID, 0);
   inherited destroy;
end;

procedure CSearchThread.AddFile;
var
   li    : TListItem;
begin
   li:=OwnerForm.lvFiles.Items.Add;
   li.Caption:=inFile;
   li.SubItems.Add(inPath);
   OwnerForm.StatusBar.Panels[0].Text:=IntToStr(cntFFound)+' files found';
end;

procedure CSearchThread.RecSearch(const sPath, sFile : String; const subDir : Boolean);
var
  sr   : TSearchRec;
  attr : Integer;
begin
   OwnerForm.StatusBar.Panels[1].Text:=IntToStr(1+StrToInt(OwnerForm.StatusBar.Panels[1].Text));
   if FindFirst(IncludeTrailingBackslash(sPath)+sFile, faAnyFile - faDirectory, sr) = 0 then
   repeat
         inPath:=sPath;
         inFile:=sr.Name;
         inFileAttr:=sr.Attr;
         inFileSize:=sr.Size;
         Synchronize(AddFile);
   until FindNext(sr) <> 0;
   FindClose(sr);

   if not subDir then Exit;

   if FindFirst(sPath + '*.*', faDirectory, sr) = 0 then
   repeat
      if ((sr.Attr and faDirectory) <> 0)  and (sr.Name<>'.') and (sr.Name<>'..') then
         RecSearch(sPath + sr.Name, sFile, True);
   until FindNext(sr) <> 0;
   FindClose(sr);
end;

procedure CSearchThread.Execute;
begin
   if DirectoryExists(ownerForm.edPath.Text) then
   begin
      RecSearch(ownerForm.edPath.Text, OwnerForm.edSearchFor.Text, OwnerForm.chkSubfolders.Checked);
   end
   else
      ShowMessage('Path not found');
end;

procedure TfrmSearch.SearchThreadDone(var msg : TMessage);
begin
   bbtnPause.Enabled:=False;
end;

Answer 1

您可以尝试使用FindFile组件，该组件可以在单独的线程中搜索给定的路径。