Delphi: Is system menu opened?

Question

Hello.

I Delphi, I need a function which determinates if the system menu (resp. window menu, the menu that appears when the icon is clicked) is opened. The reason is that I am writing a anti-keylogger functionality which sends garbage to the current active editcontrol (this also prevents keylogger which read WinAPI messages to read the content). But if system-menu is opened, the editcontrol STILL has the focus, so the garbage will invoke shortcuts.

If I use message WM_INITMENUPOPUP in my TForm1, I can determinate when the system menu opens, but I wish that I do not have to change the TForm, since I want to write a non visual component, which does not need any modifications at the TForm-derivate-class itself.

//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() does not send the WM_INITMENUPOPUP to my hook function.

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;

Even after very long research I did not found any information about how to query if the system-menu is opened or not. I do not find any way to determinate the opening+closing of that menu.

Has someone a solution for me please?

Regards
Daniel Marschall

Answer 1

Not tried this myself, but give this a shot:

Use GetMenuItemRect to get the rect for item 0 of the menu returned by GetSystemMenu. I (assume!) GetMenuItemRect should return 0 if the system menu is not open (because system could not know the rect of the menu item unless it is open?) If the result is non-zero, check if the coords returned are possible for the given screen resolution.

If you have the time, you could look into AutoHotKey's source code to see how to monitor when system menu is open/closed.

Answer 2

If you don't want any modifications to TForm-derivate-class, why don't try pure Windows API way to implement your current solution, that is, use SetWindowLongPtr() to intercept the WM_INITMENUPOPUP message. Delphi VCL style to intercept messages is just a wrapper of this Windows API function actually.

For that purpose, use SetWindowLongPtr() to set a new address for the window procedure and to get the original address of the window procedure, both at one blow. Remember to store the original address in a LONG_PTR variable. In 32-bit Delphi, LONG_PTR was Longint; supposing 64-bit Delphi will have been released in the future, LONG_PTR should be Int64; you can use $IFDEF directive to distinguish them as follows:

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

The value for nIndex parameter to be used for this purpose is GWLP_WNDPROC. Also, pass the new address for the window procedure to dwNewLong parameter, e.g. LONG_PTR(NewWndProc). The NewWndProc is a WindowProc Callback Function that processes messages, it is where your put your intercept criteria and override the default handling of the message you are going to intercept. The callback function can be any name, but the parameters must follow the WindowProc convention.

Note that you must call CallWindowProc() to pass any messages not processed by the new window procedure to the original window procedure.

Finally, you should call SetWindowLongPtr() again somewhere in your code to set the address of modified/new window procedure handler back to the original address. The original address has been saved before as mentioned above.

There was a Delphi code example here. It used SetWindowLong(), but now Microsoft recommends to use SetWindowLongPtr() instead to make it compatible with both 32-bit and 64-bit versions of Windows.

SetWindowLongPtr() didn't exist in Windows.pas of Delphi prior to Delphi 2009. If you use an older version of Delphi, you must declare it by yourself, or use JwaWinUser unit of JEDI API Library.

Answer 3

Application.HookMainWindow doesn't do what you seem to think. It hooks the hidden application window, not the main form. To intercept WM_INITMENUPOPUP on a specific form, all you need to do is write a handler for it, as you have seen.

To do this generically for any owner form of a component, you could assign WindowProc property of the form to place the hook:

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.

You could then use this component on a form:

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

The problem might be that if the form has any other components which do the same thing then you need to make sure that unhooking happens in reverse order (last hooked, last unhooked). The above example hooks in the constructor and unhooks in the destructor; this seems to work even with multiple instances on the same form.