问个关于多线程的。。。。

mdejtod 2009-07-30 03:24:46
定义了一个查找文件的线程
在 Execute 事件中用 findfirst 等函数查找指定目录下的文件
如:
constructor Create;
begin
inherited Create(False);
FreeOnTerminate:=True;
end;

procedure Execute;
begin
DoSearch(Path);
end;

然后同时创建多个线程
var list : TStringlist;
FThreadList : Tlist;

for i := 0 to 5 do
begin
FThreadList.Add(TSearchThread.Create);
end;

但我要停止全部线程时,它其实没有停掉
procedure FreeThread;
begin
for i := FThreadList.Count - 1 downto 0 do
begin
TSearchThread(FThreadList[i]).Terminate;
TSearchThread(FThreadList[i]).WaitFor; //报无效句柄错误
end;
end;

挂起
procedure FreeThread;
begin
for i := FThreadList.Count - 1 downto 0 do
begin
if not TSearchThread(FThreadList[i]).Suspended then
TSearchThread(FThreadList[i]).Suspend;//报无效句柄错误
end;
end;

唤醒
procedure FreeThread;
begin
for i := FThreadList.Count - 1 downto 0 do
begin
if TSearchThread(FThreadList[i]).Suspended then
TSearchThread(FThreadList[i]).Resume;
end;
end;

procedure DoSearch;
begin
if findfirst() <> 0 then
begin
repeat
//在此处加了 ,但并不起作用
if Terminated then break;
alist.add(path + sr.name)
until findnext(sr) = 0 ;
end;
end;


现在的问题是
(1) :线程没有停止
(2) : 挂起线程时,报无效句柄错误
不知道怎么用多线程......-_-
...全文
249 39 打赏 收藏 转发到动态 举报
写回复
用AI写文章
39 条回复
切换为时间正序
请发表友善的回复…
发表回复
JohnYale 2009-08-02
  • 打赏
  • 举报
回复
mdejtod 把线程和TThread对象搞混淆了
yshuui 2009-08-01
  • 打赏
  • 举报
回复
得多试一些方法,虽然写过一些多线程程序,但遇到问题,还得逐个去试,记不住。
mdejtod 2009-08-01
  • 打赏
  • 举报
回复
谢谢各位,多线程不好管理,采用 etomahawk 的方法,在我的机器上测试比较容易出现假S的现在,其它异常倒是可以捕获得到,不会有多大的影响
linyuzhi 2009-08-01
  • 打赏
  • 举报
回复
现在的问题是
(1) :线程没有停止
(2) : 挂起线程时,报无效句柄错误

1、线程停止的方法
TerminateThread(TSearchThread(FThreadList[i]).handle);

2、 挂起线程时,报无效句柄错误
这个是不是因为前面已经执行了 TSearchThread(FThreadList[i]).Terminate的操作,像
TSearchThread(FThreadList[i]).Terminate;
TSearchThread(FThreadList[i]).WaitFor; //报无效句柄错误
这样的执行顺序是不对的。

释放线程用TSearchThread(FThreadList[i]).destroy
用FreeOnterminate会有遗留内存。
minizhuxianchun 2009-07-31
  • 打赏
  • 举报
回复
在procedure ThreadExit; 里加一句:
CloseHandle(EventHandle);

把procedure ThreadCreate(Count: Byte);改成
var
ID: DWORD;
i: Byte;
begin
SetLength(ThreadHandle,Count);
EventHandle := CreateEvent(nil, True, False, 'SeachDir'); //手动复位,初始无信号
InitializeCriticalSection(CriticalSection);
for i:=1 to Count do
ThreadHandle[i-1]:=CreateThread(nil, 0, @ThreadFunc, pStrDir, 0, ID); //pStrDir是你传入扫描目录地址.
end;
minizhuxianchun 2009-07-31
  • 打赏
  • 举报
回复
var
EventHandle: THandle;//全局变量.
CriticalSection: TRTLCriticalSection; //临界区
ThreadHandle: array of THandle;
isThreadExit: Boolean=False; //线程退出标志
ExitCount: Byte=0; //退出的线程数.

function ThreadFunc(P: Pointer): Integer; stdcall; //线程执行函数
var
sDir: string;
begin
sDir:=StrPas(PChar(P)); //得到所扫描的目录.
DoSeach(sDir);//在DoSeach函数里的循环中判断isThreadExit,如为真则退出循环
EnterCriticalSection(CriticalSection);
//在这释放一些对象或内存.
Inc(ExitCount,1); //+1,表明有个线程退出了.
if ExitCount=Length(ThreadHandle) then //如果退出线程数为最后一个
SetEvent(EventHandle); //设置有信号
ExitThread(0);
end;

