Установка ловушки для клавиатуры

=== Установка ловушки для клавиатуры ===
==== Library Code for a Key Hook DLL ====
library HookLib;
uses
 madExcept,
 Windows,
 Messages,
 SysUtils;
type
 PHookRec = ^THookRec;
 THookRec = record
 AppHnd: integer;
 MemoHnd: integer;
 end;
var
 Hooked: boolean;
 hKeyHook, hMemo, hMemFile, hApp: HWND;
 PHookRec1: PHookRec;
function KeyHookFunc(Code, VirtualKey, KeyStroke: integer): LRESULT; stdcall;
var
 KeyState1: TKeyBoardState;
 AryChar: array[0..1] of char;
 Count: integer;
begin
 Result := 0;
 if Code = HC_NOREMOVE then
 Exit;
 Result := CallNextHookEx(hKeyHook, Code, VirtualKey, KeyStroke);
 { I moved the CallNextHookEx up here but if you want to block
 or change any keys then move it back down}
 if Code < 0 then
 Exit;
 if Code = HC_ACTION then
 begin
 if ((KeyStroke and (1 shl 30)) <> 0) then
 if not IsWindow(hMemo) then
 begin
 { I moved the OpenFileMapping up here so it would not be opened
 unless the app the DLL is attatched to gets some Key messages}
 hMemFile := OpenFileMapping(FILE_MAP_WRITE, False, 'Global7v9k');
 PHookRec1 := MapViewOfFile(hMemFile, FILE_MAP_WRITE, 0, 0, 0);
 if PHookRec1 <> nil then
 begin
 hMemo := PHookRec1.MemoHnd;
 hApp := PHookRec1.AppHnd;
 end;
 end;
 if ((KeyStroke and (1 shl 30)) <> 0) then
 begin
 GetKeyboardState(KeyState1);
 Count := ToAscii(VirtualKey, KeyStroke, KeyState1, AryChar, 0);
 if Count = 1 then
 begin
 SendMessage(hMemo, WM_CHAR, Ord(AryChar[0]), 0);
 { I included 2 ways to get the Charaters, a Memo Hnadle and
 a WM_USER+1678 message to the program}
 PostMessage(hApp, WM_USER + 1678, Ord(AryChar[0]), 0);
 end;
 end;
 end;
end;
function StartHook(MemoHandle, AppHandle: HWND): byte; export;
begin
 Result := 0;
 if Hooked then
 begin
 Result := 1;
 Exit;
 end;
 if not IsWindow(MemoHandle) then
 begin
 Result := 4;
 Exit;
 end;
 hKeyHook := SetWindowsHookEx(WH_KEYBOARD, KeyHookFunc, hInstance, 0);
 if hKeyHook > 0 then
 begin
 { you need to use a mapped file because this DLL attatches to every app
 that gets windows messages when it's hooked, and you can't get info except
 through a Globally avaiable Mapped file}
 hMemFile := CreateFileMapping($FFFFFFFF, // $FFFFFFFF gets a page memory file
 nil, // no security attributes
 PAGE_READWRITE, // read/write access
 0, // size: high 32-bits
 SizeOf(THookRec), // size: low 32-bits
 //SizeOf(Integer),
 'Global7v9k'); // name of map object
 PHookRec1 := MapViewOfFile(hMemFile, FILE_MAP_WRITE, 0, 0, 0);
 hMemo := MemoHandle;
 PHookRec1.MemoHnd := MemoHandle;
 hApp := AppHandle;
 PHookRec1.AppHnd := AppHandle;
 { set the Memo and App handles to the mapped file }
 Hooked := True;
 end
 else
 Result := 2;
end;
function StopHook: boolean; export;
begin
 if PHookRec1 <> nil then
 begin
 UnmapViewOfFile(PHookRec1);
 CloseHandle(hMemFile);
 PHookRec1 := nil;
 end;
 if Hooked then
 Result := UnhookWindowsHookEx(hKeyHook)
 else
 Result := True;
 Hooked := False;
end;
procedure EntryProc(dwReason: DWORD);
begin
 if (dwReason = Dll_Process_Detach) then
 begin
 if PHookRec1 <> nil then
 begin
 UnmapViewOfFile(PHookRec1);
 CloseHandle(hMemFile);
 end;
 UnhookWindowsHookEx(hKeyHook);
 end;
end;
exports
 StartHook,
 StopHook;
begin
 PHookRec1 := nil;
 Hooked := False;
 hKeyHook := 0;
 hMemo := 0;
 DLLProc := @EntryProc;
 EntryProc(Dll_Process_Attach);
end.
==== Code from the calling Program ====
this program get's the Char from the DLL in 2 ways, as a Char message to a Memo and as a DLLMessage WM_USER+1678
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;
type
 TForm1 = class(TForm)
 but_StartHook: TButton;
 but_StopHook: TButton;
 label1: TLabel;
 Memo1: TMemo;
 procedure but_StartHookClick(Sender: TObject);
 procedure but_StopHookClick(Sender: TObject);
 private
 { Private declarations }
 hLib2: THandle;
 DllStr1: string;
 procedure DllMessage(var Msg: TMessage); message WM_USER + 1678;
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.DllMessage(var Msg: TMessage);
begin
 if (Msg.wParam = 8) or (Msg.wParam = 13) then Exit;
 { the 8 is the Backspace and the 13 if the Enter key, You'll need to
 do some special handleing for a string}
 DllStr1 := DllStr1 + Chr(Msg.wParam);
 label1.Caption := DllStr1;
end;
procedure TForm1.but_StartHookClick(Sender: TObject);
type
 TStartHook = function(MemoHandle, AppHandle: HWND): Byte;
var
 StartHook1: TStartHook;
 SHresult: Byte;
begin
 hLib2 := LoadLibrary('HookLib.dll');
 @StartHook1 := GetProcAddress(hLib2, 'StartHook');
 if @StartHook1 = nil then Exit;
 SHresult := StartHook1(Memo1.Handle, Handle);
 if SHresult = 0 then ShowMessage('the Key Hook was Started, good');
 if SHresult = 1 then ShowMessage('the Key Hook was already Started');
 if SHresult = 2 then ShowMessage('the Key Hook can NOT be Started, bad');
 if SHresult = 4 then ShowMessage('MemoHandle is incorrect');
end;
procedure TForm1.but_StopHookClick(Sender: TObject);
type
 TStopHook = function: Boolean;
var
 StopHook1: TStopHook;
 hLib21: THandle;
begin
 @StopHook1 := GetProcAddress(hLib2, 'StopHook');
 if @StopHook1 = nil then
 begin
 ShowMessage('Stop Hook DLL Mem Addy not found');
 Exit;
 end;
 if StopHook1 then
 ShowMessage('Hook was stoped');
 FreeLibrary(hLib2);
 { for some reason in Win XP you need to call FreeLibrary twice
 maybe because you get 2 functions from the DLL? ?}
 FreeLibrary(hLib2);
end;
end.
{{lang_en}
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 02228