1,183
社区成员
发帖
与我相关
我的任务
分享【CreateProcess】、【MsgWaitForMultipleObjects】与线程冲突了
//这是主线程中的一段代码
var
H: THandle;
begin
//之前已经Create了这个线程
H := GetFileThread.Handle;
//为了方便测试，在线程中加入了Sleep(5000)
GetFileThread.Terminate;
//到这里还是正确的，即：5秒后ShowMessage出0
//如果将第3个参数改为False则会立即得到结果，这显然不正确
ShowMessage(IntToStr(MsgWaitForMultipleObjects(1, H, True, INFINITE,
QS_ALLINPUT) - WAIT_OBJECT_0));
end;
问题是：
在这前面用CreateProcess启动一个外部程序，MsgWaitForMultipleObjects就只能在外部程序关闭，并且线程结束时，才能返回，“H”明明是线程的句柄，和CreateProcess没关系，但却受它影响了
如果将MsgWaitForMultipleObjects的第3个参数改为False，则外部程序关闭时，就直接得到结果“1”，此时线程并没有结束。
var
StartupInfo: TStartUpInfo;
ProcessInfo: TProcessInformation;
begin
with StartupInfo do
begin
cb := SizeOf(StartupInfo);
dwFlags := StartF_UsesTDHandles or STARTF_USESHOWWINDOW;
lpTitle := nil;
wShowWindow := SW_Show;
end;
if not CreateProcess(PChar(ExtractFilePath(ParamStr(0)) + ClientExeName), nil,
nil, nil, True, HIGH_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo)
then
begin
Application.MessageBox('无法启动客户端', '找不到客户端程序', MB_ICONERROR);
end;
end;
...全文
请发表友善的回复…
发表回复
pathletboy 2014-12-01
- 打赏
- 举报
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
const
WM_EXECUTE = WM_USER + 5000;
type
TMyThread = class(TThread)
protected
procedure Execute(); override;
public
constructor Create();
end;
TForm1 = class(TForm)
btn1: TButton;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btn1Click(Sender: TObject);
private
FMyThread: TMyThread;
procedure RunExe(var Msg: TMessage); message WM_EXECUTE;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
const
ClientExeName = 'notepad.exe';
procedure TForm1.btn1Click(Sender: TObject);
begin
FMyThread := TMyThread.Create;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FMyThread.Free; //请仔细看TThread.Destroy(重点WaitFor)
ShowMessage('线程已经执行完毕');
end;
{ TMyThread }
constructor TMyThread.Create;
begin
inherited Create(False);
end;
procedure TMyThread.Execute;
begin
PostMessage(Form1.Handle, WM_EXECUTE, 0, 0);
end;
procedure TForm1.RunExe(var Msg: TMessage);
var
StartupInfo: TStartUpInfo;
ProcessInfo: TProcessInformation;
begin
FillChar(StartupInfo, SizeOf(StartupInfo), 0);
with StartupInfo do
begin
cb := SizeOf(StartupInfo);
dwFlags := StartF_UsesTDHandles or STARTF_USESHOWWINDOW;
lpTitle := nil;
wShowWindow := SW_Show;
end;
if not CreateProcess(PChar(ExtractFilePath(ParamStr(0)) + ClientExeName), nil,
nil, nil, True, DETACHED_PROCESS, nil, nil, StartupInfo, ProcessInfo) then
Application.MessageBox('无法启动客户端', '找不到客户端程序', MB_ICONERROR);
Self.Close;
end;
end.
FlashDance 2014-12-01
- 打赏
- 举报
没必要这么低效死循环判断标志，直接重载TThread.Destroy，在Destroy中最后PostMessage通知主窗体[/quote]
判断子线程结束前后都有代码，无法独立出来，不方便接收PostMessage啊[/quote]
死等后面的全丢消息处理就可以了。[/quote]
好的，非常感谢
pathletboy 2014-12-01
- 打赏
- 举报
没必要这么低效死循环判断标志，直接重载TThread.Destroy，在Destroy中最后PostMessage通知主窗体[/quote]
判断子线程结束前后都有代码，无法独立出来，不方便接收PostMessage啊[/quote]
死等后面的全丢消息处理就可以了。
FlashDance 2014-12-01
- 打赏
- 举报
没必要这么低效死循环判断标志，直接重载TThread.Destroy，在Destroy中最后PostMessage通知主窗体[/quote]
判断子线程结束前后都有代码，无法独立出来，不方便接收PostMessage啊
pathletboy 2014-12-01
- 打赏
- 举报
没必要这么低效死循环判断标志，直接重载TThread.Destroy，在Destroy中最后PostMessage通知主窗体
FlashDance 2014-12-01
- 打赏
- 举报
需要用到FreeOnTerminate := True;的时候还是很多
现在只好这样写了：
MyThread1.Terminate;
while not MyThread1.Finished do
Application.ProcessMessages;
FlashDance 2014-11-30
- 打赏
- 举报
本意是想在由线程处理一些数据，处理成功后，由线程启动一个EXE，线程再继续其它操作。
主线程在子线程结束后就退出。那个EXE并不需要退出。
FlashDance 2014-11-30
- 打赏
- 举报
A：我也是理解等待一个对象没有区别，但上述代码用False等待一个对象却不行
B：我试着用PostMessage来操作，在线程中也只有这一行代码用来启动exe，无意发现，就是在线程中用PostMessage启动exe，造成了这个结果：
“MsgWaitForMultipleObjects就只能在外部程序关闭，并且线程结束时，才能返回，“H”明明是线程的句柄，和CreateProcess没关系，但却受它影响了”
真是不知如何解决了
unit UnitMyThread;
interface
uses
System.Classes, System.SysUtils, Winapi.Messages, Winapi.Windows;
type
TMyThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
public
constructor Create;
end;
implementation
{ TMyThread }
uses UnitMain;
constructor TMyThread.Create;
begin
inherited Create(False);
FreeOnTerminate := True;
end;
procedure TMyThread.Execute;
begin
PostMessage(FormMain.Handle, WM_USER + 5000, 0, 0);
end;
end.
unit UnitMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TFormMain = class(TForm)
btn1: TButton;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btn1Click(Sender: TObject);
private
{ Private declarations }
procedure RunExe(var Msg: TMessage); message WM_USER + 5000;
public
{ Public declarations }
end;
var
FormMain: TFormMain;
implementation
{$R *.dfm}
uses UnitMyThread;
const
ClientExeName = 'Hash.exe';
var
MyThread1: TMyThread;
H: array [0 .. 0] of THandle;
procedure TFormMain.btn1Click(Sender: TObject);
begin
MyThread1 := TMyThread.Create;
H[0] := MyThread1.Handle;
end;
procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
MyThread1.Terminate;
ShowMessage(IntToStr(MsgWaitForMultipleObjects(1, H, True, INFINITE,
QS_ALLINPUT) - WAIT_OBJECT_0));
end;
procedure TFormMain.RunExe(var Msg: TMessage);
var
StartupInfo: TStartUpInfo;
ProcessInfo: TProcessInformation;
begin
FillChar(StartupInfo, SizeOf(StartupInfo), 0);
with StartupInfo do
begin
cb := SizeOf(StartupInfo);
dwFlags := StartF_UsesTDHandles or STARTF_USESHOWWINDOW;
lpTitle := nil;
wShowWindow := SW_Show;
end;
if not CreateProcess(PChar(ExtractFilePath(ParamStr(0)) + ClientExeName), nil,
nil, nil, True, DETACHED_PROCESS, nil, nil, StartupInfo, ProcessInfo) then
Application.MessageBox('无法启动客户端', '找不到客户端程序', MB_ICONERROR);
FormMain.Close;
end;
end.
pathletboy 2014-11-30
- 打赏
- 举报
A：
这个参数解释
bWaitAll [in]
If this parameter is TRUE, the function returns when the states of all objects in the pHandles array have been set to signaled and an input event has been received. If this parameter is FALSE, the function returns when the state of any one of the objects is set to signaled or an input event has been received. In this case, the return value indicates the object whose state caused the function to return.
FlashDance 2014-11-30
- 打赏
- 举报
unit UnitMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TFormMain = class(TForm)
btn1: TButton;
procedure btn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FormMain: TFormMain;
I: Integer;
implementation
{$R *.dfm}
uses UnitMyThread;
const
ClientExeName = 'Hash.exe';
var
MyThread1: TMyThread;
H: array [0 .. 0] of THandle;
procedure TFormMain.FormCreate(Sender: TObject);
var
StartupInfo: TStartUpInfo;
ProcessInfo: TProcessInformation;
begin
MyThread1 := TMyThread.Create;
H[0] := MyThread1.Handle;
FillChar(StartupInfo, SizeOf(StartupInfo), 0);
with StartupInfo do
begin
cb := SizeOf(StartupInfo);
dwFlags := StartF_UsesTDHandles or STARTF_USESHOWWINDOW;
lpTitle := nil;
wShowWindow := SW_Show;
end;;
if not CreateProcess(PChar(ExtractFilePath(ParamStr(0)) + ClientExeName), nil,
nil, nil, True, DETACHED_PROCESS, nil, nil, StartupInfo, ProcessInfo) then
begin
Application.MessageBox('无法启动客户端', '找不到客户端程序', MB_ICONERROR);
end;
end;
procedure TFormMain.btn1Click(Sender: TObject);
begin
MyThread1.Terminate;
ShowMessage(IntToStr(MsgWaitForMultipleObjects(1, H, True, INFINITE,
QS_ALLINPUT) - WAIT_OBJECT_0));
ShowMessage(IntToStr(I));
end;
end.
unit UnitMyThread;
interface
uses
System.Classes, System.SysUtils;
type
TMyThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
public
constructor Create;
end;
implementation
{ TMyThread }
uses UnitMain;
constructor TMyThread.Create;
begin
inherited Create(False);
FreeOnTerminate := True;
end;
procedure TMyThread.Execute;
var
I: Integer;
begin
I := 0;
while not Terminated do
begin
Sleep(100);
Inc(I);
end;
Sleep(2000);
UnitMain.I := I;
end;
end.
pathletboy 2014-11-30
- 打赏
- 举报
你这个代码是啥问题我不清楚，但是你上个代码的问题基本是因为这样。
首先你在线程中使用Synchronize同步到主线程进行更新Form的Caption，然后你又在主线程中阻塞等待线程结束，这样会造成死锁。
按下按钮死锁是这样发生的：
线程等待同步到主线程更新Caption，此时你主线程处理按下按钮，主线程永久等待在WaitFor，而线程又永久等待同步到主线，导致死锁。
FlashDance 2014-11-30
- 打赏
- 举报
搞个最简重现的工程吧，光看你这么描述，实在解决不了。[/quote]
搞了保卫战最简的重现工程，这次彻底凌乱了，情况和上面不同了，这次是WaitForSingleObject完全不起任何作用：
unit UnitMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TFormMain = class(TForm)
btn1: TButton;
procedure btn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FormMain: TFormMain;
implementation
{$R *.dfm}
uses UnitMyThread;
const
ClientExeName='Hash.exe';
var
MyThread1:TMyThread;
H:array[0..0] of THandle;
procedure TFormMain.FormCreate(Sender: TObject);
var
StartupInfo: TStartUpInfo;
ProcessInfo: TProcessInformation;
begin
MyThread1:=TMyThread.Create;
H[0]:=MyThread1.Handle;
{FillChar(StartupInfo, SizeOf(StartupInfo), 0);
with StartupInfo do
begin
cb := SizeOf(StartupInfo);
dwFlags := StartF_UsesTDHandles or STARTF_USESHOWWINDOW;
lpTitle := nil;
wShowWindow := SW_Show;
end;;
if not CreateProcess(PChar(ExtractFilePath(ParamStr(0)) + ClientExeName), nil,
nil, nil, True, DETACHED_PROCESS, nil, nil, StartupInfo, ProcessInfo) then
begin
Application.MessageBox('无法启动客户端', '找不到客户端程序', MB_ICONERROR);
end;}
end;
procedure TFormMain.btn1Click(Sender: TObject);
begin
MyThread1.Terminate;
//MsgWaitForMultipleObjects 完全不起作用了
ShowMessage(IntToStr(MsgWaitForMultipleObjects(1,H,True,INFINITE,QS_ALLINPUT)-WAIT_OBJECT_0));
end;
end.
unit UnitMyThread;
interface
uses
System.Classes,System.SysUtils
;
type
TMyThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
public
constructor Create;
end;
implementation
{ TMyThread }
uses UnitMain;
constructor TMyThread.Create;
begin
inherited Create(False);
FreeOnTerminate := True;
end;
procedure TMyThread.Execute;
var
I:Integer;
begin
I:=0;
while not Terminated do
begin
Sleep(100);
Inc(I);
Synchronize(
procedure
begin
FormMain.Caption:=IntToStr(I);
end);
end;
Sleep(2000);
end;
end.
pathletboy 2014-11-30
- 打赏
- 举报
搞个最简重现的工程吧，光看你这么描述，实在解决不了。
FlashDance 2014-11-29
- 打赏
- 举报
用WaitForSingleObject竟然结果也是一样的，受到了CreateProcess的干扰，H明明是GetFileThread.Handle，和CreateProcess无关啊
var
H:THandle;
begin
H:=GetFileThread.Handle;
GetFileThread.Terminate;
WaitForSingleObject(H,INFINITE);
ShowMessage('Finish');
end;
FlashDance 2014-11-28
- 打赏
- 举报
你看看是不是你线程中执行进程阻塞了？[/quote]
和那没关系，Sleep(5000)本来就是5秒的阻塞
没有Sleep(5000)，线程在GetFileThread.Terminate时很快就结束了，反而无法测试
单独执行线程完全正常，CreateProcess才造成的影响
现在的问题不是线程，也不是外部进程，是它们的内核对象产生了干扰
估计是MsgWaitForMultipleObjects检测内核对象时，受到CreateProcess句柄影响了
MsgWaitForMultipleObjects的句柄是H,它分明是GetFileThread.Handle和外部程序无关的
pathletboy 2014-11-28
- 打赏
- 举报
你看看是不是你线程中执行进程阻塞了？
FlashDance 2014-11-28
- 打赏
- 举报
现在的问题是：
单独执行线程，完全没问题
单独执行外部程序，也完全没问题
同时处理，问题来了
FlashDance 2014-11-28
- 打赏
- 举报
这个肯定是有的，不然Sleep(5000)也不可能受之影响了，问题是【CreateProcess】、【MsgWaitForMultipleObjects】与线程冲突了
pathletboy 2014-11-28
- 打赏
- 举报
GetFileThread.Terminate;
Terminate只是设置一个变量为True。
procedure TThread.Terminate;
begin
FTerminated := True;
end;procedure TMyThread.Execute;
begin
while not Terminated do
begin
//balabala
end;
end;
