I'm starting an executable with CreateProcess, if it does not terminate within 3 seconds (testing) I'm sending it a WM_CLOSE
Code is based on the SO URLs in the source.
Issue:
- The SendWMCloseEnumFunc does its thing and sends a WM_CLOSE
- The program does not respond to the WM_CLOSE (within 2 seconds)
- I subsequently kill it with TerminateProcess (the exception with indicator '(2)' is raised)
It is as if I'm sending the WM_CLOSE to the wrong process, but I don't see my error here?
function SendWMCloseEnumFunc(hHwnd:HWND; dwData:LPARAM): Boolean;
var vID:NativeInt;
begin
GetWindowThreadProcessID(hHwnd, @vID);
if vID = dwData then
begin
PostMessage(hHwnd, WM_CLOSE, 0, 0); // Tell window to close gracefully
Result := False; // Can stop enumerating
end
else
Result := TRUE; // Keep enumerating
end;
procedure ExecAndWait(const ACmdLine: String);
// https://stackoverflow.com/questions/30003135/optimal-try-finally-placement-for-createprocess-waitforsingleobject-close
var
pi: TProcessInformation;
si: TStartupInfo;
lResult: DWord;
begin
FillChar(si, SizeOf(si), 0);
si.cb := SizeOf(si);
si.dwFlags := STARTF_USESHOWWINDOW;
si.wShowWindow := SW_NORMAL; // @@ Of FALSE?
if not CreateProcess(nil, // Application blank, then:
PChar(ACmdLine), // Full commandline
nil, // ProcessAttributes
nil, // ThreadAttributes
False, // InheritHandles
CREATE_NEW_PROCESS_GROUP + NORMAL_PRIORITY_CLASS, // CreationFlags
nil, // Environment
nil, // Directory; current if blank
si, // StartupInfo
pi) then // ProcessInformation
RaiseLastOSError;
try
lResult := WaitForSingleObject(pi.hProcess, 3000); // @@Test 3 sec. Wij nemen 10 minuten = 10*60*1000
if lResult = WAIT_TIMEOUT then
begin
// https://stackoverflow.com/questions/9428456/how-to-terminate-a-process-created-by-createprocess
// https://stackoverflow.com/questions/268208/delphi-gracefully-closing-created-process-in-service-using-tprocess-create
// Try it nicely:
EnumWindows(@SendWMCloseEnumFunc, pi.dwProcessId);
if WaitForSingleObject(pi.hProcess, 2000) <> WAIT_OBJECT_0 then
begin
// Force termination:
if TerminateProcess(pi.hProcess,lResult) then
raise Exception.Create('Verwerking afgebroken (2)')
else
raise Exception.Create('Verwerking afgebroken - process niet gestopt (' + IntToStr(lResult) + ')');
end
else
raise Exception.Create('Verwerking afgebroken (1)');
end
else
begin
GetExitCodeProcess(pi.hProcess,lResult);
if lResult <> 0 then
raise Exception.Create('Het externe proces is gestopt met exit code ' + IntToStr(lResult));
end;
finally
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
end;
end;
The program that gets called has a WindowProc to monitor WM_CLOSE coming in and that does not seem to trigger:
procedure TFrmExternalProgram.CommonWindowProc(var Message: TMessage);
begin
if Message.Msg = WM_CLOSE then
begin
Memo1.Lines.Add('WM_CLOSE');
Sleep(500);
end;
SaveProc(Message); // Call the original handler for the other form
end;
procedure TFrmExternalProgram.FormCreate(Sender: TObject);
begin
SaveProc := WindowProc;
WindowProc := CommonWindowProc;
end;
procedure TFrmExternalProgram.FormDestroy(Sender: TObject);
begin
WindowProc := SaveProc;
end;
procedure TFrmExternalProgram.FormShow(Sender: TObject);
var i,pc: integer;
begin
Memo1.Lines.Clear;
pc := ParamCount;
if pc = 0 then
Memo1.Lines.Add('- No arguments-')
else
begin
Memo1.Lines.Add('Called with ' + IntToStr(pc)+ ' parameters:');
Memo1.Lines.Add('');
for i := 1 to pc do
Memo1.Lines.Add(ParamStr(i));
end;
end;
But if I start this 'External program' from the comamnd line and kill it from task manager I don't see the 'WM_CLOSE' memo line either (also not when I had this debug message in the FormCloseQuery).
What am I overlooking?
This is a 32-bit app under Windows 10.