使用 CreateProcess 启动的程序未收到 WM_CLOSE

Program started with CreateProcess does not receive WM_CLOSE

我正在使用 CreateProcess 启动一个可执行文件,如果它没有在 3 秒内终止(测试),我将向它发送 WM_CLOSE
代码基于源中的 SO URL。

问题:

好像我将 WM_CLOSE 发送到错误的进程,但我在这里没有看到我的错误?

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

被调用的程序有一个 WindowProc 来监视 WM_CLOSE 进入,但似乎没有触发:

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;

但是如果我从comamnd行启动这个'External program'并从任务管理器中杀死它,我也看不到'WM_CLOSE'备忘录行(当我在FormCloseQuery).

我忽略了什么?
这是 Windows 10.

下的 32 位应用程序

因为TerminateProcess没有发送任何消息。它只是简单地终止了进程。

WM_CLOSE 仅当您通过单击关闭按钮或从另一个程序手动将其发送到程序的主 window 时才有效。

A Delphi VCL 应用程序默认至少有 2 HWNDs,TApplication window 和 MainForm window .您仅将 WM_CLOSE 消息发送给您找到的第一个 HWND。您 假设 HWND 是您的 TFrmExternalProgram window,但 可能TApplication window 代替。在向 WM_CLOSE 发送 WM_CLOSE 之前,您没有验证 HWND 的 class/title。仅检查其进程 ID 是不够的,除非您将找到的每个 HWND 发送给

此外,您的回调与 EnumWindows() 期望的签名不匹配。它的 return 值需要使用 Windows.BOOL(4 个字节)而不是 System.Boolean(1 个字节)。并且需要使用 stdcall 调用约定声明,而不是 Delphi 默认 register 调用约定。

试试这个:

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;

顺便说一句,你应该考虑使用 EnumThreadWindows() 而不是 EnumWindows()EnumWindows() 枚举所有进程的所有顶级 windows,而 EnumThreadWindows() 仅枚举指定线程的顶级 windows。由于你已经知道CreateProcess()创建的主线程的ID,你可以使用EnumThreadWindows()来减少你需要查看的windows的数量。

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;

如果您不关心触发表单的 OnClose(Query) 事件,您也可以只 post 向线程的消息队列发送 WM_QUIT 消息,这样就不会必须枚举它的windows。

procedure ExecAndWait(const ACmdLine: String);
var
  pi: TProcessInformation;
  ...
begin
  ...
  PostThreadMessage(pi.dwThreadId, WM_QUIT, 0, 0);
  ...
end;

但是,如果您这样做 post WM_CLOSE,那么至少要考虑重写表单的虚拟 WndProc() 方法,而不是子类化其 WindowProc 属性。

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;

或者,只使用表单的 OnClose(Query) 事件,它已经响应了 WM_CLOSE 条消息。

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;