Solved

Hom to capture TMessage to other app.

Posted on 2000-04-07
18
200 Views
Last Modified: 2010-04-04
I need to catch the message that is sent to another application before the application itself receives the message.

(WM_QUERYENDSESSION)

How can I do that?

Regards, Oli
0
Comment
Question by:Oli2
  • 10
  • 5
  • 2
  • +1
18 Comments
 
LVL 10

Expert Comment

by:Lischke
ID: 2692972
Oli,

well, I guess this and similar questions have been asked so often, nobody likes to answer... It's that you need to hook the application with code like this:

library Hook;

uses
  Windows, SysUtils;

type
  // shared memory area used by the DLL in different process contexts (loacted in memory mapped file)
  PHookInfo = ^THookInfo;
  THookInfo = record
    MouseHook,           // general mouse messages
    SynchEvent: THandle; // used to synchronize main program and hook DLL
    Windows9x: Boolean;
  end;

const
  InternalFileMappingName = 'HookInternalMemory';
  HookEvent = 'HookInternalEvent';

var
  InternalMapping: THandle;
  HookInfo: PHookInfo;
 
//----------------------------------------------------------------------------------------------------------------------

function GetSharedData: Boolean;

begin
  Result := True;
  // create shared memory area to use some global variables for all process contexts the DLL can be called in
  InternalMapping := CreateFileMapping(DWORD(-1), nil, PAGE_READWRITE, 0, SizeOf(THookInfo), InternalFileMappingName);
  if InternalMapping <> 0 then
  begin
    // the shared memory will be mapped for the entire lifetime of the DLL (it needs really not much memory)
    HookInfo := MapViewOfFile(InternalMapping, FILE_MAP_READ or FILE_MAP_WRITE, 0, 0, SizeOf(THookInfo));
    if Assigned(HookInfo) then
    begin
      with HookInfo^ do
      begin
        // Retrieve handle to synchronization event. This handle needs not to be freed from here and must be
        // created by the main application. The event must be created initially set as this is the state which
        // indicates free operation for the hook.
        SynchEvent := OpenEvent(EVENT_ALL_ACCESS, False, HookEvent);
        if SynchEvent = 0 then Result := False; // show that something went wrong
        Windows9x := (Win32Platform and VER_PLATFORM_WIN32_NT) = 0;
      end;
    end
    else Result := False; // show that something went wrong
  end
  else Result := False; // show that something went wrong
end;

//----------------------------------------------------------------------------------------------------------------------

procedure ReleaseSharedData;

begin
  if Assigned(HookInfo) then
  begin
    UnmapViewOfFile(HookInfo);
    if InternalMapping <> 0 then CloseHandle(InternalMapping);
    InternalMapping := 0;
    HookInfo := nil;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

