• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 208
  • Last Modified:

Hom to capture TMessage to other app.

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
Oli2
Asked:
Oli2
  • 10
  • 5
  • 2
  • +1
1 Solution
 
LischkeCommented:
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
 
rene100Commented:
I think you habe to use SetWindowsHookEx in a dll...i'm working on an example....
0
 
Oli2Author Commented:
Adjusted points from 150 to 250
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
Oli2Author Commented:
Nobody ???
0
 
craig_capelCommented:
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
 
Oli2Author Commented:
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
 
LischkeCommented:
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
 
Oli2Author Commented:
Adjusted points from 250 to 300
0
 
Oli2Author Commented:
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
 
craig_capelCommented:
intresting, when i posted my code, nobody had said anything... i think EE is messed up...
0
 
Oli2Author Commented:
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
 
Oli2Author Commented:
what code, craig ?
0
 
LischkeCommented:
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
 
LischkeCommented:
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
 
Oli2Author Commented:
Adjusted points from 300 to 303
0
 
Oli2Author Commented:
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
 
LischkeCommented:
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
 
Oli2Author Commented:
great!! Thanx a lot, Mike!! Sorry to bother...

Regards, Oli
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

  • 10
  • 5
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now