Tastatur per Button sperren und wieder entsperren

[LokutusvB]

Hallo,

ich habe ein Delphi-Programm entwickelt, mit dem unsere Techniker beim Kunden vor Ort die Einsätze dokumentieren und die Daten direkt zurück an die Firma senden. Zum Abschluß des Einsatzes kann der Kunde in einem Zeichenfeld eine Unterschrift leisten (wird nicht gespeichert, für alle DSGVO-Liebhaber). Das Programm läuft auf einem Tablet. Bei der Unterschrift mittels Pen kommt es leider immer wieder vor, daß ein Kunde ausversehen eine Taste drückt oder per Touch das Programm verändert.

Deswegen die Anfrage, wie man alle Eingaben bis auf Maus/Pen per Buttonklick deaktivieren und wieder aktivieren kann. Ich habe schon einige Stunden im Netz gesucht, konnte aber leider nichts finden, was mein Problem auch nur ansatzweise lösen könnte, den wenn dann ist nur eine vollständige Sperrung möglich oder keine, siehe z.B.:
https://entwickler-ecke.de/topic_Tas...en_7440,0.html
https://www.delphipraxis.net/172090-...bschalten.html
https://www.swissdelphicenter.ch/de/showcode.php?id=312

Kennt jemand eine funktionsfähige Möglichkeit, für eine kurze Zeit bis auf Maus und Pen alle anderen Eingaben zu blockieren oder aber abzufangen und an "dev0" zu senden? Vielen Dank für eure Bemühungen.

[KodeZwerg]

(Ich habe mir Deine Links noch nicht genauer angeschaut)

Für Tastatur:
Aus meiner Archiv-Sammlung, Achtung: das wirkt global und nicht auf ein Programm bezogen.
Im SetWindowsHookEx als letzten Parameter kannst Du einen Thread benennen, zum Beispiel GetCurrentThreadId um nur Dein Programm damit zu blocken.
Müsste auch noch mit Windows 10 klappen, aber ungetestet.

Delphi-Quellcode:

function KBHookHandler(ACode: Integer; WParam: WParam; LParam: LParam) : LResult; stdcall;
begin
  if ACode < 0 then
    Result := CallNextHookEx(Hook, ACode, WParam, LParam)
  else
    Result := 1;
end;

function DisableKeyboard: Boolean; stdcall;
begin
  if Hook = 0 then
    Hook := SetWindowsHookEx(WH_KEYBOARD, @KBHookHandler, HInstance, 0);
  Result := Hook <> 0;
end;

[LokutusvB]

Hallo KodeZwerg,

vielen Dank für deine schnelle Antwort. Ich habe deinen Code in mein Programm eingebaut, er zeigt aber leider keine Wirkung. Per Debugger konnte ich sehen, die Funktion DisableKeyboard wird aufgerufen, aber Eingaben sind trotzdem noch möglich. Habe ich etwas vergessen?

Code:

var
  cHook: Cardinal;

...

function KBHookHandler(ACode: Integer; WParam: WParam; LParam: LParam) : LResult; stdcall;
begin
  if ACode < 0 then
    Result := CallNextHookEx(cHook, ACode, WParam, LParam)
  else
    Result := 1;
end;

function DisableKeyboard: Boolean; stdcall;
begin
  if cHook = 0 then
    cHook := SetWindowsHookEx(WH_KEYBOARD, @KBHookHandler, HInstance, 0);
  Result := cHook <> 0;
end;

function UninstallHook: Boolean; stdcall;
begin
  Result := UnhookWindowsHookEx(cHook);
  cHook := 0;
end;

procedure TFormC.btnUnterschreibenCheckBtnClick(Sender: TObject);
begin
  if btnUnterschreiben.Checked then DisableKeyboard
                               else UninstallHook;
end;

[KodeZwerg]

Ich bastel zu morgen (hoffentlich) eine lauffähige zwei-Knopf (On/Off) Demo.

//edit
Was mir gerade auffällt, cHook ist bei Dir ein Cardinal, ich würde HHOOK nehmen.

[KodeZwerg]

Guten Morgen,

nun eine unter Windows 10 getestete Variation, 32 sowie 64bit kompatibel.

4 Verschiedene Varianten stehen zur Auswahl, nur 3 sind per GUI testbar.
Assembler benötigt spezielle Rechte, die ich hier nicht verbaut habe.

Delphi-Quellcode:

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm2 = class(TForm)
    GroupBox1: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    GroupBox2: TGroupBox;
    Button1: TButton;
    GroupBox3: TGroupBox;
    CheckBox1: TCheckBox;
    GroupBox4: TGroupBox;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    Label1: TLabel;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure RadioButton3Click(Sender: TObject);
    procedure RadioButton4Click(Sender: TObject);
  private
    // HOOK support start
    KBHook: HHOOK;
    function KBHookHandler(ACode: Integer; WParam: WParam; LParam: LParam): LResult; stdcall;
    function DisableKeyboard: Boolean; stdcall;
    // HOOK support end
  protected
    // delphi messages support
    procedure CMCHILDKEY(var Msg: TWMKey); message CM_CHILDKEY;
  public
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
  // sicherstellen das es eine Null zur Initialisierung hat
  // (sollte eh der fall sein, aber man weiß ja nie)
  KBHook := 0;
end;

