我想执行一个子进程并同步它(可能使用互斥体),而不等待子进程终止:
父级:
program Project1;
{$APPTYPE CONSOLE}
uses
Windows, ShellApi, SysUtils, Dialogs;
procedure ShellExecEx(Wnd: HWND; const AExeFilename, AParams: string);
const
SEE_MASK_NOZONECHECKS = $00800000;
SEE_MASK_WAITFORINPUTIDLE = $02000000;
SEE_MASK_NOASYNC = $00000100;
var
Info: TShellExecuteInfo;
begin
FillChar(Info, SizeOf(Info), 0);
Info.Wnd := Wnd;
Info.cbSize := SizeOf(Info);
Info.fMask := SEE_MASK_FLAG_NO_UI or SEE_MASK_NOZONECHECKS or
SEE_MASK_NOASYNC
//or SEE_MASK_WAITFORINPUTIDLE (works only with UI app ???)
//or SEE_MASK_NO_CONSOLE
//or SEE_MASK_NOCLOSEPROCESS
;
Info.lpVerb := '';
Info.lpFile := PChar(AExeFilename);
Info.lpParameters := PChar(AParams);
Info.lpDirectory := PChar(ExtractFilePath(AExeFilename));
Info.nShow := SW_SHOWNORMAL;
if not ShellExecuteEx(@Info) then
RaiseLastOSError;
CloseHandle(Info.hProcess);
end;
var
Mutex: THandle = 0;
Error: DWORD;
begin
OutputDebugString('Project1 : 1');
ShellExecEx(0, 'Project2.exe', '');
// synchronize
repeat
// attempt to create a named mutex
Mutex := CreateMutex(nil, False, 'F141518A-E6E4-4BC0-86EB-828B1BC48DD1');
Error := GetLastError;
if Mutex = 0 then RaiseLastOSError;
CloseHandle(Mutex);
until Error = ERROR_ALREADY_EXISTS;
OutputDebugString('Project1 : 3');
end.
child :
program Project2;
{$APPTYPE CONSOLE}
uses
SysUtils, Windows, Dialogs;
var
Mutex: THandle = 0;
begin
OutputDebugString('Project2 : 2');
// attempt to create a named mutex and acquire ownership
Mutex := CreateMutex(nil, True, 'F141518A-E6E4-4BC0-86EB-828B1BC48DD1');
if Mutex = 0 then RaiseLastOSError;
// do something
ReleaseMutex(Mutex);
CloseHandle(Mutex); // <- at this point Program1.exe should exit the repeat loop
ShowMessage('ok from Project2');
end.
我期望看到以下输出:
Project1 : 1
Project2 : 2
Project1 : 3
问题是有时父级 (Project1.exe) 不会退出循环。
我做错了什么?
最佳答案
你们在互斥锁上进行了一场竞赛。您希望出现以下顺序:
child: create mutex
parent: open mutex
child: destroy mutex
但是可能发生的是
child: create mutex
child: destroy mutex
parent: open mutex (fails because mutex is destroyed)
<小时/>
我不太清楚您的最终目标是什么,但我怀疑某个事件实际上就是您正在寻找的内容。
在父级中:
- 创建一个命名事件。
- 将事件设置为无信号。
- 创建子进程。
- 等待事件发出信号。
在 child 中:
- 进行一些处理。
- 打开指定的事件。
- 将事件设置为有信号,从而将父事件从等待中释放。
在非常高的层次上,您需要的代码将如下所示:
父级
Event = CreateEvent(nil, True, False, EventName);
//create it manual reset, set to non-signaled
ShellExecEx(....);
WaitForSingleObject(Event);
child
Event = CreateEvent(nil, True, False, EventName);
//do stuff
SetEvent(Event);
我没有包含任何错误检查。我相信你可以添加一些。您可能还会发现 SyncObjs
中的事件包装类更方便。
最后,您的代码有一个繁忙的循环。这几乎永远不是解决任何问题的方法。如果您发现自己编写了一个繁忙的循环,您应该将其视为设计不正确的信号。重点是,在您的代码中,如果可以使其正常工作,父进程在等待子进程时将消耗 100% 的 CPU 利用率。
关于delphi - 如何同步父/子进程执行?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/9414702/