Console App and SetWindowsHookEx

时间:2015-07-28 17:06:27

标签: delphi

Trying to setup a SetWindowsHookEx(WH_KEYBOARD) from a console app. I'm doing this inside thread, because I tried to to use the TThread.WaitFor method to keep the application openned, while the thread is running.

Important code parts:

type
  THookKeyboard = procedure; stdcall;

  KeyloggerThread = class(TThread)
  private
    const
      MESSAGE_CODE = WM_USER + $1000;
    var
      HookOn, HookOff: THookKeyboard;
      MsgReceptor: ^Integer;
      MemFile: THandle;
    function InstallKeyLogger(const TempDir: String): bool;
    procedure HookMessage(var MessageHandler: TMessage); message MESSAGE_CODE;
  protected
    constructor Create;
    procedure Execute; override;
  end;

var
  KeylogThreadCtrl: KeyloggerThread;

function KeyloggerThread.InstallKeyLogger(const TempDir: String): bool;
var
  DLLHandle: THandle;
begin
  Result:= false;
  if FileExists(TempDir + DLLName) = true then
  begin
    DLLHandle:= LoadLibrary(PChar(TempDir + DLLName));
    if DLLHandle <> 0 then
    begin
      @HookOn:= GetProcAddress(DLLHandle, 'HookOn');
      @HookOff:= GetProcAddress(DLLHandle, 'HookOff');
    end;
    if assigned(HookOn) and assigned(HookOff) then
    begin
      MemFile:= CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0,SizeOf(Integer), 'Win32KLCom');
      if MemFile <> 0 then
      begin
        MessageBox(0, 'starting keylogger', 'hook', MB_OK);
        MsgReceptor:= MapViewOfFile(MemFile,FILE_MAP_WRITE,0,0,0);
        HookOn;
        Result:= true;
      end;
    end;
  end;
end;

procedure KeyloggerThread.HookMessage(var MessageHandler: TMessage);
begin
  MessageBox(0, 'pressed something!', 'hook', MB_OK);
end;

constructor KeyloggerThread.Create;
begin
  inherited Create(false);
end;

procedure KeyloggerThread.Execute;
begin
  while not Terminated do
  begin
    if not assigned(HookOn) then
      if InstallKeyLogger(ExtractFilePath(ParamStr(0))) = false then
        Terminate;
  end;
end;

begin
    if ParamStr(1) = '-runkeylog' then
    begin
      MessageBox(0, 'going to install keylogger', 'hook', MB_OK);
      KeylogThreadCtrl:= KeyloggerThread.Create;
      KeylogThreadCtrl.WaitFor;
    end
end;

I know the InstallKeyLogger function is going fine, because I get the messagebox 'starting keylogger'.

Once I press any key, windows start freezing and I need to finish the application. The DLL code is:

library KeyboardDLL;

uses
  Windows,
  Messages;

{$R *.res}

const
  MESSAGE_CODE = WM_USER + $1000;

var
  KeyboardHook: HHook;
  MemFile: THandle;
  MsgReceptor: ^Integer;

function HookCallBack( Code : Integer;
                          wParam  : WPARAM;
                          lParam  : LPARAM
                          )       : LRESULT; stdcall;

begin
  if code=HC_ACTION then
    begin
      MemFile:= OpenFileMapping(FILE_MAP_WRITE,False, 'Win32KLCom');
      if MemFile<>0 then
        begin
          MsgReceptor:= MapViewOfFile(MemFile,FILE_MAP_WRITE,0,0,0);
          PostMessage(MsgReceptor^,MESSAGE_CODE,wParam,lParam);
        end;
    end;
  Result:= CallNextHookEx(KeyboardHook, Code, wParam, lParam)
end;

procedure HookOn; stdcall;
begin
  KeyboardHook:= SetWindowsHookEx(WH_KEYBOARD, @HookCallBack, HInstance , 0);
end;

procedure HookOff;  stdcall;
begin
  UnmapViewOfFile(MsgReceptor);
  CloseHandle(MemFile);
  UnhookWindowsHookEx(KeyboardHook);
end;

exports
  HookOn,
  HookOff;

begin
end.

1 个答案:

答案 0 :(得分:1)

看起来您从VCL应用程序移植了托管代码,因为您有一些不为独立线程设置的假设,例如您所拥有的那些:

procedure HookMessage(var MessageHandler: TMessage); message MESSAGE_CODE;

  • 此类消息程序仅适用于VCL表单或控件的上下文。

  • 您只能将消息(使用PostMessage)发布到窗口句柄,而不是内存映射文件(当您尝试使用MsgReceptor指针时)。

  • 如果您希望线程能够处理消息,则必须创建一个窗口句柄,并且该线程必须具有消息循环(GetMessage / DispatchMessage或类似)。