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;
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;
解决方案 »
- delphi开发BHO,打开新网页时我想打开一个form窗口 有源码下载
- 怎么利用delphi调用WINEXEC函数删除本地文件
- Delphi将图片保存至Sql Server中的小问题?
- 本人自创的图像填充浮雕效果,欢迎提出改进意见
- 用Delphi操作LCD:怎么显示,怎么清空????
- toolbar的按钮中图片和文字能呈现左右排列吗,而非上下排列
- 一个一直困惑我的问题
- 敬请看......
- 怎样清空ADOQuerey中查询出来的所有数据?
- 用delphi能不能做这样的软件,阻止某ip通过局域网访问internet?
- ???? 在子窗口调用模式窗口 着急
- 谁有《深入delphi6网络编程》的光盘源码?
{ }
{ 这是一个截获全局消息的组件 }
{ }
{ 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.