如何为PopupList.Window挂钩WH_KEYBOARD？监听F11终止程序报错

我需要在托盘图标的PopupMenu打开时检测F11按键并终止程序，不想使用RegisterHotKey。根据文档说明，PopupList.Window可获取处理弹出菜单消息的隐藏窗口句柄，因此我计划拦截该窗口的键盘消息，但运行时触发了以下异常：

Project Project2.exe 触发异常类 $C0000005，消息为
'access violation at 0x00020003: write of address 0x2014fd38'。

原代码 #

unit Unit2;

interface

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

type
    TForm2 = class(TForm)
        TrayIcon1: TTrayIcon;
        PopupMenu1: TPopupMenu;
        N11: TMenuItem;
        N21: TMenuItem;
        ImageList1: TImageList;
        procedure PopupMenu1Popup(Sender: TObject);
private
    function hook(code: Integer; w: WPARAM; p : LPARAM): Lresult stdcall;
public
    { Public declarations }
end;

var
    Form2: TForm2;
    HookID: hhook;
implementation

{$R *.dfm}
function TForm2.hook(code: Integer; w: WPARAM; p: LPARAM): Lresult stdcall;
begin
    if code < 0 then
    begin
        Result := CallNextHookEx(0, code, w, p);
        Exit;
    end;

    Result := CallNextHookEx(0, code, w, p);
end;

procedure TForm2.PopupMenu1Popup(Sender: TObject);
begin
    HookID := SetWindowsHookEx(WH_KEYBOARD, @TForm2.hook, 0,
        GetWindowThreadProcessId(PopupList.Window, nil));
end;

end.

你的代码存在三个核心问题导致访问冲突：

1. 成员函数指针不兼容钩子要求：@TForm2.hook是类成员函数指针，隐含Self参数，但钩子函数要求无隐含参数的标准stdcall函数，栈结构不匹配引发内存访问错误。
2. 钩子未卸载：每次弹出菜单都安装新钩子，无卸载逻辑导致钩子堆积。
3. 缺少按键检测逻辑：原钩子仅传递消息，未实现F11检测功能。

修正后的代码 #

unit Unit2;

interface

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

type
    TForm2 = class(TForm)
        TrayIcon1: TTrayIcon;
        PopupMenu1: TPopupMenu;
        N11: TMenuItem;
        N21: TMenuItem;
        ImageList1: TImageList;
        procedure PopupMenu1Popup(Sender: TObject);
        procedure PopupMenu1Close(Sender: TObject);
    private
        class function HookProc(code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT stdcall; static;
        class var HookID: HHOOK;
    public
        { Public declarations }
    end;

var
    Form2: TForm2;

implementation

{$R *.dfm}

class function TForm2.HookProc(code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT stdcall;
begin
    if code >= HC_ACTION then
    begin
        // 检测F11按键按下（lParam第31位为0表示按键按下状态）
        if (wParam = VK_F11) and ((lParam and (1 shl 31)) = 0) then
        begin
            // 终止程序
            Halt;
        end;
    end;

    // 传递消息给后续钩子
    Result := CallNextHookEx(HookID, code, wParam, lParam);
end;

procedure TForm2.PopupMenu1Popup(Sender: TObject);
var
    ThreadID: DWORD;
begin
    ThreadID := GetWindowThreadProcessId(PopupList.Window, nil);
    // 传入当前模块句柄HInstance，符合API要求
    HookID := SetWindowsHookEx(WH_KEYBOARD, @HookProc, HInstance, ThreadID);
end;

procedure TForm2.PopupMenu1Close(Sender: TObject);
begin
    if HookID <> 0 then
    begin
        UnhookWindowsHookEx(HookID);
        HookID := 0;
    end;
end;

end.

关键修改说明 #

• 将钩子函数改为static类函数，消除隐含的Self参数，匹配钩子函数的调用约定。
• 给PopupMenu1添加OnClose事件，在菜单关闭时卸载钩子，避免钩子泄漏。
• 新增F11按键检测逻辑，触发时调用Halt终止程序。
• 调用SetWindowsHookEx时传入HInstance（当前模块实例句柄），符合API规范。

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