{-----MouseHook.pas-------------------------------------------}
{
MouseHook DLL Load & TMouseHook Class Unit
2004-09-08
Copyright ? Thomas Yao
}
unit MouseHook;
interface
uses
Windows, Messages, Classes;
const
DEFDLLNAME = 'mousehook.dll';
MappingFileName = '57D6A971_MouseHookDLL_442C0DB1';
MSGMOUSEMOVE: PChar = 'MSGMOUSEMOVE57D6A971-049B-45AF-A8CD-37E0B706E036';
MSGMOUSECLICK: PChar = 'MSGMOUSECLICK442C0DB1-3198-4C2B-A718-143F6E2D1760';
type
// 全局映像文件, 如果没有TMappingMem, hook就只对本进程起作用
TMappingMem = record
Handle: DWORD;
MsgID: DWORD;
MouseStruct: TMOUSEHOOKSTRUCT;
end;
PMappingMem = ^TMappingMem;
// 函数原型
TEnableMouseHook = function(hWindow: HWND; Blocked: BOOL): BOOL; stdcall;
TDisableMouseHook = function: BOOL; stdcall;
// 事件对象
TMouseMoveNotify = procedure(const Handle: HWND; const X, Y: Integer) of object;
TMouseClickNotify = procedure(const Handle: HWND; const X, Y: Integer) of object;
// 基类
TMouseHookBase = class
private
FDLLName: string;
FDLLLoaded: BOOL;
FListenerHandle: HWND;
FActive: BOOL;
hMappingFile: THandle;
pMapMem: PMappingMem;
FBlocked: BOOL;
procedure WndProc(var Message: TMessage);
procedure SetDLLName(const Value: string);
procedure SetBlocked(const Value: BOOL);
protected
MSG_MOUSEMOVE: UINT;
MSG_MOUSECLICK: UINT;
// 消息到事件
procedure ProcessMessage(var Message: TMessage); virtual; abstract;
public
constructor Create; virtual;
destructor Destroy; override;
function Start: BOOL; virtual;
procedure Stop; virtual;
property DLLLoaded: BOOL read FDLLLoaded;
property Active: BOOL read FActive;
published
property DLLName: string read FDLLName write SetDLLName;
property Blocked: BOOL read FBlocked write SetBlocked;
end;
// 子类TMouseHook, 只提供事件接口实现
TMouseHook = class(TMouseHookBase)
private
FOnMouseMove: TMouseMoveNotify;
FOnMouseClick: TMouseClickNotify;
procedure DoMouseMove(const Handle: HWND; const X, Y: Integer);
procedure DoMouseClick(const Handle: HWND; const X, Y: Integer);
protected
procedure ProcessMessage(var Message: TMessage); override;
public
published
property DLLName;
property OnMouseMove: TMouseMoveNotify read FOnMouseMove write FOnMouseMove;
property OnMouseClick: TMouseClickNotify read FOnMouseClick write FOnMouseClick;
end;
var
// 全局变量
DLLLoaded: BOOL = False;
StartMouseHook: TEnableMouseHook;
StopMouseHook: TDisableMouseHook;
implementation
var
DLLHandle: HMODULE;
procedure UnloadDLL; // 卸载dll
begin
DLLLoaded := False;
if DLLHandle <> 0 then
begin
FreeLibrary(DLLHandle);
DLLHandle := 0;
// 释放函数指针
@StartMouseHook := nil;
@StopMouseHook := nil;
end;
end;
function LoadDLL(const FileName: string): Integer; // 加载dll
begin
Result := 0;
if DLLLoaded then
Exit;
DLLHandle := LoadLibraryEx(PChar(FileName), 0, 0);
if DLLHandle <> 0 then
begin
DLLLoaded := True;
// 传递函数指针
@StartMouseHook := GetProcAddress(DLLHandle, 'EnableMouseHook');
@StopMouseHook := GetProcAddress(DLLHandle, 'DisableMouseHook');
if (@StartMouseHook = nil) or (@StopMouseHook = nil) then
begin
Result := 0;
UnloadDLL;
Exit;
end;
Result := 1;
end
else
MessageBox(0, PChar(DEFDLLNAME + ' library could not be loaded !'),
'Error', MB_ICONERROR);
end;
{ TInputHook }
constructor TMouseHookBase.Create;
begin
pMapMem := nil;
hMappingFile := 0;
FDLLName := DEFDLLNAME;
FBlocked := True;
// 产生独一无二的消息id
MSG_MOUSEMOVE := RegisterWindowMessage(MSGMOUSEMOVE);
MSG_MOUSECLICK := RegisterWindowMessage(MSGMOUSECLICK);
end;
destructor TMouseHookBase.Destroy;
begin
Stop;
inherited;
end;
procedure TMouseHookBase.WndProc(var Message: TMessage);
begin
if pMapMem = nil then
begin
hMappingFile := OpenFileMapping(FILE_MAP_WRITE, False, MappingFileName);
if hMappingFile = 0 then
MessageBox(0, 'cannot create share memory!', 'Error', MB_OK or MB_ICONERROR);
pMapMem := MapViewOfFile(hMappingFile, FILE_MAP_WRITE or FILE_MAP_READ, 0, 0, 0);
if pMapMem = nil then
begin
CloseHandle(hMappingFile);
MessageBox(0, 'cannot map share memory!', 'Error', MB_OK or MB_ICONERROR);
end;
end;
if pMapMem = nil then
Exit;
// 消息过滤
if (Message.Msg = MSG_MOUSEMOVE) or (Message.Msg = MSG_MOUSECLICK) then
begin
Message.WParam := pMapMem.MouseStruct.hwnd;
Message.LParam := (pMapMem.MouseStruct.pt.X and $FFFF) or
(pMapMem.MouseStruct.pt.Y shl 16);
ProcessMessage(Message);
end
else
// 不需要处理的消息交给OS默认处理函数
Message.Result := DefWindowProc(FListenerHandle, Message.Msg, Message.wParam,
Message.lParam);
end;
function TMouseHookBase.Start: BOOL;
var
hookRes: Integer;
begin
Result := False;
if (not FActive) and (not FDLLLoaded) then
begin
if FDLLName = '' then
begin
Result := False;
Exit;
end
else
begin
hookRes := LoadDLL(FDLLName);
if hookRes = 0 then
begin
Result := False;
Exit;
end
else
begin
// 这是关键所在, 通过AllocateHWnd创建一个不可见的窗体, 来实现所有消息的中转
// 通过TMouseHookBase的WndProc来实现对消息的响应
FListenerHandle := AllocateHWnd(WndProc);
if FListenerHandle = 0 then
begin
Result := False;
Exit;
end
else
begin
if StartMouseHook(FListenerHandle, FBlocked) then
begin
Result := True;
FDLLLoaded := True;
FActive := True;
end
else
begin
Result := False;
Exit;
end;
end;
end;
end;
end;
end;
procedure TMouseHookBase.Stop;
begin
if FActive then
begin
if FListenerHandle <> 0 then
begin
pMapMem := nil;
if hMappingFile <> 0 then
begin
CloseHandle(hMappingFile);
hMappingFile := 0;
end;
DeallocateHWnd(FListenerHandle);
StopMouseHook;
FListenerHandle := 0;
end;
UnloadDLL;
FActive := False;
FDLLLoaded := False;
end;
end;
procedure TMouseHookBase.SetDLLName(const Value: string);
begin
if FActive then
MessageBox(0, 'Cannot activate hook because DLL name is not set.',
'Info', MB_OK + MB_ICONERROR)
else
FDLLName := Value;
end;
procedure TMouseHookBase.SetBlocked(const Value: BOOL);
begin
if FActive then
MessageBox(0, 'Cannot set block property of hook because hook is active!',
'Info', MB_OK + MB_ICONERROR)
else
FBlocked := Value;
end;
{ TMouseHook }
procedure TMouseHook.DoMouseClick(const Handle: HWND; const X, Y: Integer);
begin
if Assigned(FOnMouseClick) then
FOnMouseClick(Handle, X, Y);
end;
procedure TMouseHook.DoMouseMove(const Handle: HWND; const X, Y: Integer);
begin
if Assigned(FOnMouseMove) then
FOnMouseMove(Handle, X, Y);
end;
procedure TMouseHook.ProcessMessage(var Message: TMessage);
begin
if Message.Msg = MSG_MOUSEMOVE then
begin
DoMouseMove(Message.WParam, Message.LParamLo, Message.LParamHi);
end
else if Message.Msg = MSG_MOUSECLICK then
begin
DoMouseClick(Message.WParam, Message.LParamLo, Message.LParamHi);
end;
end;
end.
//==========================================
library MouseHook;
//============================================
library MouseHook;
uses
Windows, Messages;
const
MappingFileName = '57D6A971_MouseHookDLL_442C0DB1';
MSGMOUSEMOVE: PChar = 'MSGMOUSEMOVE57D6A971-049B-45AF-A8CD-37E0B706E036';
MSGMOUSECLICK: PChar = 'MSGMOUSECLICK442C0DB1-3198-4C2B-A718-143F6E2D1760';
type
TMappingMem = record
Handle: DWORD;
MsgID: DWORD;
MouseStruct: TMOUSEHOOKSTRUCT;
end;
PMappingMem = ^TMappingMem;
var
MSG_MOUSEMOVE: UINT;
MSG_MOUSECLICK: UINT;
hMappingFile: THandle;
pMapMem: PMappingMem;
mhook: HHook;
fblocked: BOOL = True;
//CriticalSection: TRTLCriticalSection;
function MouseHookProc(iCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall
begin
if fblocked then
Result := 1
else
Result := 0;
if iCode < 0 then
CallNextHookEx(mhook, iCode, wParam, lParam);
case wParam of
WM_MOUSEMOVE, WM_NCMouseMove:
begin
pMapMem^.MsgID := MSG_MOUSEMOVE;
pMapMem^.MouseStruct := pMOUSEHOOKSTRUCT(lparam)^;
SendMessage(pMapMem^.Handle, pMapMem^.MsgID, 0, 0);
end;
WM_LBUTTONDOWN, WM_NCLBUTTONDOWN:
begin
pMapMem^.MsgID := MSG_MOUSECLICK;
pMapMem^.MouseStruct := pMOUSEHOOKSTRUCT(lparam)^;
SendMessage(pMapMem^.Handle, pMapMem^.MsgID, 0, 0);
end;
WM_LBUTTONUP:
begin
end;
WM_LBUTTONDBLCLK:
begin
end;
WM_RBUTTONDOWN:
begin
end;
WM_RBUTTONUP:
begin
end;
WM_RBUTTONDBLCLK:
begin
end;
WM_MBUTTONDOWN:
begin
end;
WM_MBUTTONUP:
begin
end;
WM_MBUTTONDBLCLK:
begin
end;
end;
end;
function EnableMouseHook(hWindow: HWND; Blocked: BOOL): BOOL; stdcall;
begin
Result := False;
if mhook <> 0 then
Exit;
pMapMem^.Handle := hWindow;
fblocked := Blocked;
mhook := SetWindowsHookEx(WH_MOUSE, MouseHookProc, HInstance, 0);
Result := mhook <> 0;
end;
function DisableMouseHook: BOOL; stdcall;
begin
if mhook <> 0 then
begin
UnhookWindowshookEx(mhook);
mhook := 0;
end;
Result := mhook = 0;
end;
procedure DllMain(dwReason: DWORD);
begin
case dwReason of
DLL_PROCESS_ATTACH:
begin
//InitializeCriticalSection(CriticalSection);
hMappingFile := OpenFileMapping(FILE_MAP_WRITE, False, MappingFileName);
if hMappingFile = 0 then
begin
hMappingFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE,
0, SizeOf(TMappingMem), MappingFileName);
end;
if hMappingFile = 0 then
MessageBox(0, 'cannot create share memory!', 'Error', MB_OK or MB_ICONERROR);
pMapMem := MapViewOfFile(hMappingFile, FILE_MAP_WRITE or FILE_MAP_READ,
0, 0, 0);
if pMapMem = nil then
begin
CloseHandle(hMappingFile);
MessageBox(0, 'cannot map share memory!', 'Error', MB_OK or MB_ICONERROR);
end;
mhook := 0;
MSG_MOUSEMOVE := RegisterWindowMessage(MSGMOUSEMOVE);
MSG_MOUSECLICK := RegisterWindowMessage(MSGMOUSECLICK);
end;
DLL_PROCESS_DETACH:
begin
UnMapViewOfFile(pMapMem);
CloseHandle(hMappingFile);
if mhook <> 0 then
DisableMouseHook;
//DeleteCriticalSection(CriticalSection);
end;
DLL_THREAD_ATTACH:
begin
end;
DLL_THREAD_DETACH:
begin
end;
end;
end;
exports
EnableMouseHook,
DisableMouseHook;
begin
DisableThreadLibraryCalls(HInstance);
DLLProc := @DLLMain;
DLLMain(DLL_PROCESS_ATTACH);
end.
