Search code examples
delphiwinapidelphi-7

How to synchronize Parent/Child process execution?


I would like to execute a child process and synchronize it (possibly with Mutex) without waiting for the child process to terminate:

Parent:

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.

I'm expecting to see an output of:

Project1 : 1
Project2 : 2
Project1 : 3

Problem is that sometimes the Parent (Project1.exe) is not exiting the loop.
What am I doing wrong?


Solution

  • You have a race on the mutex. You are hoping for the following sequence:

    child:  create mutex
    parent: open mutex
    child:  destroy mutex
    

    But what can happen is

    child:  create mutex
    child:  destroy mutex
    parent: open mutex (fails because mutex is destroyed)
    

    I can't quite work out what your ultimate goal is but I have a suspicion that an event is actually what you are looking for.

    In the parent:

    1. Create a named event.
    2. Set the event to non-signaled.
    3. Create the child process.
    4. Wait until the event is signaled.

    In the child:

    1. Do some processing.
    2. Open the named event.
    3. Set the event to signaled, thereby releasing the parent from its wait.

    In very high level the code you need will look like this:

    Parent

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

    I've not included any error checking. I'm sure you can add some. You may also find that the event wrapper class in SyncObjs is more convenient.


    Finally, your code has a busy loop. That is almost never the solution to any problem. If ever you find yourself writing a busy loop you should take that as a signal that the design is incorrect. The point being that, in your code, if it could be made to work, the parent process would burn 100% CPU utilization whilst waiting on the child process.