function MouseHookProc(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT stdcall;

var IsEvent: Boolean;

  function DoDefault: LRESULT;

  begin
    Result := CallNextHookEx(HookInfo.MouseHook, Code, wParam, lParam);
  end;

begin
  if GetSharedData then
  begin
    // check if we have still a pending message to swallow
    if (HookInfo.SwallowMessage = wParam) then
    begin
      HookInfo.SwallowMessage := -1;
      if Code < 0 then Result := DoDefault
                  else Result := 1;
    end
    else
    begin
      // A timeout value of 0 means not to wait for the event but to check it.
      // An unsignaled event means there were no results before or the main application has already
      // processed the last result. The event must manually be reset by the application!
      IsEvent := (WaitForSingleObject(HookInfo.SynchEvent, 0) = WAIT_TIMEOUT) and
                 ((wParam = WM_MBUTTONDOWN) or (wParam = WM_NCMBUTTONDOWN));

      if IsEvent and (GetAsyncKeyState(VK_CONTROL) < 0) then
      begin
        with PMouseHookStruct(lParam)^ do
          if HookInfo.Windows9x then DoWin9xStuff(hwnd, Pt)
                                else DoWinNTStuff(hwnd, Pt);
        if Code < 0 then Result := DoDefault
                    else Result := 1;
      end
      else Result := DoDefault;
    end;
  end
  else Result := 1;
  ReleaseSharedData;
end;

//----------------------------------------------------------------------------------------------------------------------

function InitializeHook: Boolean;

begin
  if GetSharedData then
  begin
    with HookInfo^ do
    begin
      if MouseHook = 0 then
        MouseHook := SetWindowsHookEx(WH_MOUSE, MouseHookProc, HInstance, 0);
      Result := (MouseHook <> 0);
    end;
  end
  else Result := False;
  ReleaseSharedData;
end;

//----------------------------------------------------------------------------------------------------------------------

function RemoveHook: Boolean;

begin
  if GetSharedData then
  begin
    Result := True;
    with HookInfo^ do
    begin
      if MouseHook <> 0 then
      begin
        Result := UnhookWindowsHookEx(MouseHook);
        MouseHook := 0;
      end;
    end;
  end
  else Result := False;
  ReleaseSharedData;
end;

//----------------------------------------------------------------------------------------------------------------------

var
  LastExitProc: Pointer;

function ExitLibrary: Boolean;

begin
  ExitProc := LastExitProc;
  Result := True;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure InitLibrary;

begin
  LastExitProc := ExitProc;
  ExitProc := @ExitLibrary;
end;

//----------------------------------------------------------------------------------------------------------------------

exports
  InitializeHook,
  RemoveHook;

begin
  InitLibrary;
end.



The most interesting part is MouseHookProc which tests for a certain message. Here you need of course to test for WM_QUERYENDSESSION and you can simplify the code a bit. You need also to test for the correct window handle...

Ciao, Mike
0
 
LVL 2

Expert Comment

by:rene100
ID: 2692973
I think you habe to use SetWindowsHookEx in a dll...i'm working on an example....
0
 
LVL 1

Author Comment

by:Oli2
ID: 2692869
Adjusted points from 150 to 250
0
 
LVL 1

Author Comment

by:Oli2
ID: 2692870
Nobody ???
0
 
LVL 2

Expert Comment

by:craig_capel
ID: 2692874
I may be totally wrong, but I would think something like a DLL or a VXD to do something like this.....

Before you ask.... nope i don't know :)
0
 
LVL 1

Author Comment

by:Oli2
ID: 2693022
Hi Mike!

Thanx for your code.
few q's left:

1. This will be a .dll - how to call/initialize this from my app?

2. Where's procedure "DoWin9xStuff" and "HookInfo.SwallowMessage" located? In the main app? I get an error compiling...

Regards, Oli

P.S.: sorry to bother. Didn't know this has been asked so many times before...
0
 
LVL 10

Accepted Solution

by:
Lischke earned 303 total points
ID: 2693110
Oops, sorry Oli2. I used the uncleared code. Here's to correct one:
library Hook;

uses
  Windows, SysUtils;

type
  // shared memory area used by the DLL in different process contexts (loacted in memory mapped file)
  PHookInfo = ^THookInfo;
  THookInfo = record
    MouseHook,           // general mouse messages
    SynchEvent: THandle; // used to synchronize main program and hook DLL
  end;

const
  InternalFileMappingName = 'HookInternalMemory';
  HookEvent = 'HookInternalEvent';

var
  InternalMapping: THandle;
  HookInfo: PHookInfo;
 
//----------------------------------------------------------------------------------------------------------------------

function GetSharedData: Boolean;

begin
  Result := True;
  // create shared memory area to use some global variables for all process contexts the DLL can be called in
  InternalMapping := CreateFileMapping(DWORD(-1), nil, PAGE_READWRITE, 0, SizeOf(THookInfo), InternalFileMappingName);
  if InternalMapping <> 0 then
  begin
    // the shared memory will be mapped for the entire lifetime of the DLL (it needs really not much memory)
    HookInfo := MapViewOfFile(InternalMapping, FILE_MAP_READ or FILE_MAP_WRITE, 0, 0, SizeOf(THookInfo));
    if Assigned(HookInfo) then
    begin
      with HookInfo^ do
      begin
        // Retrieve handle to synchronization event. This handle needs not to be freed from here and must be
        // created by the main application. The event must be created initially set as this is the state which
        // indicates free operation for the hook.
        SynchEvent := OpenEvent(EVENT_ALL_ACCESS, False, HookEvent);
        if SynchEvent = 0 then Result := False; // show that something went wrong
      end;
    end
    else Result := False; // show that something went wrong
  end
  else Result := False; // show that something went wrong
end;

//----------------------------------------------------------------------------------------------------------------------

procedure ReleaseSharedData;

begin
  if Assigned(HookInfo) then
  begin
    UnmapViewOfFile(HookInfo);
    if InternalMapping <> 0 then CloseHandle(InternalMapping);
    InternalMapping := 0;
    HookInfo := nil;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

function MouseHookProc(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT stdcall;

var IsEvent: Boolean;

  function DoDefault: LRESULT;

  begin
    Result := CallNextHookEx(HookInfo.MouseHook, Code, wParam, lParam);
  end;

begin
  if GetSharedData then
  begin
    // A timeout value of 0 means not to wait for the event but to check it.
    // An unsignaled event means there were no results before or the main application has already
    // processed the last result. The event must manually be reset by the application!
    IsEvent := (WaitForSingleObject(HookInfo.SynchEvent, 0) = WAIT_TIMEOUT) and
               (wParam = YourMessageHere);

    if IsEvent and (GetAsyncKeyState(VK_CONTROL) < 0) then
    begin
      with PMouseHookStruct(lParam)^ do
        !!DoYourStuffHere!!
            
      if Code < 0 then Result := DoDefault
                  else Result := 1;
    end
    else Result := DoDefault;
  end
  else Result := 1;
  ReleaseSharedData;
end;

//----------------------------------------------------------------------------------------------------------------------

function InitializeHook: Boolean;

begin
  if GetSharedData then
  begin
    with HookInfo^ do
    begin
      if MouseHook = 0 then
        MouseHook := SetWindowsHookEx(WH_MOUSE, MouseHookProc, HInstance, 0);
      Result := (MouseHook <> 0);
    end;
  end
  else Result := False;
  ReleaseSharedData;
end;

//----------------------------------------------------------------------------------------------------------------------

function RemoveHook: Boolean;

begin
  if GetSharedData then
  begin
    Result := True;
    with HookInfo^ do
    begin
      if MouseHook <> 0 then
      begin
        Result := UnhookWindowsHookEx(MouseHook);
        MouseHook := 0;
      end;
    end;
  end
  else Result := False;
  ReleaseSharedData;
end;

//----------------------------------------------------------------------------------------------------------------------

var
  LastExitProc: Pointer;

function ExitLibrary: Boolean;

begin
  ExitProc := LastExitProc;
  Result := True;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure InitLibrary;

begin
  LastExitProc := ExitProc;
  ExitProc := @ExitLibrary;
end;

//----------------------------------------------------------------------------------------------------------------------

exports
  InitializeHook,
  RemoveHook;

begin
  InitLibrary;
end.


The DLL should be loaded so:

procedure TMainForm.Button1Click(Sender: TObject);

begin
  if Lib = 0 then
  begin
    Event := CreateEvent(nil, True, False, DictEvent);
    Lib := LoadLibrary('.....\Hook.dll');
    if Lib = 0 then
    begin
      ShowMessage('hook loading failed');
      Abort;
    end;
    InitializeHook := GetProcAddress(Lib, 'InitializeHook');
    RemoveHook := GetProcAddress(Lib, 'RemoveHook');
    if not InitializeHook then ShowMessage('hook failed')
                          else
    begin
      FWorkThread.FEvent := Event;
      FWorkThread.Resume;
    end;
  end;
  Button1.Enabled := False;  
end;

Ciao, Mike
0
 
LVL 1

Author Comment

by:Oli2
ID: 2693117
Adjusted points from 250 to 300
0
 
LVL 1

Author Comment

by:Oli2
ID: 2693118
okay, forget about the "DoWin9xStuff", I figured this one out.

Still:
1.) What's the "SwallowMessage" in your code? Don't get that one...

2.) could you give a short example on how to call that dll from the main app?

