Registriert seit: 8. Mär 2004
230 Beiträge
Delphi 7 Enterprise
|
Problem mit Mousehook
2. Jul 2004, 09: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.
|