Delphi 11中实现全局钩子为Windows程序加系统菜单项失败

核心错误点 #

• 宿主卸载钩子方式错误：UnhookWindowsHookEx需要传入SetWindowsHookEx返回的钩子句柄，而非钩子类型WH_CBT，错误调用会导致钩子无法释放，阻塞程序启动。
• 钩子函数未处理异常Code：当Code参数小于0时，必须直接返回CallNextHookEx结果，否则会破坏钩子链正常执行。
• 窗口修改时机过早：HCBT_CREATEWND阶段窗口尚未完全初始化，此时修改系统菜单易引发异常。
• 冗余的窗口样式修改：已获取系统菜单句柄的情况下，SetWindowLong设置WS_SYSMENU属于多余操作，可能干扰窗口初始化。

修复后的代码 #

1. 宿主应用代码修改 #

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  CodeSiteLogging;

type
  THookProc = function(Code: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
  TSetHookHandle = procedure(NewHookHandle: HHOOK); stdcall;

var
  DLLHandle: HMODULE;
  HookProc: THookProc;
  hHook: HHOOK; // 保存钩子句柄

procedure TForm1.FormDestroy(Sender: TObject);
begin
  // 正确卸载钩子
  if hHook <> 0 then
    UnhookWindowsHookEx(hHook);
  if DLLHandle <> 0 then
    FreeLibrary(DLLHandle);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  SetHookHandleProc: TSetHookHandle;
begin
  DLLHandle := LoadLibrary('SystemMenuHookDLL.dll');
  CodeSite.Send('TForm1.FormCreate: DLLHandle', DLLHandle);
  if DLLHandle <> 0 then
  begin
    @HookProc := GetProcAddress(DLLHandle, 'HookFunc');
    CodeSite.Send('TForm1.FormCreate: @HookProc', @HookProc);
    if Assigned(HookProc) then
    begin
      CodeSite.Send('TForm1.FormCreate: Assigned');
      hHook := SetWindowsHookEx(WH_CBT, HookProc, DLLHandle, 0);
      // 传递钩子句柄给DLL
      @SetHookHandleProc := GetProcAddress(DLLHandle, 'SetHookHandle');
      if Assigned(SetHookHandleProc) and (hHook <> 0) then
        SetHookHandleProc(hHook);
    end;
  end;
end;

end.

2. DLL代码修改 #

library SystemMenuHookDLL;

uses
  Winapi.Windows,
  System.SysUtils,
  System.Classes;

{$R *.res}

// 共享数据段传递钩子句柄
const
  SHARED_SECTION = 'SharedHookData';
var
  hHook: HHOOK;
{$SECTION SHARED_SECTION READ WRITE SHARED}
{$SECTION SHARED_SECTION READ WRITE}

function AddMenuItem(WindowHandle: HWND): Boolean;
var
  MenuHandle: HMENU;
  MenuItemID: UINT;
begin
  Result := False;
  MenuHandle := GetSystemMenu(WindowHandle, False);
  if MenuHandle <> 0 then
  begin
    // 使用独特ID避免冲突
    MenuItemID := $00001001;
    AppendMenu(MenuHandle, MF_STRING, MenuItemID, 'My Menu Item');
    DrawMenuBar(WindowHandle);
    Result := True;
  end;
end;

function HookFunc(Code: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
begin
  // 优先处理异常Code
  if Code < 0 then
  begin
    Result := CallNextHookEx(hHook, Code, WParam, LParam);
    Exit;
  end;

  // 改用窗口激活时机，确保初始化完成
  if Code = HCBT_ACTIVATE then
  begin
    AddMenuItem(HWND(WParam));
  end;

  Result := CallNextHookEx(hHook, Code, WParam, LParam);
end;

// 导出设置钩子句柄的函数
procedure SetHookHandle(NewHookHandle: HHOOK); stdcall;
begin
  hHook := NewHookHandle;
end;

exports 
  HookFunc,
  SetHookHandle;

begin
  hHook := 0;
end.

额外注意事项 #

• 确保DLL与宿主同为32位编译，否则无法拦截32位程序。
• 自定义菜单ID需避开目标程序内置ID，建议使用较大数值。
• 全局钩子会影响所有同架构程序，测试时需谨慎操作。

内容的提问来源于stack exchange，提问作者user1580348