procedure ThreadCreate(Count: Byte); //Count代表建多少线程.
var
ID: DWORD;
i: Byte;
begin
SetLength(ThreadHandle,Count);
EventHandle := CreateEvent(nil, True, False, 'SeachDir'); //手动复位,初始无信号
InitializeCriticalSection(CriticalSection);
for i:=1 to Count do
CreateThread(nil, 0, @ThreadFunc, pStrDir, 0, ID); //pStrDir是你传入扫描目录地址.
end;

procedure ThreadExit;
begin
isThreadExit:=True;
WaitForSingleObject(EventHandle,INFINITE);
DeleteCriticalSection(CriticalSection);
//做一些其它相关事情.
end;

procedure ThreadSuspend; //Resume也一样,这里就不写了.
var
i: byte;
begin
for i:=Low(ThreadHandle) to High(ThreadHandle) do
SuspendThread(ThreadHandle[i]);
end;

注意退出程序时一定要把所有的挂起的线程恢复,否则ThreadExit函数永远等待.
就写个大概吧,你自己可能要再改一下.
mdejtod 2009-07-31
  • 打赏
  • 举报
回复
谢谢 楼上的,不过你认真看一下我的代码,我不能在 execute 中用 while not do 的循环,否则它找完了又重复再找一次
在 dosearch()中判断的话,跟踪了一下,似乎不起作用...我现在想要的就是能手动挂起和唤醒。
ZyxIp 2009-07-31
  • 打赏
  • 举报
回复
线程最好是自然的停止,不要强制停止,设置一个变量FIsStop,
在线程启动的时候将它设置为False,想停止的时候将它设置为True

procedure Execute;
begin
while Not FIsStop

应该在每个循环中检查这个值,如是是True 则退出循环
end;
线程在执行完,退出后会执行 OnTerminate 事件,在这个事件中将线程从 FThreadList 列表中删除

当最后一个线程删除时就是全部线程都结束了。
<Windows核心编程> 里有更详细的,可以看看。

wxsan 2009-07-31
  • 打赏
  • 举报
回复
帮你顶一下!
mdejtod 2009-07-31
  • 打赏
  • 举报
回复
[Quote=引用 33 楼 lhylhy 的回复:]
线程Execute执行完后自己把自己释放了。
[/Quote]
FreeOnTerminate:=False;
mdejtod 2009-07-31
  • 打赏
  • 举报
回复
其实在 SearchFolder中就是把符合条件的文件加到一个 tstringlist 中,也没做什么其它事
S掉的现象比较少,就是报错的情况比较多,一旦报错后,就一直无效指针错误
lhy 2009-07-31
  • 打赏
  • 举报
回复
线程Execute执行完后自己把自己释放了。
etomahawk 2009-07-31
  • 打赏
  • 举报
回复

死掉的现象没发现,不过找到一个出现AV错误的原因,这里忘加锁了

procedure TDriveShearcher.Execute;
var
sExt: String;
tRec: TSearchRec;
nTmp: Integer;
bFlg: Boolean;
begin
if not DirectoryExists(FDriver) then exit;

LockList;
try
//....
finally
UnlockList;
end;
end.

在回调函数里不要做太多的事情。
mdejtod 2009-07-31
  • 打赏
  • 举报
回复
[Quote=引用 28 楼 etomahawk 的回复:]
demo上传到我的资源了,还看不到。不知道啥时候能出来。
[/Quote]
你好,按你的方法试了一下,在频繁创建和释放 TDriveShearcher 这个线程对象时,有可能导致线程假S,不知道是真的还是假的S了,就是界面都不动了,线程窗口中的线程也停住不动,另外,还会引起无效指针的错误
不知道是不是我的用法不对,
我是这样的快速的调用下面这个函数:
procedure onDiskClick;
begin
if assigned(FThread) then
begin
FThread.StopSearch;
FThread.Destroy;
end;
FThread := TDriveShearcher.create(apath,事件);
end;

试一下minizhuxianchun 的方法
minizhuxianchun 2009-07-31
  • 打赏
  • 举报
