Tastendruck im Hintergrund registrieren und Loggen

[Astat]

Hi, T.E!

lg. Astat

Delphi-Quellcode:

library dicthook;

  {$IMAGEBASE $56000000}

uses
  Windows,
  Messages;

type
  PHWND = ^HWND;

const
  WM_KEYBOARD_HOOK = WM_USER + 1024;
  FILEMAPPING_NAME = '{08864E9D-08A9-4118-8FAC-AA0931E7ECAA}';

var
  hHook: LongWord = 0;
  Key: Word;
  KeyboardLayout: HKL;
  GetShiftKeys: Boolean;
  hWndBuffer: PHWND;
  hMMF: THandle;

function KeyboardProc(nCode: Integer; wParam: LongWord;
  lParam: LongWord): LongWord; stdcall;
var
  LastKey: Char;
  KeyState: TKeyboardState;
begin
  Result := CallNextHookEx(hHook, nCode, wParam, lParam);
  if nCode < 0 then Exit
  else begin
    GetKeyboardState(KeyState);
    if ToAsciiEx(wParam, MapVirtualKeyEx(wParam, 2, KeyboardLayout), KeyState,
      @LastKey, 0, KeyboardLayout) > 0 then Key := Ord(LastKey)
    else
      Key:=wParam;
    if (lParam and $80000000) = 0 then
      if not (wParam in [16, 17, 18]) or GetShiftKeys then
        PostMessage(hwndBuffer^, WM_KEYBOARD_HOOK, Key, GetActiveWindow);
  end;
end;

function CreateHook(hWnd: HWND; ShiftKeys: Boolean): Boolean; stdcall;
var
  bHWND: PHWND;
begin
  hMMF := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE or SEC_COMMIT, 0,
    SizeOf(hWnd), FILEMAPPING_NAME);

  bHWND := MapViewOfFile(hMMF, FILE_MAP_WRITE, 0, 0, SizeOf(HWND));
  bHWND^ := hWnd;
  UnmapViewOfFile(bHWND);
  GetMem(hWndBuffer, SizeOf(HWND));
  hWndBuffer^ := hWnd;
  GetShiftKeys := ShiftKeys;
  if hHook = 0 then
    hHook := SetWindowsHookEx(WH_KEYBOARD, @KeyboardProc, hInstance, 0);
  Result := hHook <> 0;
end;

function DeleteHook: Boolean; stdcall;
begin
  FreeMem(hWndBuffer);
  CloseHandle(hMMF);
  Result := UnhookWindowsHookEx(hHook);
  hHook := 0;
end;

procedure DLLEntryProc(EntryCode: integer);
var
  hFM: THandle;
begin
  case EntryCode of
    DLL_PROCESS_DETACH:
      begin
      end;
    DLL_PROCESS_ATTACH:
      begin
        KeyboardLayout := GetKeyboardLayout(0);

        hFM := OpenFileMapping(FILE_MAP_READ, false, FILEMAPPING_NAME);
        if hFM <> 0 then begin
          hWndBuffer := MapViewOfFile(hFM, FILE_MAP_READ, 0, 0, SizeOf(HWND));
          CloseHandle(hFM);
        end;
      end;
  end;
end;

exports
  CreateHook,
  DeleteHook;

begin
  DisableThreadLibraryCalls(hInstance);
  DLLProc := @DLLEntryProc;
  DLLEntryProc(DLL_PROCESS_ATTACH);
end.

Zu verwenden:

Delphi-Quellcode:

const
  WM_KEYBOARD_HOOK = WM_USER + 1024;
  KBHOOKDLL = 'dicthook.dll';

type
  TfrmHookHostMain = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    procedure WMONKeyMsg(var Msg: TMessage); message WM_KEYBOARD_HOOK;
  end;

var
  frmHookHostMain: TfrmHookHostMain;

implementation

{$R *.dfm}

type
  TFNCreateHook = function(hWnd: HWND; ShiftKeys: Boolean): Boolean; stdcall;
  TFNDeleteHook = function: Boolean; stdcall;
  TFNGetLastKey = function: Word; stdcall;

var
  hLib: THandle = 0;
  CreateHookFtn: TFNCreateHook = nil;
  DeleteHookFtn: TFNDeleteHook = nil;

procedure TfrmHookHostMain.WMONKeyMsg(var Msg: TMessage);
var
  sKey: string;
begin
  if msg.LParam <> handle then sKey := string(Chr(msg.wParam);
  inherited;
end;


procedure TfrmHookHostMain.FormCreate(Sender: TObject);
begin
  hLib := LoadLibrary(PChar(ADestPath + KBHOOKDLL));

  if hLib <> 0 then begin
    @CreateHookFtn := GetProcAddress(hLib, 'CreateHook');
    @DeleteHookFtn := GetProcAddress(hLib, 'DeleteHook');
    if not (Assigned(CreateHookFtn) and Assigned(DeleteHookFtn)) then
      raise exception.Create('ERROR Hooking Keys!');
  end else
    raise exception.Create('ERROR HookDLL konte nicht geladen werden!');

  if not CreateHookFtn(handle, true) then
    raise exception.Create('ERROR Hookfunction konnte nicht gestartet werden!');

end;

procedure TfrmHookHostMain.FormDestroy(Sender: TObject);
begin
  if hLib <> 0 then begin
    DeleteHookFtn;
    FreeLibrary(hLib);
  end;
end;