// Hook Handler
function TForm2.KBHookHandler(ACode: Integer; WParam: WParam; LParam: LParam): LResult; stdcall;
begin
  // ACode steht für einen Tastencode
  if ACode < 0 then
    // falls keine bekannte Taste gedrückt wurde, weiter "hooken"
    Result := CallNextHookEx(KBHook, ACode, WParam, LParam)
  else
    // sobald Result > 0 = werden Tasten unterdrückt
    Result := 1;
end;

// Hook Starter
function TForm2.DisableKeyboard: Boolean; stdcall;
begin
  // wenn noch kein hook vergeben wurde
  if KBHook = 0 then
    // einen neuen einrichten
    KBHook := SetWindowsHookEx(WH_KEYBOARD, @TForm2.KBHookHandler, HInstance, GetCurrentThreadId());
  // und als result auswerten
  Result := (KBHook <> 0);
end;

{ Hook Off }
procedure TForm2.RadioButton1Click(Sender: TObject);
begin
  // wenn ein hook gesetzt war
  if KBHook <> 0 then
    // geben wir ihn hier wieder frei
    UnhookWindowsHookEx(KBHook);
  // und stellen sicher das es ne null ist
  KBHook := 0;
  Edit1.SetFocus;
end;

{ Hook On }
procedure TForm2.RadioButton2Click(Sender: TObject);
begin
  DisableKeyboard;
  Edit1.SetFocus;
end;

{ BlockInput On/Off }
// vom blockinput rate ich dringend ab
// aber da es sowas gibt
// hier meine implementation
procedure TForm2.Button1Click(Sender: TObject);
  // meine Windows.pas besitzt bereits "BlockInput"
  // falls deins es nicht hat
  // hier ein helferlein um das nachzuholen
  function DllFunc(const dllName: string; const funcName: string; var p: pointer): Boolean;
  var
    lib: THandle;
  begin
    Result := False;
    p := nil;
    if (LoadLibrary(PChar(dllName)) = 0) then
      Exit;
    lib := GetModuleHandle(PChar(dllName));
    if (lib <> 0) then
      begin
        p := GetProcAddress(lib, PChar(funcName));
        if (p <> nil) then
          Result := True;
      end;
  end;

var
  BlockInput : function(Block: BOOL): BOOL; stdcall;
begin
  if DllFunc('USER32.DLL', 'BlockInput', @BlockInput) then
    begin
      // der input wird gepuffert und zurückgehalten
      BlockInput(Bool(True));
      Edit1.SetFocus;
      // hauptthread friert ein, sorry
      Sleep(5000);
      // der input wird freigelassen
      // was noch im puffer ist,
      // wird nun ausgeführt!!!
      BlockInput(Bool(False));
      Button1.SetFocus;
    end;
end;

{ Keyboard Message On/Off }
procedure TForm2.CMCHILDKEY(var Msg: TWMKey);
begin
  Edit1.SetFocus;
  if not CheckBox1.Checked then
    Msg.Result := 1;
end;

{ Assembler On }
procedure TForm2.RadioButton3Click(Sender: TObject);
asm
  in  al,21h
  and al,11111101b
  out 21h,al
end;

{ Assembler Off }
procedure TForm2.RadioButton4Click(Sender: TObject);
asm
  in  al,21h
  or  al,00000010b
  out 21h,al
end;

end.

Im Anhang kompletter Quelltext zum Project sowie 64bit Kompilat zum sofort ausprobieren.
Falls sich das Project nicht kompilieren lässt bitte die "überflüssigen" Dateien per Hand selbst löschen, ich war gestern bissl faul
(.dpr, .pas, .dfm, .res behalten, den Rest löschen)

Anmerkung:
Es scheint das Windows keine globalen Hooks aus einem Programm heraus zulässt, wenn dies unbedingt erforderlich ist den Hook-Part eventuell als Library erstellen und über Dll mal testen, mir fehlte die Zeit dafür.

Ps: Kann sein das die Unit im Archiv minimal von der obigen gezeigten abweicht.

PPs: WM_KEYDOWN könnte vielleicht auch eine Message sein mit der man spielen könnte bzw. generell die Delphi eigenen KeyDown/KeyPress Events dazu "missbrauchen".


Viel Erfolg und Spaß damit.
(keine copryrights oder der gleichen, alles zur freien Verfügung)

[LokutusvB]

Vielen Dank, das schaue ich mir mal in Ruhe an.

Zusatz:
nach einigen mißlungenen Versuchen bin ich zum Delphi Standard zurück. Ich habe in der Form die Eigenschaft "KeyPreview" auf "True" gesetzt und die Ereignisse "FormKeyDown" und FormKeyPressed" bearbeitet.

Code:

procedure TFormS.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if btnUnterschreiben.Checked then key := 0;
end;

procedure TFormS.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if btnUnterschreiben.Checked then key := #0;
end;

Für meine Zwecke funktioniert es sehr gut. So lange die Checkbox True ist, werden die Tastureingaben nicht weiter bearbeitet. Trotzdem Danke dir für deine Hilfe.

[KodeZwerg]

Jo gern geschehn. Ich schrieb ja auch das man des dafür "missbrauchen" kann. Mir ist zwar unklar warum mein Beispiel bei Dir nicht schnurrt aber supi wenn's nun klappt.