GLOBALE HOOKS i Delphi

Hej Eksperter ...

Jeg har nu brugt to hele dage på at lave et global hook i Delphi ..

skulle der side nogen og tænke, hvorfor kører manden ikke bare sit spm gennem google, eller inde på torry. Der må da vare en milliard eksempler ...

Og ja gangse rigtigt .. det er der .... Jeg har bare ikke fundet et eneste der virker !!

Jeg har temmeligt godt styr på hooks. Jeg har feks indkapslet dem i komponenter ...

INDEN nogen fristes til at svare på denne post så vær opmærksom på at med mindre du har afprøvet eksemplet selv gidder jeg ikke spilde min tid på det !!

Eksemplet skal laves i Delphi vha en exe fil og en DLL fil. Jeg er udemærket klar over Low Loevel hooks ikke behøver ligge i en dll fil

Men nu er det et message hook jeg skal bruge ... Lang snak, men jeg skal pille i VM_input besekden ....

Jeg har prøvet det følgende :

/// EXE FILE :
unit MainU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

const
  UWMMOUSEMOVE = WM_USER + 1;
type
  TForm17 = class(TForm)
    CheckBox1: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    procedure UWMMOUSEMOVE(var Message: TMessage); message UWMMOUSEMOVE;
  public
    { Public declarations }
  end;

var
  Form17: TForm17;

implementation

function SetMyHook(Handle: THandle): Boolean; external 'MouseHook.dll';
function ClearMyHook(Handle: Thandle): Boolean; external 'MouseHook.dll';

{$R *.dfm}

procedure TForm17.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Enabled then
    Caption := BoolToStr(SetMyHook(Handle), True)
  else
    ClearMyHook(Handle);
end;

procedure TForm17.FormCreate(Sender: TObject);
begin
  Caption := IntToStr(Handle);
end;

procedure TForm17.UWMMOUSEMOVE(var Message: TMessage);
begin
  Caption := TimeToStr(now)
end;

end.

//DLL FILE
library MouseHook;

uses
  Windows,
  SysUtils,
  Messages,
  Dialogs,
  Classes;

{$R *.res}

const
  UWM_MOUSEMOVE = WM_USER + 1;
var
  hInst: DWORD;
  hWndServer: DWORD = 0;
  Hook: HHOOK;

  (****************************************************************************
  *                                  MsgHook
  * Inputs:
  *      int nCode: Code value
  *    WPARAM wParam:
  *    LPARAM lParam:
  * Result: LRESULT
  *      Either 0 or the result of CallNextHookEx
  * Effect:
  *      Hook processing function. If the message is a mouse-move message,
  *    posts the coordinates to the parent window
  ****************************************************************************)

function MsgHook(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  MSG: pMSG;
begin
  if Code < 0 then
  begin
    Result := CallNextHookEx(Hook, Code, wParam, lParam);
    Exit;
  end; // if

  MSG := pMSG(lParam);

  if (MSG^.Message = WM_MOUSEMOVE) or (MSG^.Message = WM_NCMOUSEMOVE) then
    PostMessage(hWndServer, UWM_MOUSEMOVE, 0, 0);

  Result := CallNextHookEx(Hook, Code, wParam, lParam);
end;

(****************************************************************************
*                                SetMyHook
* Inputs:
*      HWND hWnd: Window to notify
* Result: BOOL
*      TRUE if successful
*    FALSE if error
* Effect:
*      Sets the hook
****************************************************************************)

function SetMyHook(Handle: THandle): Boolean;
begin
  Result := False;

  if hWndServer <> 0 then
    Exit;

  Hook := SetWindowsHookEx(WH_GETMESSAGE, @MsgHook, hInst, 0);
  if Hook <> 0 then
    hWndServer := Handle;

  Result := Hook <> 0;
end;

(****************************************************************************
*                                clearMyHook
* Inputs:
*      HWND hWnd: Window hook
* Result: BOOL
*      TRUE if successful
*    FALSE if error
* Effect:
*      Removes the hook that has been set
****************************************************************************)

function ClearMyHook(Handle: Thandle): Boolean;
var
  UnHooked: Boolean;
begin
  Result := False;
  if (Handle <> hWndServer) or (Handle = 0) then
    Exit;
  UnHooked := UnhookWindowsHookEx(hook);

  if UnHooked then
    hWndServer := 0;

  Result := UnHooked;
end;

procedure DllMain(reason: Integer);
begin
  case reason of
    DLL_PROCESS_ATTACH:
      begin
        hInst := hInstance;
      end;

    DLL_THREAD_ATTACH:
      begin
        hInst := hInstance;
      end;

    DLL_PROCESS_DETACH:
      begin
        if hWndServer <> 0 then
          ClearMyHook(hWndServer);
      end;

    DLL_THREAD_DETACH:
      begin
      end;
  end;
end;

exports
  SetMyHook,
  ClearMyHook;

begin
  hInst := hInstance;
  DllProc := @DllMain;
end.