با سلام
چگونه میتوان کنترل صفحه کلید را در تمامی ویندوزها بدست گرفت ؟
Library TheHook;
uses
Windows, Messages, SysUtils;
{Define a record for recording and passing information process wide}
type
PHookRec = ^ THookRec;
THookRec = Packed Record
TheHookHandle: HHOOK;
TheAppWinHandle: HWnd;
TheCtrlWinHandle: HWnd;
TheKeyCount: DWord;
end;
var
hObjHandle : THandle; {Variable for the file mapping object}
lpHookRec : PHookRec;
{Pointer to our hook record}
procedure MapFileMemory (dwAllocSize: DWord);
begin { MapFileMemory }
{Create a process wide memory mapped variable}
hObjHandle := CreateFileMapping ($FFFFFFFF, Nil, PAGE_READWRITE, 0,
dwAllocSize, 'HookRecMemBlock');
if (hObjHandle = 0) then
begin
MessageBox (0, 'Hook DLL', 'Could not create file map object', mb_Ok);
exit
end { (hObjHandle = 0) };
{Get a pointer to our process wide memory mapped variable}
lpHookRec := MapViewOfFile (hObjHandle, FILE_MAP_WRITE, 0, 0, dwAllocSize);
if (lpHookRec = Nil) then
begin
CloseHandle (hObjHandle);
MessageBox (0, 'Hook DLL', 'Could not map file', mb_Ok);
exit
end { (lpHookRec = Nil) }
end; { MapFileMemory }
procedure UnMapFileMemory;
begin { UnMapFileMemory }
{Delete our process wide memory mapped variable}
if (lpHookRec <> Nil) then
begin
UnMapViewOfFile (lpHookRec);
lpHookRec := Nil
end { (lpHookRec <> Nil) };
if (hObjHandle > 0) then
begin
CloseHandle (hObjHandle);
hObjHandle := 0
end { (hObjHandle > 0) }
end; { UnMapFileMemory }
function GetHookRecPointer : pointer
stdcall;
begin { GetHookRecPointer }
{Return a pointer to our process wide memory mapped variable}
Result := lpHookRec
end; { GetHookRecPointer }
{The function that actually processes the keystrokes for our hook}
function KeyBoardProc (code: Integer; wParam: Integer; lParam: Integer) :
Integer;
stdcall;
var
KeyUp : bool;
{Remove comments for additional functionability
IsAltPressed : bool;
IsCtrlPressed : bool;
IsShiftPressed : bool;
}
begin { KeyBoardProc }
Result := 0;
Case code Of
HC_ACTION:
begin
{We trap the keystrokes here}
{Is this a key up message?}
KeyUp := ((lParam and (1 shl 31)) <> 0);
(*Remove comments for additional functionability
{Is the Alt key pressed}
if ((lParam and (1 shl 29)) <> 0) then begin
IsAltPressed := TRUE;
end else begin
IsAltPressed := FALSE;
end;
{Is the Control key pressed}
if ((GetKeyState(VK_CONTROL) and (1 shl 15)) <> 0) then begin
IsCtrlPressed := TRUE;
end else begin
IsCtrlPressed := FALSE;
end;
{if the Shift key pressed}
if ((GetKeyState(VK_SHIFT) and (1 shl 15)) <> 0) then begin
IsShiftPressed := TRUE;
end else begin
IsShiftPressed := FALSE;
end;
*)
{if KeyUp then increment the key count}
if (KeyUp <> false) then
begin
inc (lpHookRec^.TheKeyCount)
end { (KeyUp <> false) };
Case wParam Of
{Was the enter key pressed?}
VK_RETURN:
begin
{if KeyUp}
if (KeyUp <> false) then
begin
{Post a bogus message to the window control in our app}
PostMessage (lpHookRec^.TheCtrlWinHandle, WM_KEYDOWN, 0, 0);
PostMessage (lpHookRec^.TheCtrlWinHandle, WM_KEYUP, 0, 0)
end { (KeyUp <> false) };
{if you wanted to swallow the keystroke then return -1}
{else if you want to allow the keystroke then return 0}
Result := 0;
exit
end; {VK_RETURN}
{if the left arrow key is pressed then lets play a joke!}
VK_LEFT:
begin
{if KeyUp}
if (KeyUp <> false) then
begin
{Create a UpArrow keyboard event}
keybd_event (VK_RIGHT, 0, 0, 0);
keybd_event (VK_RIGHT, 0, KEYEVENTF_KEYUP, 0)
end { (KeyUp <> false) };
{Swallow the keystroke}
Result := -1;
exit
end; {VK_LEFT}
end { case wParam }; {case wParam}
{Allow the keystroke}
Result := 0
end; {HC_ACTION}
HC_NOREMOVE:
begin
{This is a keystroke message, but the keystroke message}
{has not been removed from the message queue, since an}
{application has called PeekMessage() specifying PM_NOREMOVE}
Result := 0;
exit
end;
end { case code }; {case code}
if (code < 0) then
{Call the next hook in the hook chain}
Result := CallNextHookEx (lpHookRec^.TheHookHandle, code, wParam, lParam)
end; { KeyBoardProc }
procedure StartKeyBoardHook
stdcall;
begin { StartKeyBoardHook }
{if we have a process wide memory variable}
{and the hook has not already been set...}
if ((lpHookRec <> Nil) and (lpHookRec^.TheHookHandle = 0)) then
begin
{Set the hook and remember our hook handle}
lpHookRec^.TheHookHandle := SetWindowsHookEx (WH_KEYBOARD, @KeyBoardProc,
HInstance, 0)
end { ((lpHookRec <> Nil) and (lpHookRec^.TheHookHandle = 0)) }
end; { StartKeyBoardHook }
procedure StopKeyBoardHook
stdcall;
begin { StopKeyBoardHook }
{if we have a process wide memory variable}
{and the hook has already been set...}
if ((lpHookRec <> Nil) and (lpHookRec^.TheHookHandle <> 0)) then
begin
{Remove our hook and clear our hook handle}
if (UnHookWindowsHookEx (lpHookRec^.TheHookHandle) <> false) then
begin
lpHookRec^.TheHookHandle := 0
end { (UnHookWindowsHookEx (lpHookRec^.TheHookHandle) <> false) }
end { ((lpHookRec <> Nil) and (lpHookRec^.TheHookHandle <> 0)) }
end; { StopKeyBoardHook }
procedure DllEntryPoint (dwReason: DWord);
begin { DllEntryPoint }
Case dwReason Of
Dll_Process_Attach:
begin
{if we are getting mapped into a process, then get}
{a pointer to our process wide memory mapped variable}
hObjHandle := 0;
lpHookRec := Nil;
MapFileMemory (sizeof (lpHookRec^))
end;
Dll_Process_Detach:
begin
{if we are getting unmapped from a process then, remove}
{the pointer to our process wide memory mapped variable}
UnMapFileMemory
end;
end { case dwReason }
end; { DllEntryPoint }
Exports
KeyBoardProc name 'KEYBOARDPROC',
GetHookRecPointer name 'GETHOOKRECPOINTER',
StartKeyBoardHook name 'STARTKEYBOARDHOOK',
StopKeyBoardHook name 'STOPKEYBOARDHOOK';
begin
{Set our Dll's main entry point}
DLLProc := @DllEntryPoint;
{Call our Dll's main entry point}
DllEntryPoint (Dll_Process_Attach)
end.
پاسخ با نقل قول
