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

Question

定义了一个查找文件的线程
在 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)  : 挂起线程时，报无效句柄错误
不知道怎么用多线程......-_-

Answer 1

写个析构函数，再调用试试
destructor TSearchThread.Destroy;
begin
  Terminate;
  Resume;
  WaitFor;
  inherited;
end;

Answer 2

还有执行函数加上这个
procedure TSearchThread.Execute;
begin
  inherited;
  while not Terminated do
  begin    
    try
      DoSearch(Path);       if Terminated then Exit;
      Suspend;
    except
    end;
  end;
end;

Answer 3

试过了，不论是唤醒还是挂起，都会报无效句柄错误
while not Terminated do 
  begin    
    try 
      DoSearch(Path);       if Terminated then Exit; 
      Suspend; 
    except 
    end; 
  end; 
这个我试过了，恐怕不是我要的效果，这样的话，会一直重复执行 dosearch函数，会重复查找添加文件到 list中

Answer 4

如果改为这样
FreeOnTerminate:= False;
可以正常手动释放
procedure FreeThread; 
begin 
  for i := FThreadList.Count - 1 downto 0 do 
  begin 
    TSearchThread(FThreadList[i]).Terminate; 
    TSearchThread(FThreadList[i]).Destory; 
  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;

Answer 5

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;这个可以不要了，还有TSearchThread(FThreadList[i]).Terminate; 
    TSearchThread(FThreadList[i]).Destory; 
，没必要这么写，写成这样，只要一个TSearchThread(FThreadList[i]).Destory; 就OK了
destructor TSearchThread.Destroy; 
begin 
  Terminate; 
  Resume; 
  WaitFor; 
  inherited; 
end;

Answer 6

如果不写这个函数
procedure SuspendThread; 
begin 
  for i := FThreadList.Count - 1 downto 0 do 
  begin 
    if not TSearchThread(FThreadList[i]).Suspended then 
    TSearchThread(FThreadList[i]).Suspend; 
  end; 
end;那我要挂起全部的线程怎么办呢？
如果FreeONTerminate := false 是可以这样手动释放
TSearchThread(FThreadList[i]).Destory;

Answer 7

我使用线程都是在执行函数Excute中挂起的，没见过手动去中断执行挂起的
你是想直接中断，然后结束？这个还没用过
一般都是即使程序关闭了也要等它执行完

Answer 8

感觉还是你的线程没有释放掉,下面的手动释放的代码你可以参考一下
  ThreadReConnect.Terminate;
  if ThreadReConnect.Suspended then
     ThreadReConnect.Resume;
  ThreadReConnect.WaitFor;
  ThreadReConnect.Free;

Answer 9

另外你设置了FreeOnTerminate:=True,那执行完全线程会自动释放,你为何还要手动释放,我觉得你不要这句了if Terminated then break;什么时候退出自己判断,比如你找到了指定的文件就退出循环就可以了,没有找到就让线程自己跑完自己释放就好了.

Answer 10

已经改为这样了 : 
FreeOnTerminate:= false
destructor TSearchThread.Destroy; 
begin 
  Terminate; 
  Resume; 
  WaitFor; 
  inherited; 
end;还是那个问题，可以手动释放，但是无法挂起和唤醒
另外，频繁释放和创建线程时，就会报错，也不知道是什么原因引起的而这句话 ：if Terminated then break; 似乎不会起任何作用，

Answer 11

线程最好是自然的停止，不要强制停止,设置一个变量FIsStop，
在线程启动的时候将它设置为False,想停止的时候将它设置为Trueprocedure Execute;
begin 
  while Not FIsStop 
   
   应该在每个循环中检查这个值，如是是True 则退出循环
end;
  线程在执行完，退出后会执行 OnTerminate 事件,在这个事件中将线程从 FThreadList 列表中删除当最后一个线程删除时就是全部线程都结束了。
<Windows核心编程> 里有更详细的,可以看看。

Answer 12

谢谢 楼上的，不过你认真看一下我的代码，我不能在 execute 中用 while not do 的循环，否则它找完了又重复再找一次
在 dosearch（）中判断的话，跟踪了一下，似乎不起作用...我现在想要的就是能手动挂起和唤醒。

Answer 13

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函数永远等待.
就写个大概吧,你自己可能要再改一下.

Answer 14

在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; 

Answer 15

   写了一个测试了一下, 出现拒绝访问是因为线程已经结束掉了(调试的时候调出线程监视窗体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.

Answer 16

demo上传到我的资源了，还看不到。不知道啥时候能出来。

Answer 17

又错了:
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;

Answer 18

你好，按你的方法试了一下，在频繁创建和释放 TDriveShearcher 这个线程对象时，有可能导致线程假S，不知道是真的还是假的S了，就是界面都不动了，线程窗口中的线程也停住不动,另外，还会引起无效指针的错误
不知道是不是我的用法不对，
我是这样的快速的调用下面这个函数：
procedure onDiskClick;
begin
  if assigned(FThread) then 
  begin
    FThread.StopSearch;
    FThread.Destroy;
  end;
  FThread := TDriveShearcher.create(apath,事件);
end;试一下minizhuxianchun 的方法

Answer 19

死掉的现象没发现，不过找到一个出现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.在回调函数里不要做太多的事情。

Answer 20

线程Execute执行完后自己把自己释放了。

Answer 21

其实在 SearchFolder中就是把符合条件的文件加到一个 tstringlist 中，也没做什么其它事
S掉的现象比较少，就是报错的情况比较多，一旦报错后，就一直无效指针错误

Answer 22

FreeOnTerminate:=False;  

Answer 23

现在的问题是 
（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会有遗留内存。

Answer 24

谢谢各位，多线程不好管理，采用 etomahawk 的方法，在我的机器上测试比较容易出现假S的现在，其它异常倒是可以捕获得到，不会有多大的影响 

Answer 25

mdejtod 把线程和TThread对象搞混淆了