I'm new to Delphi and I try to write an experimental plugin for a program in Lazarus. I found a free source code from a different plugin and I try to base on it. My plugin should received the message sent by the program and insert a string into an edit line. So far I have managed to implement a handler to the program. However, I stuck with CopyDataStruct, which works with a message sent by the main program.
UPDATE
I think the feedback from Marco van de Voort might explain the source of the problem. I did some research after finding a tutorial and it seems that those messages are simply lost.
So that I rewrite my code including:
function WndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam; lParam: LParam):LRESULT; stdcall;
begin
case uMsg of WM_COPYDATA:
begin
Result := TForm1.WMCopyData();
exit;
end;
else
Result := CallWindowProc(PrevWndProc, Ahwnd, uMsg, WParam, LParam);
end;
end;
as well as
PrevWndProc:=Windows.WNDPROC(SetWindowLongPtr(Self.Handle,GWL_WNDPROC,PtrInt(#WndCallback)));
in FormCreate section.
Now, I got an error with Result := TForm1.WMCopyData(); I'm not sure what parameters should be passed into this function. It is declared as: TForm1.WMCopyData(var Msg: TCopyDataStruct); but neither 'Msg' nor 'TCopyDataStruct' works. Could you help me with it?
Note that only a portable subset of (GDI) messages is copied into the Lazarus LCL message queue.
See http://wiki.freepascal.org/Win32/64_Interface#Processing_non-user_messages_in_your_window
Related
Has anyone found a way to detect the mouse back and forward buttons in a Delphi FMX form in Windows (and only Windows)?
I understand this works fine in a VCL application, using
procedure WMAppCommand(var Msg: Winapi.Messages.TMessage); message WM_APPCOMMAND;
but this has no effect in an FMX application.
If anyone already has worked out a solution to this, would very much appreciate a hint (or the code they used, of course).
FMX heavily filters window messages, only dispatching the few messages it actually uses for itself. WM_APPCOMMAND is not one of them, which is why a simple message handler does not work in FMX, like it does in VCL.
So, you are going to have to manually subclass the TForm's Win32 HWND directly, via SetWindowLongPtr(GWLP_WNDPROC) or SetWindowSubclass(), in order to intercept window messages before FMX sees them. See Subclassing controls.
An ideal place to do that subclassing is to override the TForm.CreateHandle() method. You can use FMX's FormToHWND() function to get the TForm's HWND after it has been created.
protected
procedure CreateHandle; override;
...
uses
FMX.Platform.Win, Winapi.Windows, Winapi.CommCtrl;
function MySubclassProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM;
uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): LRESULT; stdcall;
begin
case uMsg of
WM_APPCOMMAND: begin
// use TMyForm(dwRefData) as needed...
end;
WM_NCDESTROY:
RemoveWindowSubclass(hWnd, #MySubclassProc, uIdSubclass);
end;
Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
end;
procedure TMyForm.CreateHandle;
begin
inherited;
SetWindowSubclass(FormToHWND(Self), #MySubclassProc, 1, DWORD_PTR(Self));
end;
procedure InitStandardClasses;
var
ICC: TInitCommonControlsEx;
begin
ICC.dwSize := SizeOf(TInitCommonControlsEx);
ICC.dwICC := ICC_STANDARD_CLASSES;
InitCommonControlsEx(ICC);
end;
initialization
InitStandardClasses;
Somewhere in my application (along with 3rd party libraries of code) is a window procedure that is preventing Windows from:
logging off
shutting down
restarting
I found one spot in my code where I made the extraordinarily common mistake of calling DefWindowProc, but calling it incorrectly:
Before:
void Grobber.BroadcastListenerWindowProc(ref TMessage msg)
{
DefWindowProc(_broadcastListenerHwnd, msg.msg, msg.wparam, msg.lparam);
}
After:
void Grobber.BroadcastListenerWindowProc(ref TMessage msg)
{
//20170207: Forgetting to set the result can, for example, prevent Windows from restarting
msg.Result = DefWindowProc(_broadcastListenerHwnd, msg.msg, msg.wparam, msg.lparam);
}
I fixed that bug, and my test program no longer halted the shutdown.
But a full application does
I'm now faced with having to tear a program down to nothing, until my computer finally reboots.
Somewhere deep inside my application is a Window procedure attached to an HWND that is returning zero to WM_QUERYENDSESSION. If only i knew the HWND, i could use the Spy++ to find the Window.
But how can i find that hwnd?
The Windows Application event log notes the process that halt a shutdown:
And there very well be a more detailed log in the more detailed Applications and Services Logs. But those are undocumented.
How can i find my problematic hwnd?
Attempts
I tried to use EnumThreadWindows to get all the windows of my "main" thread, with the idea of manually sending WM_QUERYENDSESSION to them all to see who returns false:
var
wnds: TList<HWND>;
function DoFindWindow(Window: HWnd; Param: LPARAM): Bool; stdcall;
var
wnds: TList<HWND>;
begin
wnds := TList<HWND>(Param);
wnds.Add(Window);
Result := True;
end;
wnds := TList<HWND>.Create;
enumProc := #DoFindWindow;
EnumThreadWindows(GetCurrentThreadId, EnumProc, LPARAM(wnds));
Now i have a list of twelve hwnds. Poke them:
var
window: HWND;
res: LRESULT;
for window in wnds do
begin
res := SendMessage(window, WM_QUERYENDSESSION, 0, 0);
if res = 0 then
begin
ShowMessage('Window: '+IntToHex(window, 8)+' returned false to WM_QUERYENDSESSION');
end;
end;
But nobody did return zero.
So that's one tube down the drain.
EnumThreadWindows only enumerates the windows of one particular thread. It could be that the offending window was created in a thread. So I'd suggest that you use EnumWindows to enum all top level windows in your application for your test.
It's enough to initialize COM in a thread and you'll have a window you don't know about. That way a call to WaitForSingleObject in a thread could be your culprit:
Debugging an application that would not behave with WM_QUERYENDSESSION
This might sound a bit like overkill but here goes. I would solve this using code hooks for AllocateHWnd and DeallocateHWnd. We had to solve a different issue related to handles and it worked well for us.
Your replacement routines will just be copies of the versions in System.Classes. You will also need to copy all of the dependencies (PObjectInstance, TObjectInstance, CodeBytes, PInstanceBlock, TInstanceBlock, InstBlockList, InstFreeList, StdWndProc, CalcJmpOffset, MakeObjectInstance, FreeObjectInstance, CleanupInstFreeList, GetFreeInstBlockItemCount, ReleaseObjectInstanceBlocks, UtilWindowClass) from that unit. The only difference is that you log all allocated and deallocated handles in your replacement routines. It would help to include stack traces too.
That will give you a list of all of the handles that are allocated at the time of your shutdown along with their calling stack traces.
The basic structure is something like this. I can't post full code because it's mostly VCL code with the exception of the code hooks and logging.
const
{$IF Defined(CPUX86)}
CodeBytes = 2;
{$ELSEIF Defined(CPUX64)}
CodeBytes = 8;
{$ENDIF CPU}
InstanceCount = (4096 - SizeOf(Pointer) * 2 - CodeBytes) div SizeOf(TObjectInstance) - 1;
type
PInstanceBlock = ^TInstanceBlock;
TInstanceBlock = packed record
...
end;
var
InstBlockList: PInstanceBlock;
InstFreeList: PObjectInstance;
{ Standard window procedure }
function StdWndProc(Window: HWND; Message: UINT; WParam: WPARAM; LParam: WPARAM): LRESULT; stdcall;
...
function CalcJmpOffset(Src, Dest: Pointer): Longint;
...
function MakeObjectInstance(const AMethod: TWndMethod): Pointer;
...
procedure FreeObjectInstance(ObjectInstance: Pointer);
...
procedure CleanupInstFreeList(BlockStart, BlockEnd: PByte);
...
function GetFreeInstBlockItemCount(Item: PObjectInstance; Block: PInstanceBlock): Integer;
...
procedure ReleaseObjectInstanceBlocks;
...
var
UtilWindowClass: TWndClass = (
... );
function AllocateHWnd(const AMethod: TWndMethod): HWND;
begin
< Logging/Stack trace code here >
...
end;
procedure DeallocateHWnd(Wnd: HWND);
begin
< Logging/Stack trace code here >
...
end;
It may also be necessary to hook and log SetWindowLong, SetWindowLongA and SetWindowLongW too.
I need to detect when a form is minimized (to hide overlay form). I intercept WM_SYSCOMMAND message and it works fine if I click the form's minimize button, but this event seems not to be fired if I use [Windows] + [M]. Also, WM_ACTIVATE and WM_ACTIVATEAPP are not triggered in this case.
What event could I use and are there any other situations that I would have to detect?
As explained here, How to detect when the form is being maximized?, listen to the WM_SIZE messages.
Declare in your form:
procedure WMSize(var Msg: TMessage); message WM_SIZE;
And implementation:
procedure TForm1.WMSize(var Msg: TMessage);
begin
Inherited;
if Msg.WParam = SIZE_MINIMIZED then
ShowMessage('Minimized');
end;
Update
See also the answer by #bummi where there is a solution when Application.MainFormOnTaskbar = false.
Since WM_SIZE will not be called on a mainform of a project not using the setting Application.MainFormOnTaskbar := True; I'd suggest an approach, inspired by inspired by #kobik 's answer on , How to detect when the form is being maximized?.
WM_WINDOWPOSCHANGING will be called independed from MainFormOnTaskbar with different signatures on Message.WindowPos^.flags and respond on WIN + M too.
procedure TForm3.WMWindowPosChanging(var Message: TWMWindowPosChanging);
const
Hide1=(SWP_NOCOPYBITS or SWP_SHOWWINDOW or SWP_FRAMECHANGED or SWP_NOACTIVATE);
Hide2=((SWP_HIDEWINDOW or SWP_NOACTIVATE or SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE));
begin
inherited;
if ((Message.WindowPos^.flags AND Hide1) = Hide1)
or ((Message.WindowPos^.flags AND Hide2) = Hide2) then
begin
Memo1.Lines.Add('Window got minimized');
end;
end;
Listen for WM_SIZE notification messages with a wParam parameter of SIZE_MINIMIZED.
When I try to use the Windows SetTimer function, it generate a IDEvent for the timer even if I have specified one!
This:
SetTimer(0,999,10000,#timerproc);
In:
procedure timerproc(hwnd: HWND; uMsg: UINT; idEvent: UINT_PTR;dwTime: DWORD); stdcall;
begin
KillTimer(0, idEvent);
showmessage(inttostr(idevent));
end;
Return:
Random Number!
Is it possible to manage my timers by myself instead of Windows choosing for me?
Thank you very much!
If you want to handle multiple timer events in a single routine, then handle it by specific window rather then by specific routine:
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
FTimerWindow: HWND;
procedure TimerProc(var Msg: TMessage);
end;
...
procedure TForm1.FormCreate(Sender: TObject);
begin
FTimerWindow := Classes.AllocateHWnd(TimerProc);
SetTimer(FTimerWindow, 999, 10000, nil);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Classes.DeallocateHWnd(FTimerWindow);
end;
procedure TForm1.TimerProc(var Msg: TMessage);
begin
if Msg.Msg = WM_TIMER then
with TWMTimer(Msg) do
case TimerID of
999:
//
else:
//
end;
end;
SetTimer will work differently, depending upon whether you are passing a window handle to it or not.
Timer_Indentifier := SetTimer(0, MyIdentifier, Time, #myproc);
In the above instance, Timer_Identifier does NOT equal MyIdentifier.
Timer_Indentifier := SetTimer(handle, MyIdentifier, Time, #myproc);
In the second example, Timer_Identifier = MyIdentifier.
This is because in the second example, your windows loop will need to use "MyIdentifier" to find out which timer is sending a "WM_Timer" message to it.
Using a specific Timer function, with no Window Handle, is different. The short answer is that in your scenario, use the value that Windows gives you.
http://msdn.microsoft.com/en-us/library/windows/desktop/ms644906%28v=vs.85%29.aspx
Multimedia Timer solved my problem!
I can pass whatever I want to them with dwUser:)
MMRESULT timeSetEvent(
UINT uDelay,
UINT uResolution,
LPTIMECALLBACK lpTimeProc,
DWORD_PTR dwUser,
UINT fuEvent
);
From MSDN : dwUser -> User-supplied callback data.
They have a TIME_ONESHOT option which is exactly what I use timers for!
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
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, first 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.
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.
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.