Thema: Delphi Problem mit Mousehook

Einzelnen Beitrag anzeigen

Chris P

Registriert seit: 8. Mär 2004
230 Beiträge
 
Delphi 7 Enterprise
 
#1

Problem mit Mousehook

  Alt 2. Jul 2004, 08:24
Hi Leute,

ich schreibe grade einen Mousehook, aber irgendwie kommen die
Nachrichten aus der DLL nicht bei meinem Programm an.

Hier seht ihr die DLL und das Hauptprogramm:

Delphi-Quellcode:
library MHDLL;

uses
  Windows,
  Messages;

procedure InstallHook(AppHandle: HWND); export; forward;
procedure UninstallHook; export; forward;

type
    THookRec = record
       AppHnd: HWND;
    end;

var
  PHookRec: ^THookRec;
  hApp, hMap, hMouseHook: HWND;

const
     WM_MOUSEHOOK = WM_USER + 1001;

function MouseHookProc(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
   Result := CallNextHookEx(hMouseHook, Code, wParam, lParam);

   if Code >= 0 then
   begin
      hMap := OpenFileMapping(FILE_MAP_WRITE, False, 'MouseMMF');
      PHookRec := MapViewOfFile(hMap, FILE_MAP_WRITE, 0, 0, 0);
      if PHookRec <> nil then
         hApp := PHookRec.AppHnd;

      PostMessage(hApp, WM_MOUSEHOOK, wParam, lParam);
   end
   else
      Exit;
end;

procedure InstallHook(AppHandle: HWND); export;
begin
   hMouseHook := SetWindowsHookEx(WH_MOUSE, @MouseHookProc, hInstance, 0);
   if hMouseHook > 0 then
   begin
     hMap := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(THookRec), 'MouseMMF');
     PHookRec := MapViewOfFile(hMap, FILE_MAP_WRITE, 0, 0, 0);
     PHookRec.AppHnd := AppHandle;
     hApp := AppHandle;
   end;
end;

procedure UninstallHook(); export;
begin
   UnhookWindowsHookEx(hMouseHook);
end;

procedure EntryPointProc(Reason: Integer);
begin
  case reason of
    DLL_PROCESS_ATTACH:
      begin
        hMap := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(THookRec), 'MouseMMF');
        PHookRec := MapViewOfFile(hMap, FILE_MAP_WRITE, 0, 0, 0);
      end;

    DLL_PROCESS_DETACH:
      begin
        try
          UnMapViewOfFile(PHookRec);
          CloseHandle(hMap);
        except
        end;
      end;

  end;
end;

exports
  InstallHook,
  UninstallHook;

begin
  DllProc := @EntryPointProc;
  EntryPointProc(DLL_PROCESS_ATTACH);
end.
Und hier das Programm:
Delphi-Quellcode:
unit UMain;

interface

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

const
   WM_MOUSEHOOK = WM_USER + 1001;

type
  TCreateHook = procedure (hApp: HWND);
  TDeleteHook = procedure ();

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    procedure DLLMessage(var Msg: TMessage); message WM_MOUSEHOOK;
    procedure CreateHook();
    procedure DeleteHook();
  end;

var
  Form1: TForm1;
  hLib: HWND;

const
     MHDLL = 'MHDLL.Dll';

implementation

{$R *.DFM}

procedure TForm1.DLLMessage(var Msg: TMessage);
begin
  case Msg.wParam of
    WM_MOUSEMOVE: begin

                       Label1.Caption := InttoStr(LOWORD(Msg.wParam));
                       Label2.Caption := InttoStr(HIWORD(Msg.wParam));
                  end;
  end;
end;

procedure TForm1.CreateHook();
var
  Hook: TCreateHook;
begin
  hLib := LoadLibrary(MHDLL);
  @Hook := GetProcAddress(hLib, 'InstallHook');
  if @Hook = nil then
     Exit;
  Hook(Handle);
end;

procedure TForm1.DeleteHook();
var
  Hook: TDeleteHook;
begin
  @Hook := GetProcAddress(hLib, 'UninstallHook');
  if @Hook = nil then
  begin
    ShowMessage('DLL cannot be found');
    Exit;
  end;
  FreeLibrary(hLib);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
   CreateHook();
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   DeleteHook();
end;

end.
  Mit Zitat antworten Zitat