Delphi 10.2: 32bit: Form 不处理 SHELLHOOK 消息，为什么不呢？答案

【问题标题】：Delphi 10.2: 32bit: Form does not handle SHELLHOOK messages, why not?Delphi 10.2: 32bit: Form 不处理 SHELLHOOK 消息，为什么不呢？
【发布时间】：2018-07-08 19:54:38
【问题描述】：

问题已解决，请参阅我的回答，但由于堆栈溢出的 2 天规则，目前无法接受。感谢大家的投入！

edit：答案被删除，答案是删除行：

function  registerWindowMessage( lpString : PChar ) : integer; stdcall; external user32 name 'RegisterWindowMessageA';

来自项目，因为它已经在delphi windows api文件中定义，就是这样。不需要重新定义，而且重新定义的版本也不匹配。

我尝试将一些旧的 Delphi 5 Enterprise（32 位）项目恢复/迁移到新的/现代的 Delphi 版本（Delphi 10.2、32 位），但是旧版本可以在任何操作系统上编译和运行。总的来说，相当兼容。

现在我遇到了这个奇怪的问题，Delphi 10.2 表单不喜欢处理SHELLHOOK 消息，旧编译的 Delphi 5 版本可以。因为我没有 Delphi 10.2（免费版）forms.pas 的来源，所以我看不到实际发生了什么（不同），也无法弄清楚为什么它不起作用。无法调试。

钩子注册似乎没问题，FormCreate 中的writeln 显示以下值（在额外的控制台窗口中）：

但是overrided WndProc 过程不处理任何shellhook 消息。我做了一个演示，您可以自己尝试创建一个新项目，双击表单的onCreate 和onDestroy 事件并将表单代码替换为：

unit main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

const
  // Constant for shell hook events
 HSHELL_WINDOWCREATED = 1;
 HSHELL_WINDOWDESTROYED = 2;
 HSHELL_ACTIVATESHELLWINDOW = 3;
 HSHELL_WINDOWACTIVATED = 4;
 HSHELL_GETMINRECT = 5;
 HSHELL_REDRAW = 6;
 HSHELL_TASKMAN = 7;
 HSHELL_LANGUAGE = 8;
 HSHELL_ACCESSIBILITYSTATE = 11;


type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
    FHookMsg : integer;

    procedure WMShellHook(var Msg: TMessage );


  protected
    procedure WndProc(var Msg : TMessage); override;

  public
    { Public declarations }
  end;

var
  Form1: TForm1;


 // Not implemented Windows API functions, available at WinXP and later
function  registerWindowMessage( lpString : PChar ) : integer; stdcall; external user32 name 'RegisterWindowMessageA';
function  registerShellHookWindow( hWnd : THandle ) : bool;    stdcall; external user32 name 'RegisterShellHookWindow';
function  deregisterShellHookWindow( hWnd : THandle ) : bool;  stdcall; external user32 name 'DeregisterShellHookWindow';


implementation

{$R *.dfm}

