时间戳

首页 > 解决方案 > Delphi 10.2：32 位：表单不处理 SHELLHOOK 消息，为什么不呢？

windows - Delphi 10.2：32 位：表单不处理 SHELLHOOK 消息，为什么不呢？

问题描述

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

编辑：答案被删除，答案是删除行：

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 的来源，所以我看不到实际发生了什么（不同），也无法弄清楚为什么它不起作用。无法调试它。

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

看到了什么

但是，该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带有and的 示例deallocateHwnd，不接收任何内容。为什么不？按照这个例子。

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.

标签： windowsformsdelphiwinapidelphi-10.2-tokyo

解决方案

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 窗口控件受窗口重新创建的影响。它可能发生的原因有很多，但是表单后面的窗口句柄可以在表单生命周期的任何时候被销毁和重新创建。

您的代码一直是错误的，但您似乎已经摆脱了它。有两种解决方案：

  1. 在覆盖的CreateWnd或中注册和取消注册钩子DestroyWnd。
  2. 使用非 VCL 窗口来处理钩子。使用AllocateHWnd和DeallocateHWnd。

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

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

推荐阅读