回复
又错了:
function ThreadFunc(P: Pointer): Integer; stdcall; //线程执行函数
var
sDir: string;
begin
sDir:=StrPas(PChar(P)); //得到所扫描的目录.
DoSeach(sDir);//在DoSeach函数里的循环中判断isThreadExit,如为真则退出循环
EnterCriticalSection(CriticalSection);
//在这释放一些对象或内存.
Inc(ExitCount,1); //+1,表明有个线程退出了.
LeaveCriticalSection(CriticalSection);//离开临界区忘了加了.
if ExitCount=Length(ThreadHandle) then //如果退出线程数为最后一个
SetEvent(EventHandle); //设置有信号
ExitThread(0);
end;
mdejtod 2009-07-31
  • 打赏
  • 举报
回复
谢谢 ,我都试一下
etomahawk 2009-07-31
  • 打赏
  • 举报
回复
demo上传到我的资源了,还看不到。不知道啥时候能出来。
etomahawk 2009-07-31
  • 打赏
  • 举报
回复
写了一个测试了一下, 出现拒绝访问是因为线程已经结束掉了(调试的时候调出线程监视窗体Ctrl + Alt + T,就可以看到线程运行情况了)。

TShowSearch = procedure (sFile: String) of Object;

TDriveShearcher = class(TThread)
private
FThreads : TList;
FDriver : String;

FOnShow : TShowSearch;
FOnFinish: TNotifyEvent;

FCurFile : String;
FIsPause : Boolean;
FThreadLk: _RTL_CRITICAL_SECTION;

procedure InitLock;
procedure LockList;
procedure UnlockList;
procedure UnInitLock;

procedure ShowSearch;

protected
procedure Execute; override;

public
constructor Create(sDriver: String; OnShow: TShowSearch; OnFinish: TNotifyEvent);
destructor Destroy; override;

procedure PauseSearch;
procedure ResumeSearch;
procedure StopSearch;

published
property IsPause: Boolean read FIsPause;

end;

TSearchThread = class(TThread)
private
FRootPath: String;

FCurFile : String;
FOnShow : TShowSearch;
Finished : Boolean;

procedure ShowSearch;
procedure SearchFolder(sPath: String);

protected
procedure Execute; override;

public
constructor Create(sRoot: String; OnShow: TShowSearch);
destructor Destroy; override;

procedure StopSearch;

published
property CurFile: String read FCurFile;
property Finish : Boolean read Finished;

end;

implementation
{ TSearchThread }

constructor TSearchThread.Create(sRoot: String; OnShow: TShowSearch);
begin
FRootPath:= sRoot;
FOnShow := OnShow;
Finished := false;

inherited Create(false);
end;

destructor TSearchThread.Destroy;
begin
Self.Terminate; // TThread will set Terminated flag true
Self.Resume; // Maybe the thread not started, we resume thread
Self.WaitFor;

inherited;
end;

procedure TSearchThread.StopSearch;
begin
Self.Terminate; // TThread will set Terminated flag true
Self.Resume; // Maybe the thread not started, we resume thread
Self.WaitFor;

Finished:= true;
end;

procedure TSearchThread.Execute;
begin
inherited;

SearchFolder(FRootPath);

Finished:= true;
end;

procedure TSearchThread.SearchFolder(sPath: String);
var
sExt : String;
tRec : TSearchRec;
begin
if not DirectoryExists(sPath) then exit;

