当我试图在一个线程中创建一个递归搜索函数时,我遇到了一个大问题(使用delphi 7)下面是代码:
TParcFicDir = class(TThread)
private
several variables..
protected
procedure Execute; override;
public
constructor Create(CreateSuspended: Boolean);
constructor TParcFicDir.Create(CreateSuspended: Boolean);
begin
inherited Create(CreateSuspended);
end;
procedure TParcFicDir.Execute;
begin
try
FindFiles(FStartDir,FMask);//'c:\' and '*.*'
except on e:Exception do
end;
end;
procedure TParcFicDir.FindFiles(StartDir, FileMask: string);
var
wTmp : string;
f:TextFile;
wTempSR:TSearchRec;
function Search(StartDir, FileMask: string): string;
var
SR : TSearchRec;
IsFound : Boolean;
files : integer;
dirs : integer;
t : string;
begin
try
files := 0;
dirs := 0;
if StartDir[length(StartDir)] <> '\' then
StartDir := StartDir + '\';
try
IsFound := (FindFirst(StartDir + '*.*', faAnyFile, SR) = 0);// here the thread gets interrupted
except on e: Exception do
end;
while IsFound do
begin
if (SR.Name <> '.') and (SR.Name <> '..') then
if ((SR.Attr and faDirectory) <> 0) then
if FScanDirs then
begin
inc(dirs);
t := Search(StartDir + SR.Name, FileMask);
try
files := files + strtoint(copy((t), 0, pos('#', t) - 1));//old code, don't take on calcul;
Delete(t, 1, pos('#', t));
dirs := dirs + strtoint(t);
except on e: Exception do
end;
begin
t := StartDir + SR.Name;
wTmp := t;
wtmp := '';
Inc(FDirNo);
writeln(f,t);
inc(filno);
end;
end
else
if ScanFiles then
begin
inc(filno);
inc(files);
end;
IsFound := FindNext(SR) = 0;
end;
Result := IntToStr(files) + '#' + IntToStr(dirs);
sysutils.FindClose(SR);
except on e: Exception do
end;
end;
begin
filno := 0;
try
try
if trim(FPathFileTmp)<>'' then
AssignFile(f, FPathFileTmp+'Temp.bak')
else
AssignFile(f,ExtractFileDir(GetDllName)+'\Temp.bak');
Rewrite(f);
Search(StartDir, FileMask);
if StartDir[length(StartDir)] = '\' then
delete(StartDir, length(StartDir), 1);
wTmp := StartDir;
wTmp := '';
if FindFirst(StartDir, faDirectory, wTempSR) = 0 then
writeln(f);
writeln(f);
CloseFile(f);
except on e: Exception do
end;
finally
end;
end;
好吧,可能代码有点乱,但我不明白为什么线程在'findfirst'部分结束....我用Google搜索,没有结果。
任何帮助将不胜感激!
提前致谢
答案 0 :(得分:2)
在您发布的代码中,我看到您try catch and forget例外。当你破坏了包含类似内容的代码时,我要做的第一件事就是删除空的except块。很可能因为你扔掉你需要的信息而不知道发生了什么。
您的代码中有两次FindFirst()
来电。尝试查找目录的用法是可疑的。我会将你的代码改为这样的。
var
SR : TSearchRec;
begin
if FindFirst('C:\',faDirectory,SR) <> 0 then
RaiseLastOSError;
end;
然后您将看到FindFirst()
失败的原因。
在您查找目录的情况下,我不会使用FindFirst()
而是使用DirectoryExists()
调用。