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.
CodePudding user response:
Because TerminateProcess
not sending any messages. It simply, well, terminates the process.
WM_CLOSE
valid only if you send it to main window of your program, either by clicking close button or manually from another program.
CodePudding user response:
A Delphi VCL app has at least 2 HWND
s initially by default, the TApplication
window and the MainForm
window. You are sending the WM_CLOSE
message only to the 1st HWND
you find. You are assuming that HWND
is your TFrmExternalProgram
window, but it MIGHT be the TApplication
window instead. You are not validating the HWND
's class/title before sending WM_CLOSE
to it. Checking its process ID alone is not enough, unless you send to every HWND
you find.
Also, your callback does not match the signature that EnumWindows()
expects. It needs to use Windows.BOOL
(4 bytes) instead of System.Boolean
(1 byte) for its return value. And it needs to be declared with the stdcall
calling convention, not Delphi default register
calling convention.
Try this instead:
function SendWMCloseEnumFunc(hHwnd:HWND; dwData:LPARAM): BOOL; stdcall;
var
ProcessID: DWORD;
WndClassName: array[0..23] of Char;
begin
GetWindowThreadProcessID(hHwnd, @ProcessID);
if ProcessID = dwData then
begin
GetClassName(hHwnd, WndClassName, Length(WndClassName));
if StrComp(WndClassName, 'TFrmExternalProgram') = 0 then
begin
PostMessage(hHwnd, WM_CLOSE, 0, 0); // Tell window to close gracefully
Result := False; // Can stop enumerating
Exit;
end;
end;
Result := True; // Keep enumerating
end;
BTW, you should consider using EnumThreadWindows()
instead of EnumWindows()
. EnumWindows()
enumerates all top-level windows of all processes, whereas EnumThreadWindows()
enumerates top-level windows of just the specified thread. Since you already know the ID of the main thread that CreateProcess()
created, you can use EnumThreadWindows()
to reduce the number of windows you need to look at.
function SendWMCloseEnumFunc(hHwnd:HWND; dwData:LPARAM): BOOL; stdcall;
var
WndClassName: array[0..23] of Char;
begin
GetClassName(hHwnd, WndClassName, Length(WndClassName));
if StrComp(WndClassName, 'TFrmExternalProgram') = 0 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);
var
pi: TProcessInformation;
...
begin
...
EnumThreadWindows(pi.dwThreadId, @SendWMCloseEnumFunc, 0);
...
end;
If you don't care about triggering the Form's OnClose(Query)
events, you could alternatively just post a WM_QUIT
message to the thread's message queue instead, then you won't have to enumerate its windows at all.
procedure ExecAndWait(const ACmdLine: String);
var
pi: TProcessInformation;
...
begin
...
PostThreadMessage(pi.dwThreadId, WM_QUIT, 0, 0);
...
end;
But, if you do post WM_CLOSE
, then at least consider overriding the Form's virtual WndProc()
method instead of subclassing its WindowProc
property.
protected
procedure WndProc(var Message: TMessage); override;
...
procedure TFrmExternalProgram.WndProc(var Message: TMessage);
begin
if Message.Msg = WM_CLOSE then
Memo1.Lines.Add('WM_CLOSE');
inherited; // Call the original handler
end;
Or, just use the Form's OnClose(Query)
events, which already respond to WM_CLOSE
messages.
procedure TFrmExternalProgram.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
Memo1.Lines.Add('OnCloseQuery');
end;
procedure TFrmExternalProgram.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Memo1.Lines.Add('OnClose');
end;