Delphi: Открыто ли системное меню?

Question

I Delphi Мне нужна функция, которая определяет, открывается ли системное меню (соответственно меню окна, меню, которое появляется при щелчке значка). Причина в том, что я пишу функцию анти-кейлоггера, которая отправляет мусор текущему активному editcontrol (это также предотвращает кейлоггер, который читает сообщения WinAPI для чтения содержимого). Но если открыто системное меню, то в панели управления editcontrol STILL есть фокус, поэтому мусор будет вызывать ярлыки.

Если я использую сообщение WM_INITMENUPOPUP в моем TForm1, я могу детерминированный, когда откроется системное меню, но я хочу, чтобы я не должен изменить TForm, так как я хочу, чтобы написать неофициальный визуальный компонент, который не делает нужны любые модификации самого класса TForm-дериватива.

//I do not want that solution since I have to modify TForm1 for that! 
procedure TForm1.WMInitMenuPopup(var Message: TWMInitMenuPopup); 
begin 
if message.MenuPopup=getsystemmenu(Handle, False) then 
begin 
    SystemMenuIsOpened := true; 
end; 
end; 

TApplicaton.HookMainWindow() не посылает WM_INITMENUPOPUP к моей функции крючков.

function TForm1.MessageHook(var Msg: TMessage): Boolean; 
begin 
Result := False; 
if (Msg.Msg = WM_INITMENUPOPUP) then 
begin 
// Msg.Msg IS NEVER WM_INITMENUPOPUP! 
if LongBool(msg.LParamHi) then 
begin 
    SystemMenuIsOpened := true; 
end; 
end; 
end; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
Application.HookMainWindow(MessageHook); 
end; 

procedure TForm1.FormDestroy(Sender: TObject); 
begin 
    Application.UnhookMainWindow(MessageHook); 
end; 

Даже после очень долгих исследований я не нашел никакой информации о том, как запрашивать, если меню системы открыто или нет. Я не нашел способа определить открытие + закрытие этого меню.

У кого-то есть решение для меня, пожалуйста?

С уважением
Daniel Marschall

Answer 1

Если вы не хотите каких-либо изменений в TForm-derivate-class, почему бы не попробовать простой способ Windows API реализовать свое текущее решение, то есть использовать SetWindowLongPtr() для перехвата сообщения WM_INITMENUPOPUP. Стиль Delphi VCL для перехвата сообщений - это просто оболочка этой функции Windows API.

Для этого используйте SetWindowLongPtr(), чтобы установить новый адрес для процедуры окна и получить первоначальный адрес процедуры окна одновременно. Не забудьте сохранить исходный адрес в переменной LONG_PTR. В 32-битном Delphi LONG_PTR был Longint; предположительно 64-bit Delphi будет выпущен в будущем, LONG_PTR должен быть Int64; Вы можете использовать директиву $IFDEF различать их следующим образом:

Type 
    {$IFDEF WIN32} 
    PtrInt = Longint; 
    {$ELSE} 
    PtrInt = Int64; 
    {$ENDIF} 
    LONG_PTR = PtrInt; 

Значение nIndex параметра будет использоваться для этой цели GWLP_WNDPROC. Кроме того, передайте новый адрес для оконной процедуры в параметр dwNewLong, например. LONG_PTR(NewWndProc). NewWndProc - это WindowProc Callback Function, который обрабатывает сообщения, где вы помещаете свои критерии перехвата и переопределяете обработку по умолчанию сообщения, которое вы собираетесь перехватывать.Функция обратного вызова может быть любым именем, но параметры должны соответствовать соглашению WindowProc.

Обратите внимание, что вы должны позвонить по номеру CallWindowProc() для передачи любых сообщений, не обработанных процедурой нового окна, в процедуру исходного окна.

Наконец, вы должны позвонить SetWindowLongPtr() еще раз в свой код, чтобы установить адрес измененного/нового процедуры окна обработчик назад к исходному адресу. Первоначальный адрес был сохранен ранее, как указано выше.

