1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:

procedure TForm1.FormActivate(Sender: TObject);
begin
Test1 := TCPTest.Create(self);
Test1.OnKey :=  onkeypressed;
Test1.Start_Test;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
Test1.Stop_Test;
Test1.Free;
Test1 := nil;
end;					

1:

if FileExists(\Test.dll) then //|==> hier erst die DLL laden					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:

procedure TForm1.FormActivate(Sender: TObject);
begin
KeyHook1 := TCPKeyHook.Create(self);
KeyHook1.OnKey :=  onkeypressed;
KeyHook1.Start_KeyHook;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
KeyHook1.Stop_KeyHook;
KeyHook1.Free;
KeyHook1 := nil;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:

unit CPKeyHook;

interface

uses Windows, Messages, Classes, Forms;

const
  HOOKLIBNAME = 'test.dll';
  WM_KEYHOOKMSG = WM_USER+303;
 { Keyboard Generated clockticks each 15secs }
  KEYTICK_MSG : integer = $C0000001;
  KEYWAIT_MSG : integer = $00000001;

function Hook_Start(WinHandle : HWND; MsgToSend : integer) : boolean;
  stdcall external HOOKLIBNAME name 'KeyboardHook_Start';

function Hook_Stop : boolean;
  stdcall external HOOKLIBNAME name 'KeyboardHook_Stop';

type
TKeyStates = packed record
  KeyTickMsg : Boolean;
  KeyDown : Boolean;
  ShiftDown: Boolean;
  AltDown: Boolean;
  CtrlDown: Boolean;
  ExtendedKey: Boolean;
  MenuKey: Boolean;
  KeyRepeated: Boolean;
  RepeatCount: integer;
  end;

TKeyNames = packed record
 KeyChar: Char;
 KeyExtName: array[0..100] of Char;
 end;

type
TKeyHookedEvent = procedure(Sender: TObject; AKeyStates: TKeyStates; AKeyNames: TKeyNames) of object;

type
  TCPKeyHook = class(TComponent)
  private
   FHandle: HWnd;
   FEnabled: Boolean;
   FKeyLayout: string;
   FKeyHandle: integer;
   FOnKey: TKeyHookedEvent;
   procedure HookMsg(var msg : TMessage); message WM_KEYHOOKMSG;
   procedure SetEnabled(AValue: boolean);
   procedure SetNoneStr(AValue: string);
  protected
   procedure MainWndProc(var Message: TMessage);
   procedure WndProc(var Message: TMessage); virtual;
  public
   constructor Create(AOwner:TComponent); override;
   destructor Destroy; override;
   procedure DefaultHandler(var Message); override;
   function Start_KeyHook: boolean;
   function Stop_KeyHook: boolean;
  published
   property Enabled: boolean read FEnabled write SetEnabled;
   property KeyboardLayout: string read FKeyLayout write SetNoneStr;
   property KeyboardHandle: integer read FKeyHandle;
   property OnKey: TKeyHookedEvent read FOnKey write FOnKey;
  end;

var
  keyreps: integer;

implementation

procedure TCPKeyHook.SetNoneStr(AValue: string);begin;end;
procedure TCPKeyHook.SetEnabled(AValue: boolean);begin;end;

constructor TCPKeyHook.Create(AOwner: TComponent);
var
KLayout : array[0..KL_NAMELENGTH] of char;
begin
 inherited Create(AOwner);
 {if not (csDesigning in ComponentState) then}
FHandle := AllocateHWnd(MainWndProc);
keyreps := 0;
FEnabled := False;
GetKeyboardLayoutName(@KLayout);
FKeyHandle := GetKeyboardLayout(0);
FKeyLayout := KLayout;
end;

destructor TCPKeyHook.Destroy;
begin
TRY
Hook_Stop;
DeallocateHWnd(FHandle);
FINALLY
inherited Destroy;
END;
end;

procedure TCPKeyHook.MainWndProc(var Message: TMessage);
begin
 WndProc(Message);
end;

procedure TCPKeyHook.WndProc(var Message: TMessage);
begin
 Dispatch(Message)
end;