0
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 
LVL 2

Expert Comment

by:craig_capel
ID: 2693133
intresting, when i posted my code, nobody had said anything... i think EE is messed up...
0
 
LVL 1

Author Comment

by:Oli2
ID: 2693156
Hi, Mike!

Again: big thanx.

Last ones:
--------------------------------------------
procedure TMainForm.Button1Click(Sender: TObject);
begin
  if Lib = 0 then
  begin
    Event := CreateEvent(nil, True, False, DictEvent);
    Lib := LoadLibrary('.....\Hook.dll');
    if Lib = 0 then
    begin
      ShowMessage('hook loading failed');
      Abort;
    end;
    InitializeHook := GetProcAddress(Lib, 'InitializeHook');
    RemoveHook := GetProcAddress(Lib, 'RemoveHook');
    if not InitializeHook then ShowMessage('hook failed')
                          else
    begin
      FWorkThread.FEvent := Event;
      FWorkThread.Resume;
    end;
  end;
  Button1.Enabled := False;    
end;

----------------------------------------------

I assume "Lib" and "Event" are Integers, right?

What are "InitializeHook" and "RemoveHook" ?

What's the "FWorkThread" ?

What's the "DictEvent"? an array[0..MAX_PATH] of char ? Do I have to fill it with something?

I guess with hard thinking I could figure it out, but... being lazy...

