Maus sperren während Tastatureingabe

[blackdrake]

Hallo,

Der Fehler lag beim GetProcAddress, da bei den 2 Tutorials einmal von *Hook und einmal von *Hooks die Rede war.

Ich habe jetzt einen fast funktionierenden Code, jedoch gibt es noch 2 Dinge, mit denen ich Probleme habe:

1. Die Strg-Taste wird auch als Taste angesehen ... hier muss sich dringend noch eine Allgemeine Lösung finden, weil Strg+Maustaste ja legitim sind
2. Das Sperren der Maustaste funktioniert nicht. Eigentlich dachte ich, es genüge, einfach das WndProc, das man verwerfen möchte, einfach nicht mehr per inherited weiterzureichen, doch es funktioniert einfach nicht.

Zum Testen: Ich habe während die Anwendung im Hintergrund läuft in einem Notepad etwas eingetippt. Das Fenster im Hintergrund zeigt als Debugausgabe "Gesperrt". Während der Eingabe klicke ich in meinen geschriebenen Text hinein. Nach der Eingabe werden die Textstellen markiert, weil scheinbar die Mausereignisse doch noch im Eingabepuffer waren und nicht durch die Hook-DLL verworfen wurden.

Code (DLL hooks.dll in den oberen Posts):

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    debug_tmr: TTimer;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure debug_tmrTimer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  public
    last_keyboard_input: DWORD;
    procedure WndProc(var Message:TMessage); override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TInstallHook = function(Hwnd: THandle): Boolean; stdcall;
  TUninstallHook = function: Boolean; stdcall;

var
  InstallHooks: TInstallHook;
  UninstallHooks: TUninstallHook;
  lib: Cardinal;
  WM_MOUSEHOOKMSG: Cardinal = 0;
  WM_KEYBHOOKMSG: Cardinal = 0;

const
  mousmsg='MouseHookMessage_Assarbad';
  keybmsg='KeyboardHookMessage_Assarbad';

const
  sperrdauer = 3000; // 3 Sekunden, später Variabel

// ToDo: Programm total lahm, wenn Delphi gestartet ist
// (auch außerhalb des Debuggers) ?
procedure TForm1.WndProc(var Message:TMessage);
var
  difference: DWORD;
begin
  if Message.Msg = WM_KEYBHOOKMSG then
  begin
    inherited WndProc(Message);

    // Eine Taste wurde gedrückt, wir merken uns den Zeitpunkt
    last_keyboard_input := GetTickCount();

    // ToDo: Tasten wie Strg dürfen nicht mitgezählt werden,
    // da diese in Kombination mit der Maustaste OK sind!
  end
  else if Message.Msg = WM_MOUSEHOOKMSG then
  begin
    difference := GetTickCount() - last_keyboard_input;

    if (difference <= sperrdauer) and
       ((Message.wParam = WM_LBUTTONDBLCLK) or
        (Message.wParam = WM_LBUTTONDOWN) or
        (Message.wParam = WM_LBUTTONUP)) then
    begin
      // Ereignis verwerfen, da linke Maustaste innerhalb
      // der Sperrzeit gedrückt wurde

      // Something ToDo ?

      // Debug: Zeigen, dass etwas gesperrt wurde
      label2.Caption := 'Sperrung: ' + IntToStr(GetTickCount());
    end
    else
    begin
      // Sonstiges Mausereignis bzw. Mausklick außerhalb
      // der Sperrzeit erlauben
      inherited WndProc(Message);
    end;
  end
  else
  begin
    // Andere Ereignisse durchlassen
    inherited WndProc(Message);
  end;
end;

procedure TForm1.debug_tmrTimer(Sender: TObject);
var
  difference: DWORD;
begin
  difference := GetTickCount() - last_keyboard_input;

  if difference > sperrdauer then
  begin
    label1.Caption := 'Freigegeben';
  end
  else
  begin
    label1.Caption := 'Gesperrt';
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  UnInstallHooks;
  WM_MOUSEHOOKMSG:=0;
  WM_KEYBHOOKMSG:=0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  lib := LoadLibrary('hooks.dll');
  if lib <> INVALID_HANDLE_VALUE then
  begin
    InstallHooks := GetProcAddress(lib, 'InstallHooks');
    UnInstallHooks := GetProcAddress(lib, 'UninstallHooks');
  end
  else
  begin
    ShowMessage('Hook could not be initialized. Please check "hooks.dll".');
    Application.Terminate;
  end;
end;

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

procedure TForm1.FormShow(Sender: TObject);
begin
  InstallHooks(Handle);
  WM_MOUSEHOOKMSG:=getprop(Handle, mousmsg);
  WM_KEYBHOOKMSG:=getprop(Handle, keybmsg);
end;

end.

Gruß
blackdrake