procedure TCPKeyHook.DefaultHandler(var Message);
begin
TMessage(Message).Result := DefWindowProc(FHandle, TMessage(Message).Msg,
    TMessage(Message).wParam, TMessage(Message).lParam)
end;

procedure TCPKeyHook.HookMsg(var msg : TMessage);
var
FKeyState: TKeyStates;
FKeyNames: TKeyNames;
VKeyName : array[0..100] of char;
VKeyChar : char;
KBS : TKeyboardState;
begin
  fillchar(VKeyName,SizeOf(VKeyName),#0);
  FKeyNames.KeyChar := #0;
  FKeyState.KeyTickMsg := (msg.lParam = KEYTICK_MSG) or (msg.lParam = KEYWAIT_MSG);
  FKeyState.KeyDown := (msg.lParam AND (1 shl 31)) = 0;
  FKeyState.KeyRepeated := (msg.lParam AND (1 shl 30)) <> 0;
  FKeyState.AltDown := (msg.lParam AND (1 shl 29)) <> 0;
  FKeyState.MenuKey := (msg.lParam AND (1 shl 28)) <> 0;
  FKeyState.ExtendedKey := (msg.lParam AND (1 shl 24)) <> 0;
  FKeyState.CtrlDown := (GetKeyState(VK_CONTROL) AND (1 shl 15)) <> 0;
  FKeyState.ShiftDown  := (GetKeyState(VK_SHIFT) AND (1 shl 15)) <> 0;
  if (FKeyState.KeyRepeated and FKeyState.KeyDown) then inc(keyreps)
  else keyreps := 0;
  FKeyState.RepeatCount := keyreps;
  GetKeyboardState(KBS);
  GetKeyNameText(msg.LParam,@VKeyName,SizeOf(VKeyName));
  move(VKeyName,FKeyNames.KeyExtName,SizeOf(VKeyName));
  //AsciiChar := Char(ToAsciiEx(Msg.WParam, Msg.LParam, KBS, @VKeyChar, Msg.LParam, FKeyHandle));
  //if ToAsciiEx(Msg.WParam, Msg.LParam, KBS, @VKeyChar, Msg.LParam, FKeyHandle) <> 0
  if ToAscii(Msg.WParam, Msg.LParam, KBS, @VKeyChar, Integer(FKeyState.MenuKey)) <> 0
  then FKeyNames.KeyChar := VKeyChar;
  if Assigned(FOnKey) then FOnKey(self,FKeyState,FKeyNames);
end;

function TCPKeyHook.Start_KeyHook: Boolean;
begin
Result := False;
if FEnabled then exit;
if Hook_Start(FHandle,WM_KEYHOOKMSG) then begin
   FEnabled := True;
   Result := True;
   end else FEnabled := False;
end;

function TCPKeyHook.Stop_KeyHook: Boolean;
begin
Result := False;
if Not FEnabled then exit;
if Hook_Stop then begin
   FEnabled := False;
   Result := True;
   end else FEnabled := True;
end;


end.					

1:
2:
3:
4:
5:

function Hook_Start(WinHandle : HWND; MsgToSend : integer) : boolean; 
  stdcall external HOOKLIBNAME name 'KeyboardHook_Start'; 

function Hook_Stop : boolean; 
  stdcall external HOOKLIBNAME name 'KeyboardHook_Stop';					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:

 type
  THook_Start = function Hook_Start(WinHandle : HWND; MsgToSend : integer) : boolean; stdcall;
type
  THook_Stop = function Hook_Stop : boolean; stdcall;

var Hook_Start: THook_Start;
    Hook_Stop: THook_Stop;

procedure TForm1.Form1Create(Sender: TObject);
var
  hLib: cardinal;
begin
  hLib := LoadLibrary(HOOKLIBNAME);
  if hLib <> 0 then
  begin
    @Hook_Start := GetProcAddress(hLib, 'KeyboardHook_Start');
    @Hook_Stop := GetProcAddress(hLib, 'KeyboardHook_Stop');
    if not Assigned(Hook_Start) or not Assigned(Hook_Stop) then
      Showmessage('DLL nicht gefunden. Fortfahren.');
  end
  else
    Showmessage('DLL nicht gefunden. Fortfahren.');
end;