Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
Solved

Hom to capture TMessage to other app.

Posted on 2000-04-07
18
203 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
Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

 
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
 
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

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Printing problem 2 102
HTML text in the body of an email (delphi code) 12 167
how can i search if string exist in array ? 3 63
Browsing a TTreeView in Delphi 5 7
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
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…
This video shows how to use Hyena, from SystemTools Software, to bulk import 100 user accounts from an external text file. View in 1080p for best video quality.
The Email Laundry PDF encryption service allows companies to send confidential encrypted  emails to anybody. The PDF document can also contain attachments that are embedded in the encrypted PDF. The password is randomly generated by The Email Laundr…

856 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