Был номер Delphi code example here. Он использовал SetWindowLong(), но теперь Microsoft рекомендует использовать SetWindowLongPtr(), чтобы сделать его совместимым с 32-разрядной и 64-разрядной версиями Windows.

SetWindowLongPtr() не существовало в Windows.pas Дельфы до Delphi 2009. Если вы используете старую версию Delphi, вы должны объявить его самостоятельно, или использовать JwaWinUser единицу JEDI API Library.

Answer 2

Не пробовал это сам, но дать этому выстрел:

Используйте GetMenuItemRect, чтобы получить прямоугольник для элемента 0 меню возвращенного GetSystemMenu. I (предположим!) GetMenuItemRect должен возвращать 0, если системное меню не открыто (потому что система не могла знать, какой пункт меню находится в списке, если только он не открыт?) Если результат отличен от нуля, проверьте, возможны ли согласованные координаты для данного разрешения экрана.

Если у вас есть время, вы можете посмотреть AutoHotKey's source code, чтобы увидеть how to monitor when system menu is open/closed.

Answer 3

Application.HookMainWindow не делает то, что вы, кажется, думаете. Он перехватывает скрытое окно приложения, а не основную форму. Чтобы перехватить WM_INITMENUPOPUP в определенной форме, вам нужно всего лишь написать обработчик, как вы видели.

Чтобы сделать это обобщенно для любого владельца формы компонента, можно назначить WindowProc свойство формы, чтобы разместить крюк:

unit FormHook; 

interface 

uses 
    Windows, Classes, SysUtils, Messages, Controls, Forms; 

type 
    TFormMessageEvent = procedure(var Message: TMessage; var Handled: Boolean) of object; 

    TFormHook = class(TComponent) 
    private 
    FForm: TCustomForm; 
    FFormWindowProc: TWndMethod; 
    FOnFormMessage: TFormMessageEvent; 
    protected 
    procedure FormWindowProc(var Message: TMessage); virtual; 
    public 
    constructor Create(AOwner: TComponent); override; 
    destructor Destroy; override; 
    published 
    property OnFormMessage: TFormMessageEvent read FOnFormMessage write FOnFormMessage; 
    end; 

procedure Register; 

implementation 

procedure Register; 
begin 
    RegisterComponents('Test', [TFormHook]); 
end; 

procedure TFormHook.FormWindowProc(var Message: TMessage); 
var 
    Handled: Boolean; 
begin 
    if Assigned(FFormWindowProc) then 
    begin 
    Handled := False; 

    if Assigned(FOnFormMessage) then 
     FOnFormMessage(Message, Handled); 

    if not Handled then 
     FFormWindowProc(Message); 
    end; 
end; 

constructor TFormHook.Create(AOwner: TComponent); 
begin 
    inherited Create(AOwner); 
    FFormWindowProc := nil; 
    FForm := nil; 
    while Assigned(AOwner) do 
    begin 
    if AOwner is TCustomForm then 
    begin 
     FForm := TCustomForm(AOwner); 
     FFormWindowProc := FForm.WindowProc; 
     FForm.WindowProc := FormWindowProc; 
     Break; 
    end; 
    AOwner := AOwner.Owner; 
    end; 
end; 

destructor TFormHook.Destroy; 
begin 
    if Assigned(FForm) and Assigned(FFormWindowProc) then 
    begin 
    FForm.WindowProc := FFormWindowProc; 
    FFormWindowProc := nil; 
    FForm := nil; 
    end; 
    inherited Destroy; 
end; 

end. 

Вы могли бы использовать этот компонент на форме:

procedure TForm1.FormHook1FormMessage(var Message: TMessage; var Handled: Boolean); 
begin 
    case Message.Msg of 
    WM_INITMENUPOPUP: 
     ... 
    end; 
end; 

Проблема может заключаться в том, что если в форме есть какие-либо другие компоненты, которые делают то же самое, тогда вам нужно убедиться, что отцепление происходит в обратном порядке (последний подключен, последний отцеплен). Вышеприведенный пример перехватывает конструктор и отцепляется в деструкторе; это, похоже, работает даже с несколькими экземплярами в одной и той же форме.