procedure TForm1.FormActivate(Sender: TObject);
begin
   // send a message
  sendMessage( handle, WM_USER+$40, 1, 2 );
  postMessage( handle, WM_USER+$40, 3, 4 );
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 writeln( handle );
 FHookMsg:=registerWindowMessage('SHELLHOOK'+#0 );
 writeln( FHookMsg );
 writeln( registerShellHookWindow( handle ) );
 writeln( handle );  // handle still the same
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  deregisterShellHookWindow( handle );
  writeln( handle ); // set breakpoint here, handle still the same
end;

procedure TForm1.FormShow(Sender: TObject);
begin
 writeln( handle ); // handle still the same
end;

procedure TForm1.WndProc(var Msg : TMessage);
begin
 // writeln( handle );  even when i showed this, handle is still the same
 if( Msg.Msg = WM_USER+$40 ) then
  begin
   writeln( 'wParam is: ', Msg.wParam );
   writeln( 'lParam is: ', Msg.lParam );
   exit;
  end;

 if( Msg.Msg = FHookMsg ) then
  begin
     // Not executed in Delphi 10.2 generated exe
    writeln( 'wParam is: ', Msg.wParam );
    WMShellHook( Msg );
    exit;
  end;

  inherited; // call this for default behaviour
end;

procedure TForm1.WMShellHook( var Msg: TMessage );
begin
 // Simple however effective way to detect window changes at low costs.
  if( Msg.wparam = HSHELL_WINDOWCREATED )
    or ( Msg.wparam = HSHELL_WINDOWDESTROYED )
     or ( Msg.wparam = HSHELL_WINDOWACTIVATED ) then
      begin
        // Not executed in Delphi 10.2 generated exe
       writeln('here' );
      end;
end;



end.

PS：不要忘记打开链接器选项“生成控制台应用程序”以避免在运行此演示时出现 writeln 错误。

有人能说出发生了什么以及为什么它不起作用吗？

编辑： allocateHwnd 和 deallocateHwnd 的示例没有收到任何内容。为什么不？关注this 示例。

unit unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

const
  // Constant for shell hook events
 HSHELL_WINDOWCREATED = 1;
 HSHELL_WINDOWDESTROYED = 2;
 HSHELL_ACTIVATESHELLWINDOW = 3;
 HSHELL_WINDOWACTIVATED = 4;
 HSHELL_GETMINRECT = 5;
 HSHELL_REDRAW = 6;
 HSHELL_TASKMAN = 7;
 HSHELL_LANGUAGE = 8;
 HSHELL_ACCESSIBILITYSTATE = 11;


type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FHookWndHandle : THandle;
    FHookMsg       : integer;

    procedure WMShellHook(var Msg: TMessage );

  protected
    procedure WndMethod(var Msg: TMessage);

  public
    { Public declarations }
  end;

var
  Form1: TForm1;


 // Not implemented Windows API functions, available at WinXP and later
function  registerWindowMessage( lpString : PChar ) : integer; stdcall; external user32 name 'RegisterWindowMessageA';
function  registerShellHookWindow( hWnd : THandle ) : bool;    stdcall; external user32 name 'RegisterShellHookWindow';
function  deregisterShellHookWindow( hWnd : THandle ) : bool;  stdcall; external user32 name 'DeregisterShellHookWindow';


implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 FHookWndHandle:=allocateHWnd(WndMethod);
 FHookMsg:=registerWindowMessage('SHELLHOOK'+#0 );
 writeln( FHookMsg );
 writeln( registerShellHookWindow( FHookWndHandle ) );
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  deregisterShellHookWindow( FHookWndHandle );
  deallocateHWnd( FHookWndHandle );
end;


procedure TForm1.WndMethod(var Msg: TMessage);
begin
 if( Msg.Msg = FHookMsg ) then
  begin
     // Not executed in Delphi 10.2 generated exe
    writeln( 'wParam is: ', Msg.wParam );
    WMShellHook( Msg );
    exit;
  end;
end;

procedure TForm1.WMShellHook( var Msg: TMessage );
begin
 // Simple however effective way to detect window changes at low costs.
  if( Msg.wparam = HSHELL_WINDOWCREATED )
    or ( Msg.wparam = HSHELL_WINDOWDESTROYED )
     or ( Msg.wparam = HSHELL_WINDOWACTIVATED ) then
      begin
        // Not executed in Delphi 10.2 generated exe
       writeln('here' );
      end;
end;



end.

【问题讨论】：

标签： windows forms delphi winapi delphi-10.2-tokyo

【解决方案1】：

function  registerWindowMessage( lpString : PChar ) : integer; stdcall;
  external user32 name 'RegisterWindowMessageA';

此声明在 ANSI 版本的 Delphi 中是正确的，但在 Unicode Delphi 中是错误的。在 Unicode Delphi 中，您应该使用 W 版本的函数。就目前而言，您的版本将 UTF16 文本发送到需要 ANSI 的函数，并且不匹配意味着该函数将接收到错误的消息名称。像这样更正它：

function  registerWindowMessage( lpString : PChar ) : integer; stdcall; 
  external user32 name 'RegisterWindowMessageW';

这可能是最重要的问题。由于这种文本编码不匹配，您将注册一个名称错误的窗口消息，因此不会收到您期望的消息。

还要注意返回类型应该是UINT。您应该更改它以及FHookMsg 的类型，尽管这样做实际上不会改变任何行为。

VCL 窗口控件受窗口重新创建的影响。发生这种情况的原因有很多，但是表单背后的窗口句柄可以在表单生命周期的任何时候被销毁和重新创建。

您的代码一直是错误的，但您似乎侥幸逃脱。有两种解决方案：

在覆盖的CreateWnd 或DestroyWnd 中注册和注销挂钩。
使用非 VCL 窗口处理挂钩。使用AllocateHWnd 和DeallocateHWnd。

我个人认为第二种选择更可取。

这些是我可以在提供的代码中看到的错误。还有其他可能的问题。您将这描述为发生在控制台应用程序中，但我们当然看不到您如何创建表单、如何运行消息循环等等。所以我想代码中很可能还有其他我们看不到的错误。

【讨论】：

【解决方案2】：

将RegisterWindowMessage 的声明更改为：

function RegisterWindowMessage( lpString : PChar ) : integer; stdcall; external user32 name 'RegisterWindowMessageW';

【讨论】：