;-)

Regards, Oli
0
 
LVL 1

Author Comment

by:Oli2
ID: 2693161
what code, craig ?
0
 
LVL 10

Expert Comment

by:Lischke
ID: 2693189
Here's another snippet which show what you need:

var
  Lib: THandle;
  InitializeHook: function: Boolean;
  RemoveHook: function: Boolean;
  Event: THandle;

procedure TWorkThread.Execute;

begin
  while not Terminated do
  begin
    case WaitForSingleObject(FEvent, 500) of
      WAIT_TIMEOUT:
        Continue;
      WAIT_OBJECT_0:
        begin
          Synchronize(ShowResults);
          // signal that result has been processed
          ResetEvent(FEvent);
        end;
    end;
  end;
end;

DictEvent is just a unique string to indentify the event. Use some name which will likely not appear in any other named object in the system (like your girl friends name :-)).

The thread in my case is to process results from the hook. Those results are packed into a second file mapping by the hook library and unpacked in the ShowResults method. This way you don't need to care about passing memory along different processes (you should always keep in mind that the hook DLL is almost always called in the context of another process).

Ciao, Mike
0
 
LVL 10

Expert Comment

by:Lischke
ID: 2693198
Ah yes, the thread declaration:

  TWorkThread = class(TThread)
  private
    FEvent: THandle;
    procedure ShowResults;
  public
    procedure Execute; override;
  end;


As you can see it's extremly complex and competent :-))

Ciao, Mike
0
 
LVL 1

Author Comment

by:Oli2
ID: 2693215
Adjusted points from 300 to 303
0
 
LVL 1

Author Comment

by:Oli2
ID: 2693216
Hi Mike!

Last one, I promise !!

If my app has nothing else to do but loading the dll (setting the hook), then I don't have to use a TThread, do I ?
0
 
LVL 10

Expert Comment

by:Lischke
ID: 2693236
No you don't. If you use another way to process the result then there's no need to create the thread. It's only to process the result set which probably takes some time while the main application still responds to the user.

Ciao, Mike
0
 
LVL 1

Author Comment

by:Oli2
ID: 2693245
great!! Thanx a lot, Mike!! Sorry to bother...

Regards, Oli
0

Featured Post

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now