procedure SetMessageTrappingHook; stdcall;
var
  TheHandle : HWND;
  TheThread : DWORD;
begin
  TheHandle := FindWindow('Whatever',NIL);
  if TheHandle <> 0 then begin
    TheThread := GetWindowThreadProcessId(TheHandle,NIL);
    HookProcHandle := SetWindowsHookEx(WH_CALLWNDPROC,@CallWndProc,
                                       HInstance,TheThread);
    if HookProcHandle <> 0 then
       NewMessages:=0;
    else
      ShowMessage('Setting Hook Failed.');
  end else
    showmessage('Icon Author is not currently running.');
end;

解决方案 »

  1.   

    {******************************************************************************}
    {                                                                              }
    { 这是一个截获全局消息的组件                                                   }
    {                                                                              }
    { This is a component for capturing global message                             }
    {                                                                              }
    {******************************************************************************}
    {************************************************}
    {                                                }
    { 它可以截获键盘与鼠标事件,并可以得到触发事件   }
    { 的来源句柄、来源所在的进程...以及其他一些信息  }
    {                                                }
    { It can capture keyboard event and mouse event, }
    { and can capture source handle from causeing    }
    { event , process of  source...and  other        }
    { information                                    }
    {                                                }
    {************************************************}
    unit SysHook;interfaceuses
      Windows, Messages, SysUtils, Classes,TlHelp32;type
      {截获消息的结构 the structure of message}
      TEventMsg = ^_EventMsg;
      _EventMsg = packed record
        Message : UINT;
        ParamL : UINT;
        ParamH : UINT;
        Time : DWORD;
        Hwnd : HWND;
      end;  TMouseButton = (mbLeft, mbRight, mbMiddle);  TGetMessageEvent =
            procedure (Msg : TEventMsg) of object;  TGetKeyDownMessage =
            procedure (Key : Word;Winhandle :HWND) of object;  TGetKeyUpMessage =
            procedure (Key : Word;Winhandle :HWND) of object;  TGetMouseDownMessage =
            procedure (Button : TMouseButton;
                       WinHandle :HWND;X, Y : integer) of object;  TGetMouseUpMessage =
            procedure (Button : TMouseButton;
                       WinHandle :HWND;X, Y : integer) of object;  TGetMouseMoveMessage =
            procedure (X, Y : integer) of object;  TSysHook = class(TComponent)
      private
        FHooking: boolean;
        Handle : HHOOK;
        FOnGetMessage : TGetMessageEvent;
        FOnKeyDown: TGetKeyDownMessage;
        FOnKeyUp: TGetKeyUpMessage;
        FOnMouseDown: TGetMouseDownMessage;
        FOnMouseUp: TGetMouseupMessage;
        FOnMouseMove: TGetMouseMoveMessage;
        procedure SetHooking(const Value: boolean);
      protected
        procedure DoKeyDown(Msg : TEventMsg);dynamic;
        procedure DoKeyUp(Msg : TEventMsg);dynamic;
        procedure DoMouseDown(Msg : TEventMsg);dynamic;
        procedure DoMouseUp(Msg : TEventMsg);dynamic;
        procedure DoMouseMove(Msg : TEventMsg);dynamic;
      public
        constructor Create(AOwner : TComponent);override;
        destructor Destroy;override;
        function GetProcessInfo(AProcessID : DWORD):PProcessEntry32;
        function GetWinClassName(WinHandle : HWND):string;
        function GetProcess(WinHandle : HWND):DWORD;
        function GetInstance(WinHandle : HWND):DWORD;
      published
        property Enabled : boolean
                   read FHooking write SetHooking;
        property OnGetMessage : TGetMessageEvent
                   read FOnGetMessage write FOnGetMessage;
        property OnKeyDown : TGetKeyDownMessage
                   read FOnKeyDown write FOnKeyDown;
        property OnKeyUp : TGetKeyUpMessage
                   read FOnKeyUp write FOnKeyUp;
        property OnMouseDown : TGetMouseDownMessage
                   read FOnMouseDown write FOnMouseDown;
        property OnMouseUp : TGetMouseupMessage
                   read FOnMouseUp write FOnMouseUp;
        property OnMouseMove : TGetMouseMoveMessage
                   read FOnMouseMove write FOnMouseMove;
      end;procedure Register;implementationfunction Play(Code : integer;wParam, lParam : Longint):Longint;stdcall;forward;var
      _Hook : TSysHook;procedure Register;
    begin
      RegisterComponents('Samples', [TSysHook]);
    end;
    { TSysHook }constructor TSysHook.Create(AOwner : TComponent);
    begin
      inherited Create(AOwner);
      _Hook := Self;
    end;destructor TSysHook.Destroy;
    begin
      Enabled := False;
      _Hook := nil;
      inherited;
    end;function Play(Code, wParam, lParam: Longint): Longint;
    begin
      Result := 0;
      if (Code = HC_ACTION) or (Code =HC_SYSMODALON)or(Code=HC_SYSMODALOFF)then
      begin
        if Assigned(_Hook.FOnGetMessage) then
          _Hook.FOnGetMessage(TEventMsg(lParam));    if TEventMsg(lParam).Message = WM_KEYDOWN then
          _Hook.DoKeyDown(TEventMsg(lParam));    if TEventMsg(lParam).Message = WM_KEYUP then
          _Hook.DoKeyUp(TEventMsg(lParam));    if (TEventMsg(lParam).Message = WM_LBUTTONDOWN) or
           (TEventMsg(lParam).Message = WM_RBUTTONDOWN) or
           (TEventMsg(lParam).Message = WM_MBUTTONDOWN) then
           _Hook.DoMouseDown(TEventMsg(lParam));    if (TEventMsg(lParam).Message = WM_LBUTTONUP) or
           (TEventMsg(lParam).Message = WM_RBUTTONUP) or
           (TEventMsg(lParam).Message = WM_MBUTTONUP) then
           _Hook.DoMouseUp(TEventMsg(lParam));    if TEventMsg(lParam).Message = WM_MOUSEMOVE then
          _Hook.DoMouseMove(TEventMsg(lParam));
      end;
     if Code < 0 then
        Result := CallNextHookEx(_Hook.Handle,Code,wParam,lParam);
    end;procedure TSysHook.DoKeyDown(Msg: TEventMsg);
    var
      AKey : array [0..1] of Char;
      AState : TKeyboardState;
    begin
      try
        GetKeyboardState(AState);
        ToAscii(Msg.ParamL,Msg.ParamH,AState,AKey,0);
        if Assigned(FOnKeyDown) then
          FOnKeyDown(Ord(AKey[0]),GetFocus);
      except
      end;
    end;procedure TSysHook.DoKeyUp(Msg: TEventMsg);
    var
      AKey : array [0..1] of Char;
      AState : TKeyboardState;
    begin
      try
        GetKeyboardState(AState);
        ToAscii(Msg.ParamL,Msg.ParamH,AState,AKey,0);
        if Assigned(FOnKeyUp) then
          FOnKeyUp(Ord(AKey[0]),GetFocus);
      except
      end;
    end;procedure TSysHook.DoMouseDown(Msg: TEventMsg);
    var
      Button : TMouseButton;
    begin
      Button := mbLeft;
      case Msg.Message of
        WM_LBUTTONDOWN : button := mbLeft;
        WM_RBUTTONDOWN : Button := mbRight;
        WM_MBUTTONDOWN : Button := mbMiddle;
      end;
      if Assigned(FOnMouseDown) then
        FOnMouseDown(Button,Msg.Hwnd,Msg.ParamL,Msg.ParamH);
    end;procedure TSysHook.DoMouseMove(Msg: TEventMsg);
    begin
      if Assigned(FOnMouseMove) then
        FOnMouseMove(Msg.ParamL,Msg.ParamH);
    end;procedure TSysHook.DoMouseUp(Msg: TEventMsg);
    var
      Button : TMouseButton;
    begin
      Button := mbLeft;
      case Msg.Message of
        WM_LBUTTONUP : button := mbLeft;
        WM_RBUTTONUP : Button := mbRight;
        WM_MBUTTONUP : Button := mbMiddle;
      end;
      if Assigned(FOnMouseUp) then
        FOnMouseUp(Button,Msg.Hwnd,Msg.ParamL,Msg.ParamH);
    end;function TSysHook.GetInstance(WinHandle: HWND): DWORD;
    begin
      Result := GetWindowLong(WinHandle,GWL_HINSTANCE);
    end;function TSysHook.GetProcess(WinHandle: HWND): DWORD;
    var
      p : DWORD;
    begin
      GetWindowThreadProcessId(WinHandle,@p);
      Result := P;
    end;function TSysHook.GetProcessInfo(AProcessID: DWORD): PProcessEntry32;
    var
      Snap : THandle;
      PE : TProcessEntry32;
      PPE : PProcessEntry32;
      Found : boolean;
    begin
      Snap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS,0);
      PE.dwSize := SizeOf(PE);
      PPE := nil;
      Found := False;
      if Process32First(Snap,PE) then
      repeat
        if (PE.th32ProcessID =  AProcessID) then
          Found := True;
      until (Found = true) or (not Process32Next(Snap,PE));
      if Found then
      begin
        new(PPE);
        PPE^ := PE;
      end;
      Result := PPE;
    end;function TSysHook.GetWinClassName(WinHandle: HWND): string;
    var
      ClassName : pChar;
    begin
      GetMem(ClassName,256);
      GetClassName(WinHandle,ClassName,256);
      Result := string(ClassName);
    end;procedure TSysHook.SetHooking(const Value: boolean);
    begin
      FHooking := Value;
      if Value then
          Handle := SetWindowsHookEx(WH_JOURNALRECORD,Play,hInstance,0)
      else
        UnHookWindowsHookEx(Handle);
    end;end.
      

  2.   

    我不是要用WH_JOURNALRECORD钩子事件,不是想对外设输入事件进行截取或重放,而是想用KH_KEYBOARD和KEY_MOUSE这两个钩子函数,现想要知道的是对于WH_CALLWNDPROC、WH_GETMESSAGE WH_SHELL、WH_MSGFILTER等的系统钩子设置好了以后,回调函数该怎样使用,在返回的数值信息中,lparam和rparam里所附的返回值该怎样处理,例如怎样知道返回值为某一窗口的wm_paint或者别的什么附加于该窗口的消息