mousehook.pas

用DLL文件的形式挂载键盘与鼠标钩子的例子

{

 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.