我有一个搜索文件的例程：
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;
答案 0 :(得分：2)
您可以尝试FindFile组件，它可以在单独的线程中搜索给定路径。
答案 1 :(得分：2)
我看到两个线程访问VCL组件 - 一个很大的禁忌。在列表中构建文件列表，该列表不属于可视组件，并且在线程运行时不会被其他任何内容触及。
另外，回发一条消息，提供找到的文件数量，不要直接更新。
最后，不要为每个文件更新找到的文件数。我已经看到一个程序因为过度更新而对用户输入完全没有响应。我会做一些事情，比如在目录中的每个目录和每100个文件之后进行更新等等。
答案 2 :(得分：1)
在第一个过程中，看起来您将路径分隔符添加到sPath的末尾：
sPath:=IncludeTrailingBackslash(sPathName);
而在第二个中，您只在FindFirst的调用中添加分隔符
if FindFirst(IncludeTrailingBackslash(sPath)+sFile, faAnyFile - faDirectory, sr) = 0 then
稍后将路径组件附加到sPath时，新组件与路径的其余部分之间没有分隔符
if FindFirst(sPath + '*.*', faDirectory, sr) = 0 then
...
RecSearch(sPath + sr.Name, sFile, True);
答案 3 :(得分：1)
我发现了我在寻找@ pascal newsletter＃01 我将再次查看我的代码并搜索我的错误
unit1.dfm：
object Form1: TForm1
Left = 468
Top = 177
Width = 467
Height = 354
Caption = 'File Search'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
DesignSize = (
459
320)
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 17
Top = 13
Width = 55
Height = 13
Alignment = taRightJustify
Caption = 'File &Names:'
FocusControl = Edit1
end
object Label2: TLabel
Left = 19
Top = 42
Width = 53
Height = 13
Alignment = taRightJustify
Caption = '&Containing:'
FocusControl = Edit2
end
object Label3: TLabel
Left = 31
Top = 72
Width = 41
Height = 13
Alignment = taRightJustify
Caption = 'In f&older:'
FocusControl = Edit3
end
object Button1: TButton
Left = 376
Top = 6
Width = 78
Height = 24
Anchors = [akTop, akRight]
Caption = '&Find'
Default = True
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 376
Top = 38
Width = 78
Height = 24
Anchors = [akTop, akRight]
Cancel = True
Caption = '&Cancel'
Enabled = False
TabOrder = 1
OnClick = Button2Click
end
object StatusBar1: TStatusBar
Left = 0
Top = 301
Width = 459
Height = 19
Panels = <>
SimplePanel = True
end
object Edit1: TEdit
Left = 74
Top = 8
Width = 291
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 3
Text = '*.ini'
end
object Edit2: TEdit
Left = 74
Top = 37
Width = 291
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 4
Text = 'General'
end
object Edit3: TEdit
Left = 75
Top = 67
Width = 290
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 5
Text = 'C:\Windows'
end
object CheckBox1: TCheckBox
Left = 76
Top = 97
Width = 111
Height = 13
Caption = '&Include subfolders'
TabOrder = 6
end
object ListView1: VListView
Left = 0
Top = 120
Width = 459
Height = 188
Anchors = [akLeft, akTop, akRight, akBottom]
Columns = <
item
Caption = 'Name'
Width = 150
end
item
Caption = 'Folder'
Width = 300
end>
TabOrder = 7
ViewStyle = vsReport
OnDblClick = ListView1DblClick
OnMouseDown = ListView1MouseDown
end
object Animate1: TAnimate
Left = 393
Top = 66
Width = 48
Height = 50
Anchors = [akTop, akRight]
FileName = 'C:\LatiumSoft\Pascal#001\findfile.avi'
StopFrame = 23
end
end
unit1.pas：
unit Unit1;
//{$DEFINE Spanish}
{
Copyright (c) 2001 Ernesto De Spirito
Latium Software http://www.latiumsoftware.com/
Email: edespirito @ latiumsoftware.com
To try this example you first have to install the ListViewX component
and set a correct value for the FileName property of the Animate1
control (the full path name of an AVI file).
Para probar este ejemplo primero debe instalar el componente ListViewX y
establecer un valor correcto para la propiedad FileName del control
Animate1 (la ruta y nombre completo de un archivo AVI).
}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, ShellAPI, ListView;
const
WM_ThreadDoneMsg = WM_User + 8;
{$IFDEF Spanish}
cstrCouldNotExecApp = 'No se pudo ejecutar la aplicaci≤n';
cstrSearchEnded = 'B·squeda finalizada (%d ficheros encontrados).';
cstrSearchCancelled =
'B·squeda cancelada (%d ficheros encontrados).';
cstrSearching = 'Buscando... (%d ficheros encontrados)';
cstrEnterFileSpec = 'Especifique el nombre de archivo';
cstrEnterKeywords = 'Especifique el texto de b·squeda';
cstrEnterFolder = 'Especifique la carpeta inicial';
{$ELSE}
cstrCouldNotExecApp = 'Couldn''t execute the application';
cstrSearchEnded = 'Search ended (%d files found).';
cstrSearchCancelled = 'Search cancelled (%d files found).';
cstrSearching = 'Searching... (%d files found)';
cstrEnterFileSpec = 'Enter file spec';
cstrEnterKeywords = 'Enter keywords';
cstrEnterFolder = 'Enter folder';
{$ENDIF}
{$IFDEF WIN32}
PathSeparator: char = '\';
DriveSeparator: char = ':';
{$ELSE}
PathSeparator: char = '/';
// DriveSeparator: char = ' ';
{$ENDIF}
type
TForm1 = class;
TThread1 = class(TThread)
private
OwnerForm: TForm1;
Location: string;
FileName: string;
Count: cardinal;
procedure Initialize;
procedure AddFileName;
procedure Finalize;
protected
procedure Execute; override;
published
constructor Create(Owner: TForm1);
destructor Destroy; override;
end;
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
StatusBar1: TStatusBar;
Edit1: TEdit;
Label1: TLabel;
Edit2: TEdit;
Label2: TLabel;
Edit3: TEdit;
Label3: TLabel;
CheckBox1: TCheckBox;
ListView1: VListView;
Animate1: TAnimate;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ListView1DblClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ListView1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
Last: TPoint;
Thread1: TThread1;
procedure Thread1Done(var AMessage: TMessage); message WM_ThreadDoneMsg;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
//---------------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
var
c: char;
begin
if Edit1.Text = '' then begin
MessageDlg(cstrEnterFileSpec, mtWarning, [mbOK], 0);
Edit1.SetFocus;
end else if Edit2.Text = '' then begin
MessageDlg(cstrEnterKeywords, mtWarning, [mbOK], 0);
Edit2.SetFocus;
end else if Edit3.Text = '' then begin
MessageDlg(cstrEnterFolder, mtWarning, [mbOK], 0);
Edit3.SetFocus;
end else begin
c := Edit3.Text[Length(Edit3.Text)];
if (c <> PathSeparator) and (c <> DriveSeparator) then
Edit3.Text := Edit3.Text + PathSeparator;
Button1.Enabled := False;
Edit1.Enabled := False;
Edit2.Enabled := False;
Edit3.Enabled := False;
Checkbox1.Enabled := False;
Button2.Enabled := True;
Thread1 := TThread1.Create(Self);
// Animate1.Active := True;
end;//if
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Thread1.Terminate;
end;
procedure TForm1.Thread1Done(var AMessage: TMessage);
begin
// Animate1.Active := False;
Button1.Enabled := True;
Edit1.Enabled := True;
Edit2.Enabled := True;
Edit3.Enabled := True;
Checkbox1.Enabled := True;
Button2.Enabled := False;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Button2.Enabled then begin
Thread1.Terminate;
Thread1.WaitFor;
end; // if
Action := caFree;
end;
// ---------------------------------------------------------------
constructor TThread1.Create(Owner: TForm1);
begin
inherited Create(True);
OwnerForm := Owner;
Priority := tpHigher;
FreeOnTerminate := True;
Suspended := False;
end;
destructor TThread1.Destroy;
begin
PostMessage(OwnerForm.Handle,
WM_ThreadDoneMsg, Self.ThreadID, 0);
inherited destroy;
end;
procedure TThread1.Execute;
var
Content: TStringList;
Keywords: string;
procedure ScanFolder(const folder: string);
var
SearchRec: TSearchRec;
begin
if FindFirst(folder + OwnerForm.Edit1.Text,
faReadOnly Or faHidden Or faSysFile Or faArchive,
SearchRec) = 0 then begin
repeat
try
FileName := SearchRec.Name;
Content.LoadFromFile(folder + FileName);
if AnsiPos(Keywords, AnsiUpperCase(Content.Text))
<> 0 then begin
Inc(Count);
Location := folder;
Synchronize(AddFileName);
end; // if
except
end; // try
until Terminated Or (FindNext(SearchRec) <> 0);
end; // if
FindClose(SearchRec);
if (not Terminated) and OwnerForm.Checkbox1.Checked then begin
if FindFirst(folder + '*', faReadOnly Or faHidden
Or faSysFile Or faArchive Or faDirectory,
SearchRec) = 0 then begin
repeat
try
if ((SearchRec.Attr and faDirectory) <> 0)
and (SearchRec.Name <> '.')
and (SearchRec.Name <> '..') then
ScanFolder(folder + SearchRec.Name + PathSeparator);
except
end; // try
until Terminated Or (FindNext(SearchRec) <> 0);
end; // if
FindClose(SearchRec);
end; // if
end;
begin // procedure TThread1.Execute;
Count := 0;
Synchronize(Initialize);
Content := TStringList.Create();
Keywords := AnsiUpperCase(OwnerForm.Edit2.Text);
ScanFolder(OwnerForm.Edit3.Text);
Content.Free;
Synchronize(Finalize);
end;
procedure TThread1.Initialize;
begin
OwnerForm.StatusBar1.SimpleText :=
Format(cstrSearching, [Count]);
OwnerForm.ListView1.Items.Clear;
end;
procedure TThread1.AddFileName;
var
ListItem: TListItem;
begin
OwnerForm.StatusBar1.SimpleText := Format(cstrSearching, [Count]);
ListItem := OwnerForm.ListView1.Items.Add();
ListItem.Caption := FileName;
ListItem.SubItems.Add(Location);
end;
procedure TThread1.Finalize;
begin
if Terminated then
OwnerForm.StatusBar1.SimpleText :=
Format(cstrSearchCancelled, [Count])
else
OwnerForm.StatusBar1.SimpleText :=
Format(cstrSearchEnded, [Count]);
end;
procedure TForm1.ListView1DblClick(Sender: TObject);
var
Col: Integer;
ListItem: TListItem;
begin
ListItem := ListView1.GetItemAtX(Last.X, Last.Y, Col);
if ListItem <> nil then begin
if Col = 0 then begin
if ShellExecute(Self.Handle, nil,
PChar(ListItem.SubItems.Strings[0] + ListItem.Caption),
nil, nil, SW_SHOWMAXIMIZED) <= 32 then begin
Application.MessageBox(cstrCouldNotExecApp,
'Error', MB_ICONEXCLAMATION);
end;//if
end else if Col = 1 then begin
if ShellExecute(Self.Handle, 'explore',
PChar(ListItem.SubItems.Strings[0]),
nil, nil, SW_SHOWMAXIMIZED) <= 32 then begin
Application.MessageBox(cstrCouldNotExecApp,
'Error', MB_ICONEXCLAMATION);
end; // if
end; // if
end; // if
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
{$IFDEF Spanish}
Button1.Caption := '&Buscar';
Button2.Caption := '&Detener';
Label1.Caption := 'No&mbre:';
Label2.Caption := 'Con el &texto:';
Label3.Caption := 'B&uscar en:';
CheckBox1.Caption := '&Incluir subcarpetas:';
ListView1.Columns[0].Caption := 'Nombre';
ListView1.Columns[1].Caption := 'Ubicaci≤n';
{$ENDIF}
end;
procedure TForm1.ListView1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Last.X := X;
Last.Y := Y;
end;
end.