Einzelnen Beitrag anzeigen

blackdrake

Registriert seit: 21. Aug 2003
Ort: Bammental
618 Beiträge
 
Delphi 10.3 Rio
 
#9

Re: Maus sperren während Tastatureingabe

  Alt 17. Nov 2008, 20:55
Hallo.

@Sir Rufo: Ja, genau so meine ich es. Im Endeffekt will ich das Tool auch veröffentlichen, da es in einigen Situationen bzw. bei einigen Anwendern wirklich sinnvoll ist.

Die Klickfunktion des Touchpads zu Deaktivieren führt natürlich wieder zu einer gezwungenen Umstellung des Benutzers und ist außerdem nicht im Allgemeinen (bei allen Notebooks/Treibern) anwendbar. Und allgemeine Deaktivierungen bzw. per Fn-Tastenkombination sind nur bei längeren Schreibphasen sinnvoll.

Ich habe jetzt mit dem Delphi-Treff-Tutorial folgende Anwendung mit DLL (ich möchte die DLL konventionell extern haben, nicht als Ressource) abgeleitet. Ich bekomme aber eine AV, sobald ich Button 1 oder 2 klicke. Ich weiß nicht, was da passiert

Das DP Tutorial ist leider so kompliziert nonVCL geschrieben, dass ich es nur sehr schwer in VCL nachvollziehen/nachmachen kann. Ich denke, dass auch hier ein Problem bei der Transkription besteht.

Hauptanwendung, die ein Keyboard-Ergeigniss erhalten soll

Delphi-Quellcode:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  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';

procedure TForm1.Button1Click(Sender: TObject);
var
  h: hwnd;
begin
  h := application.Handle; // ???
  InstallHooks(h); // EXCEPTION
  WM_MOUSEHOOKMSG:=getprop(h,mousmsg);
  WM_KEYBHOOKMSG:=getprop(h,keybmsg);
end;

// TODO: Globale Keyboard Message abfragen (mit WM_KEY Message?)

procedure TForm1.Button2Click(Sender: TObject);
begin
  UnInstallHooks; // EXCEPTION
  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, 'InstallHook');
    UnInstallHooks := GetProcAddress(lib, 'UninstallHook');
  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;

end.
Die Hook-DLL, direkt übernommen

Delphi-Quellcode:
library Hooks;

uses
  Windows,
  Messages;

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

var
  Mouse_HookHandle: Cardinal = 0;
  Keyboard_HookHandle: Cardinal = 0;
  WindowHandle: Cardinal = 0;

  WM_MOUSEHOOKMSG: Cardinal = 0;
  WM_KEYBHOOKMSG: Cardinal = 0;

function KeyboardHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
//es ist ebenfalls moeglich die Bearbeitung an eine Bedingung zu knuepfen
//it's possible to call CallNextHookEx conditional only.
  Result := CallNextHookEx(Keyboard_HookHandle, nCode, wParam, lParam);
  case nCode < 0 of
    TRUE: exit; //wenn code kleiner 0 wird nix gemacht
                //if code smaller 0 nothing has to be done
    FALSE:
      begin
//Hier kann jetzt alles bearbeitet werden
//Here one can work with the parameters
        setprop(WindowHandle, 'keyb_ncode', nCode);
        SendMessage(HWND_BROADCAST, WM_KEYBHOOKMSG, wParam, lParam);
      end;
  end;
end;

function MouseHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
//es ist ebenfalls moeglich die Bearbeitung an eine Bedingung zu knuepfen
//it's possible to call CallNextHookEx conditional only.
  Result := CallNextHookEx(Mouse_HookHandle, nCode, wParam, lParam);
  case nCode < 0 of
    TRUE: exit; //wenn code kleiner 0 wird nix gemacht
                //if code smaller 0 nothing has to be done
    FALSE:
      begin
//Hier kann jetzt alles bearbeitet werden
//Here one can work with the parameters
        setprop(WindowHandle, 'mous_ncode', nCode);
        setprop(WindowHandle, 'mous_hwnd', PMOUSEHOOKSTRUCT(lParam)^.hwnd);
        setprop(WindowHandle, 'mous_hitt', PMOUSEHOOKSTRUCT(lParam)^.wHitTestCode);
        setprop(WindowHandle, 'mous_xpos', PMOUSEHOOKSTRUCT(lParam)^.pt.x);
        setprop(WindowHandle, 'mous_ypos', PMOUSEHOOKSTRUCT(lParam)^.pt.y);
        SendMessage(HWND_BROADCAST, WM_MOUSEHOOKMSG, wParam, lParam);
      end;
  end;
end;

function InstallHooks(Hwnd: Cardinal): Boolean; stdcall;
var mouseh, keybh: boolean;
begin
  keybh := false;
  mouseh := false;
//Erstmal Hooks installieren
//First install the hooks
  case Mouse_HookHandle of
    0: begin
        Mouse_HookHandle := SetWindowsHookEx(WH_MOUSE, @MouseHookProc, HInstance, 0);
        SetProp(Hwnd,mousmsg,WM_MOUSEHOOKMSG);
        mouseh := true;
      end;
  end;
  case Keyboard_HookHandle of
    0: begin
        Keyboard_HookHandle := SetWindowsHookEx(WH_KEYBOARD, @KeyboardHookProc, HInstance, 0);
        SetProp(Hwnd,keybmsg,WM_KEYBHOOKMSG);
        keybh := true;
      end;
  end;
//Uebergebenes Fensterhandle sichern
//Save the given window handle
  WindowHandle := Hwnd;
  Result := keybh and mouseh;
end;

function UninstallHooks: Boolean; stdcall;
var mouseh, keybh: boolean;
begin
//Hooks aus der Hookchain entfernen
//Uninstall hook from hooks chain
  mouseh := UnhookWindowsHookEx(Mouse_HookHandle);
  keybh := UnhookWindowsHookEx(Keyboard_HookHandle);
  Mouse_HookHandle := 0;
  Keyboard_HookHandle := 0;
  Result := keybh and mouseh;
  if Result then WindowHandle := 0;
end;

exports
//Installations- und Deinstallationsroutine exportieren
//Export the installation and deinstallation routine
  InstallHooks,
  UninstallHooks;

begin
  WM_MOUSEHOOKMSG:=RegisterWindowMessage(mousmsg);
  WM_KEYBHOOKMSG:=RegisterWindowMessage(keybmsg);
end.
Daniel Marschall
  Mit Zitat antworten Zitat