var
st,et,ct: int64;
procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
QueryPerformanceCounter(et);
QueryPerformanceFrequency(ct);
if ((et-st)/ct<2.000) then
key:=chr(0);
st:=et;
end;
如果是监控某个程序用2楼的可以,如果是监控全局则要使用钩子,下面是一个监控键盘的钩子代码:
unit KeyboardHook;
interface
uses
Windows, Messages, Classes, IdleConst;
const
DEFDLLNAME = 'IdleKeyboard.dll';
type
TEnableKeyboardHook = function(hWindow: HWND): BOOL; stdcall;
TDisableKeyboardHook = function: BOOL; stdcall;
TKeyDownNotify = procedure(const KeyCode: Integer) of object;
TKeyUpNotify = procedure(const KeyCode: Integer) of object;
TKeyboardHookBase = class
private
FDLLName: string;
FDLLLoaded: BOOL;
FListenerHandle: HWND;
FActive: BOOL;
hMappingFile: THandle;
pMapMem: PKeyboardMappingMem;
procedure WndProc(var Message: TMessage);
procedure SetDLLName(const Value: string);
protected
MSG_KEYDOWN: UINT;
MSG_KEYUP: 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;
end;
TKeyboardHook = class(TKeyboardHookBase)
private
FOnKeyDown: TKeyDownNotify;
FOnKeyUp: TKeyUpNotify;
procedure DoKeyDown(const KeyCode: Integer);
procedure DoKeyUp(const KeyCode: Integer);
protected
procedure ProcessMessage(var Message: TMessage); override;
public
published
property DLLName;
property OnKeyDown: TKeyDownNotify read FOnKeyDown write FOnKeyDown;
property OnKeyUp: TKeyUpNotify read FOnKeyUp write FOnKeyUp;
end;
var
DLLLoaded: BOOL = False;
StartKeyboardHook: TEnableKeyboardHook;
StopKeyboardHook: TDisableKeyboardHook;
implementation
var
DLLHandle: HMODULE;
procedure UnloadDLL;
begin
DLLLoaded := False;
if DLLHandle <> 0 then
begin
FreeLibrary(DLLHandle);
DLLHandle := 0;
@StartKeyboardHook := nil;
@StopKeyboardHook := nil;
end;
end;
function LoadDLL(const FileName: string): Integer;
begin
Result := 0;
if DLLLoaded then
Exit;
DLLHandle := LoadLibraryEx(PChar(FileName), 0, 0);
if DLLHandle <> 0 then
begin
DLLLoaded := True;
@StartKeyboardHook := GetProcAddress(DLLHandle, 'EnableKeyboardHook');
@StopKeyboardHook := GetProcAddress(DLLHandle, 'DisableKeyboardHook');
if (@StartKeyboardHook = nil) or (@StopKeyboardHook = 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 TKeyboardHookBase.Create;
begin
pMapMem := nil;
hMappingFile := 0;
FDLLName := DEFDLLNAME;
MSG_KEYDOWN := RegisterWindowMessage(MSGKEYDOWN);
MSG_KEYUP := RegisterWindowMessage(MSGKEYUP);
end;
destructor TKeyboardHookBase.Destroy;
begin
Stop;
inherited;
end;
procedure TKeyboardHookBase.WndProc(var Message: TMessage);
begin
if pMapMem = nil then
begin
hMappingFile := OpenFileMapping(FILE_MAP_WRITE, False, KeyboardMappingFileName);
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_KEYDOWN) or (Message.Msg = MSG_KEYUP) then
begin
Message.WParam := pMapMem.KeyCode;
ProcessMessage(Message);
end
else
Message.Result := DefWindowProc(FListenerHandle, Message.Msg, Message.wParam,
Message.lParam);
end;
function TKeyboardHookBase.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
FListenerHandle := AllocateHWnd(WndProc);
if FListenerHandle = 0 then
begin
Result := False;
Exit;
end
else
begin
if StartKeyboardHook(FListenerHandle) then
begin
Result := True;
FDLLLoaded := True;
FActive := True;
end
else
begin
Result := False;
Exit;
end;
end;
end;
end;
end;
end;
procedure TKeyboardHookBase.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);
StopKeyboardHook;
FListenerHandle := 0;
end;
UnloadDLL;
FActive := False;
FDLLLoaded := False;
end;
end;
procedure TKeyboardHookBase.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;
{ TKeyboardHook }
procedure TKeyboardHook.DoKeyDown(const KeyCode: Integer);
begin
if Assigned(FOnKeyDown) then
FOnKeyDown(KeyCode);
end;
procedure TKeyboardHook.DoKeyUp(const KeyCode: Integer);
begin
if Assigned(FOnKeyUp) then
FOnKeyUp(KeyCode);
end;
procedure TKeyboardHook.ProcessMessage(var Message: TMessage);
begin
if Message.Msg = MSG_KEYDOWN then
begin
DoKeyDown(Message.WParam);
end
else if Message.Msg = MSG_KEYUP then
begin
DoKeyUp(Message.WParam);
end;
end;
end.
这个是我DLL的所有代码,发给你,你看一下,初学者建议还是搞懂原理,再来做,否则不利于你将来的发展。
library IdleKeyboard;
uses
Windows,
Messages,
IdleConst in 'IdleConst.pas';
var
MSG_KEYDOWN: UINT;
MSG_KEYUP: UINT;
hMappingFile: THandle;
pMapMem: PKeyboardMappingMem;
khook: HHook;
function KeyboardHookProc(iCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall
begin
if iCode >= HC_ACTION then
begin
pMapMem^.KeyCode := wParam;
case ((lParam shr 30) and $F) of
0: // Key down
begin
pMapMem^.MsgID := MSG_KEYDOWN;
SendMessage(pMapMem^.Handle, pMapMem^.MsgID, 0, 0);
end;
1: // key up
begin
pMapMem^.MsgID := MSG_KEYUP;
SendMessage(pMapMem^.Handle, pMapMem^.MsgID, 0, 0);
end;
end;
end;
Result := CallNextHookEx(khook, iCode, wParam, lParam);
end;
function EnableKeyboardHook(hWindow: HWND): BOOL; stdcall;
begin
Result := False;
if khook <> 0 then
Exit;
pMapMem^.Handle := hWindow;
khook := SetWindowsHookEx(WH_KEYBOARD, KeyboardHookProc, HInstance, 0);
Result := khook <> 0;
end;
function DisableKeyboardHook: BOOL; stdcall;
begin
if khook <> 0 then
begin
UnhookWindowshookEx(khook);
khook := 0;
end;
Result := khook = 0;
end;
procedure DllMain(dwReason: DWORD);
begin
case dwReason of
DLL_PROCESS_ATTACH:
begin
hMappingFile := OpenFileMapping(FILE_MAP_WRITE, False, KeyboardMappingFileName);
if hMappingFile = 0 then
begin
hMappingFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE,
0, SizeOf(TKeyboardMappingMem), KeyboardMappingFileName);
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;
khook := 0;
MSG_KEYDOWN := RegisterWindowMessage(MSGKEYDOWN);
MSG_KEYUP := RegisterWindowMessage(MSGKEYUP);
end;
DLL_PROCESS_DETACH:
begin
UnMapViewOfFile(pMapMem);
CloseHandle(hMappingFile);
if khook <> 0 then
DisableKeyboardHook;
end;
DLL_THREAD_ATTACH:
begin
end;
DLL_THREAD_DETACH:
begin
end;
end;
end;
exports
EnableKeyboardHook,
DisableKeyboardHook;
begin
DisableThreadLibraryCalls(HInstance);
DLLProc := @DLLMain;
DLLMain(DLL_PROCESS_ATTACH);
end.
unit IdleConst;
interface
uses Windows;
const
MouseMappingFileName = 'Sample_MouseHookDLL_442C0DB1';
KeyboardMappingFileName = 'Sample_KeyboardHookDLL_442C0DB1';
MSGMOUSE: PChar = 'MSGMOUSE57D6A971-049B-45AF-A8CD-37E0B706E036';
MSGKEYDOWN: PChar = 'MSGKEYDOWN57D6A971-049B-45AF-A8CD-37E0B706E036';
MSGKEYUP: PChar = 'MSGKEYUP442C0DB1-3198-4C2B-A718-143F6E2D1760';
type
TMouseMappingMem = record
Handle: DWORD;
MsgID: DWORD;
MouseStruct: TMOUSEHOOKSTRUCT;
end;
PMouseMappingMem = ^TMouseMappingMem;
TKeyboardMappingMem = record
Handle: DWORD;
MsgID: DWORD;
KeyCode: DWORD;
end;
PKeyboardMappingMem = ^TKeyboardMappingMem;
implementation
end.