Delphi 10.2: 32bit: Form does not handle SHELLHOOK messages, why not?

Question

Problem solved, refer to my answer, however cannot accept it right now because stack overflow's 2 day rule. Thanks for the input everbody!

edit: The answer is removed, the answer is to remove line:

function  registerWindowMessage( lpString : PChar ) : integer; stdcall; external user32 name 'RegisterWindowMessageA';

From the project because it is already defined in delphi windows api files, that's it. No need to redefine it and also the redefine does not match the newer version.

I try to revive/migrate some older Delphi 5 Enterprise (32bit) projects to a new/modern Delphi version (Delphi 10.2, 32bit) however the old versions compiles and run fine on any OS. Overall, pretty compatible.

Now I am running into this strange problem, the Delphi 10.2 form does not like to handle SHELLHOOK messages, the older compiled Delphi 5 version does. Because I don't have the source of Delphi 10.2 (free edition) forms.pas I can't see what is actually going on (different) and can't figure out why it doesn't work. Unable to debug it.

The hook registration seems to be fine, the writeln's in the FormCreate shows the following values (in extra console window):

However the overrided WndProc procedure does not handle any shellhook messages. I made a demo so you can try it yourself by creating a new project, double click on the form's onCreate and onDestroy event and replace the forms code with this:

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: Don't forget to switch linker option "generate console application" on to avoid writeln errors while running this demo.

Can somebody tell what's going on and why it doesn't work?

EDIT: Example with allocateHwnd and deallocateHwnd, does not receive anything. Why not? Followed this example.

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.

David Heffernan · Answer 1 · 2018-07-09T07:42:22.703

function  registerWindowMessage( lpString : PChar ) : integer; stdcall;
  external user32 name 'RegisterWindowMessageA';

This declaration is correct in ANSI versions of Delphi but incorrect in Unicode Delphi. In Unicode Delphi you should be using the W version of the function. As it stands your version sends UTF16 text to a function that expects ANSI and that mismatch means the wrong message name will be received by the function. Correct it like this:

function  registerWindowMessage( lpString : PChar ) : integer; stdcall; 
  external user32 name 'RegisterWindowMessageW';

That's probably the most important problem. Because of this text encoding mismatch you will be registering a window message with the wrong name and so won't receive the messages you expect.

Note also that the return type should be UINT. You should change this, and the type of FHookMsg, although doing so won't actually change any behaviour.

VCL windowed controls are subject to window recreation. There are plenty of reasons that it might happen, but the window handle behind the form can be destroyed and recreated at any point in the lifetime of the form.

Your code has always been wrong but you appear to have got away with it. There are two solutions:

Register and unregister the hook in overridden CreateWnd or DestroyWnd.
Use a non VCL window to handle the hook. Use AllocateHWnd and DeallocateHWnd.

Personally I regard the second option to be preferable.

Those are the mistakes that can I can see in the code provided. There are other possible problems. You describe this as happening inside a console application but of course we cannot see how you create the form, how you run the message loop and so on. So I guess there could well be other mistakes in the code that we cannot see.

score 1 · Answer 2 · edited Jul 08 '18 at 23:06

1

Change your declaration of RegisterWindowMessage to this:

function RegisterWindowMessage( lpString : PChar ) : integer; stdcall; external user32 name 'RegisterWindowMessageW';

edited Jul 08 '18 at 23:06

Remy Lebeau

555,201
31
458
770

answered Jul 08 '18 at 21:52

FredS

680
1
5
6

Delphi 10.2: 32bit: Form does not handle SHELLHOOK messages, why not?

2 Answers2