if (sPath[Length(sPath)] <> '\') then
sPath:= sPath + '\';

try
if (0 <> FindFirst(sPath + '*.*', FILE_ATTRIBUTE_DIRECTORY, tRec)) then exit;

repeat
// Check extend
sExt:= LowerCase(ExtractFileExt(tRec.Name));
if (Trim(sExt) = '') then
begin
SearchFolder(sPath + tRec.Name);
continue;
end
else if (sExt <> '.mp3') then
continue;

// Show file find
FCurFile:= sPath + tRec.Name;
Synchronize(ShowSearch);
until ((FindNext(tRec) <> 0) or Self.Terminated);

FindClose(tRec);
except
end;
end;

procedure TSearchThread.ShowSearch;
begin
if Assigned(FOnShow) then FOnShow(FCurFile);
end;

{ TDriveShearcher }

constructor TDriveShearcher.Create(sDriver: String; OnShow: TShowSearch;
OnFinish: TNotifyEvent);
begin
FDriver := sDriver;
FOnShow := OnShow;
FOnFinish:= OnFinish;
FThreads := nil;
FIsPause := false;

InitLock;

inherited Create(false);
end;

destructor TDriveShearcher.Destroy;
begin
StopSearch;

UnInitLock;
inherited;
end;

procedure TDriveShearcher.Execute;
var
sExt: String;
tRec: TSearchRec;
nTmp: Integer;
bFlg: Boolean;
begin
if not DirectoryExists(FDriver) then exit;

// No need to lock
FThreads:= TList.Create;

if (FDriver[Length(FDriver)] <> '\') then
FDriver:= FDriver + '\';

try
if (0 <> FindFirst(FDriver + '*.*', FILE_ATTRIBUTE_DIRECTORY, tRec)) then exit;

repeat
// Check extend
sExt:= LowerCase(ExtractFileExt(tRec.Name));
if (Trim(sExt) = '') then
begin
FThreads.Add(TSearchThread.Create(FDriver + tRec.Name, FOnShow));
continue;
end
else if (sExt <> '.mp3') then
continue;

// Show file find
FCurFile:= FDriver + tRec.Name;
Synchronize(ShowSearch);
until ((FindNext(tRec) <> 0) or Self.Terminated);

FindClose(tRec);
except
end;

// Wait for search finish
while not Self.Terminated do
begin
bFlg:= true;

// Check whether all thread finished
LockList;
try
if (FThreads <> nil) and (FThreads.Count > 0) then
begin
for nTmp:= FThreads.Count - 1 downto 0 do
begin
if not TSearchThread(FThreads.Items[nTmp]).Finished then
begin
bFlg:= false;
break;
end;
end;
end;
finally
UnlockList;
end;

if bFlg then break;

Sleep(100);
end;

// Tell Calling thread that search finished
if Assigned(FOnFinish) then FOnFinish(Self);
end;

procedure TDriveShearcher.ShowSearch;
begin
if Assigned(FOnShow) then FOnShow(FCurFile);
end;

procedure TDriveShearcher.PauseSearch;
var
nTmp: Integer;
pTmp: TSearchThread;
begin
FIsPause:= true;

LockList;
try
if (FThreads = nil) or (FThreads.Count <= 0) then
begin
Self.Suspend;
exit;
end;

for nTmp:= 0 to FThreads.Count - 1 do
begin
pTmp:= TSearchThread(FThreads.Items[nTmp]);

if (not pTmp.Finished) and (not pTmp.Terminated) then
pTmp.Suspend;
end;
finally
UnlockList;
end;
end;

procedure TDriveShearcher.ResumeSearch;
var
nTmp: Integer;
pTmp: TSearchThread;
begin
FIsPause:= false;

LockList;
try
if (FThreads = nil) or (FThreads.Count <= 0) then
begin
Self.Resume;
exit;
end;

for nTmp:= FThreads.Count - 1 downto 0 do
begin
pTmp:= TSearchThread(FThreads.Items[nTmp]);

if (not pTmp.Finished) and (not pTmp.Terminated) then
pTmp.Resume;
end;
finally
UnlockList;
end;
end;

procedure TDriveShearcher.StopSearch;
var
nTmp: Integer;
pTmp: TSearchThread;
begin
FIsPause:= true;

if Self.Terminated then exit;

LockList;
try
if (FThreads = nil) then
begin
Self.Terminate;
Self.Resume;
Self.WaitFor;
exit;
end;

if (FThreads.Count > 0) then
begin
for nTmp:= FThreads.Count - 1 downto 0 do
begin
pTmp:= TSearchThread(FThreads.Items[nTmp]);

if (not pTmp.Finished) and (not pTmp.Terminated) then
pTmp.StopSearch;

FreeAndNil(pTmp);
end;
end;

FThreads.Clear;
FreeAndNil(FThreads);
finally
UnlockList;
end;

Self.Terminate;
if Self.Suspended then Self.Resume;
Self.WaitFor;
end;

procedure TDriveShearcher.InitLock;
begin
InitializeCriticalSection(FThreadLk);
end;

procedure TDriveShearcher.LockList;
begin
EnterCriticalSection(FThreadLk);
end;

procedure TDriveShearcher.UnInitLock;
begin
DeleteCriticalSection(FThreadLk);
end;

procedure TDriveShearcher.UnlockList;
begin
LeaveCriticalSection(FThreadLk);
end;

end.
mdejtod 2009-07-31
  • 打赏
  • 举报
回复
谢谢 ,我试一下
mdejtod 2009-07-30
  • 打赏
  • 举报
回复
[Quote=引用 19 楼 hongqi162 的回复:]
你要弄一个线程池?
[/Quote]
能实现我的要求即可,还望赐教,如实搞线程池?
加载更多回复(19)

16,748

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 语言基础/算法/系统设计
社区管理员
  • 语言基础/算法/系统设计社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