(Keyboard) Hook Problem

Hagbard · Beiträge: 142 Win XP Home / Pro D7.1 Architekt

Hallo,

ich habe da ein kleines Problem mit einem Hook:
Ich habe mir das Tutorial dazu angesehen und den Code teilweise kopiert.

Ich habe mir statt einer DLL eine Klasse gebaut, die den Hook installiert, usw. da Ich ein Event feuern möchte, wenn meine gesuchten Daten in einer Puffer Variable liegen.

Hier ist der Code um den Hook zu installieren...

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:

function TTiKeyHook.InstallHook(Hwnd: Cardinal): Boolean; stdcall;
begin
  Result := False;
  if HookHandle = 0 then begin
     //Erstmal Hook installieren
     HookHandle := SetWindowsHookEx(WH_KEYBOARD, @theKeyboardHookProc, HInstance, 0);
     //Uebergebenes Fensterhandle sichern
     WindowHandle := Hwnd;
     Result := TRUE;
  end;
end;

Seltsamerweise ist aber nCode in der KeyboardHookProc immer 0, und somit springt er nicht in meine Verarbeitung rein.
Hat jemand eine Ahnung warum nicht???

Hier ist die eigentliche Hook Function:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:

function TTiKeyHook.KeyboardHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; 
var
  KeyboardLayout: HKL;
  LastKey       : Char;
  KeyState      : TKeyboardState;
  Key           : Word;
  GetShiftKeys  : Boolean;
  BufferActive  : Boolean;

begin
  //es ist ebenfalls möglich die Bearbeitung an eine Bedingung zu knüpfen

  Result := CallNextHookEx(HookHandle, nCode, wParam, lParam);

  if nCode < 0 then begin
    KeyboardLayout:=GetKeyboardLayout(0);
    GetKeyboardState(KeyState);

    if ToAsciiEx(wParam,MapVirtualKeyEx(wParam,2,KeyboardLayout),KeyState,@LastKey,0,KeyboardLayout)>0 then begin
      Key:=Ord(LastKey)
    end else begin
      Key:=wParam;
    end;

    if (lParam and $80000000)=0 then begin
      if not (wParam in [16,17,18]) or GetShiftKeys then begin

        if (Key = 35) then begin // Startzeichen empfangen ( * )
          BufferActive := True;
        end;

        if (Key = 23) then begin // Endzeichen empfangen ( # )
          BufferActive := False;

          // fire Event
          If Trim(FBuffer) <> '' then begin
            if Assigned(OnSendData) then begin

              OnSendData(FBuffer);
            end;
          end;

          FBuffer := '';
        end; // if Key = 35

        // only save Key´s when Buffer ist Active
        If BufferActive then begin
          FBuffer := FBuffer + Chr(Key);
        end;

      end; // if wParam

    end; // if lParam

  end; // if nCode

end; // function

da Ich in der InstallHook keine Function einer Klasse einbauen kann: (Fehler Variable erforderlich)

markieren

Delphi-Quelltext

1:	HookHandle := SetWindowsHookEx(WH_KEYBOARD, @theKeyboardHookProc, HInstance, 0);

habe Ich mir eine weitere Funktion ausßerhalb der Klasse gebaut: theKeyboardHookProc, , welche nichts weiter tut,
als die Funktion KeyboardHookProc aus meiner Hook Klasse aufzurufen...

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:

function theKeyboardHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  ShowMessage(IntToStr(nCode));
  result := TiKeyHook.KeyboardHookProc(nCode, wParam, lParam);
end;

Ich benutze Showmessage um mir die aktuellen Daten anzuzeigen, denn wenn ich einen Breakpoint setze um anzuhalten, schließt sich Delphi ohne Vorwarnung...

Die Klasse dient dazu Daten von einem BarCode Scanner (mit PS/2 Anschluß) abzufangen und per Event an ein anderes Programm zu übertragen...

Viele Grüße,
Christian

Moderiert von Peter Lustig: Code- durch Delphi-Tags ersetzt.

_________________
I haven't failed, I just found 10,000 ways that won't work!

Udontknow · Beiträge: 2596 Win7 D2006 WIN32, .NET (C#)

Hallo!

Ich habe jetzt nur flüchtig über deinen Code gekuckt, aber:

Methoden und Prozeduren sind nicht zuweisungskompatibel! SetWindowsHook erwartet eine Prozedur, du übergibst aber eine Methode (also eine Prozedur einer Klasse). Du musst da einen Umweg über eine Prozedur machen, die die Daten dann an die Methode des Objekts weiterleitet.

Cu,
Udontknow

Hagbard · Beiträge: 142 Win XP Home / Pro D7.1 Architekt

hi, das ging ja richtig schnell mit dem Antworten ;-)

deswegen habe Ich mir ja eine Funktion gebaut, welche außerhalb der Klasse liegt, und habe diese Übergeben bei

markieren

Delphi-Quelltext

1:	HookHandle := SetWindowsHookEx(WH_KEYBOARD, @theKeyboardHookProc, HInstance, 0);

theKeyboardHookProc ( außerhalb der Klasse )
ruft aber dann KeyboardHookProc (innerhalb der Klasse) auf.

Somit übergebe Ich eine normale Prozedur, oder irre Ich mich??

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:

function theKeyboardHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  ShowMessage(IntToStr(nCode));
  result := TiKeyHook.KeyboardHookProc(nCode, wParam, lParam);
end;

Moderiert von Tino: Code- durch Delphi-Tags ersetzt.

_________________
I haven't failed, I just found 10,000 ways that won't work!

Udontknow · Beiträge: 2596 Win7 D2006 WIN32, .NET (C#)

Klar, hast recht... Manchmal sollte ich mir einfach ein wenig mehr Zeit nehmen... :oops:

Edit: Aaalso, ich habe mir mal die Funktionen im MSDN angekuckt, und da steht, das ncode 0 = hc_action ist, was bedeutet, daß die Parameter nun Infos über den Tastendruck enthalten. Ein Wert von 0 für ncode ist also völlig in Ordnung.

Ich habe mal deine Klasse ein wenig nachgebaut und verschlimmbessert:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:

unit U_Hook_Class;

interface

uses SysUtils, Classes, Windows;

type TDataEvent=procedure(Buffer:String) of object;

type TTiKeyHook=class(TComponent)
  private
    HookHandle: Hwnd;
    WindowHandle:Hwnd;
    FBuffer:String;
    FOnSendData:TDataEvent;
  public

    destructor Destroy; override;
    function InstallHook(Hwnd: Cardinal): Boolean;
    procedure UninstallHook;
    function KeyboardHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
  published
    property OnSendData:TDataEvent read FOnSendData write FOnSendData;
end;

var TiKeyHook:TTiKeyHook;

procedure Register;

implementation

function theKeyboardHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  //ShowMessage(IntToStr(nCode));
  //if nCode=hc_action then
    //ShowMessage('action');
  result := TiKeyHook.KeyboardHookProc(nCode, wParam, lParam);
end;


destructor TTiKeyHook.Destroy;
begin
  if Hookhandle<>0 then
    UninstallHook;
  inherited;
end;

function TTiKeyHook.InstallHook(Hwnd: Cardinal): Boolean;
begin  
   Result := False;
   if HookHandle = 0 then begin
      //Erstmal Hook installieren
      HookHandle := SetWindowsHookEx(WH_KEYBOARD, @theKeyboardHookProc, hinstance, 0);
      //Uebergebenes Fensterhandle sichern
      WindowHandle := Hwnd;
      Result := TRUE;
   end;  
end;

function TTiKeyHook.KeyboardHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
var
  KeyboardLayout: HKL;
  LastKey       : Char;
  KeyState      : TKeyboardState;
  Key           : Word;
begin
  //es ist ebenfalls möglich die Bearbeitung an eine Bedingung zu knüpfen

  Result := CallNextHookEx(HookHandle, nCode, wParam, lParam);

  KeyboardLayout:=GetKeyboardLayout(0);
  GetKeyboardState(KeyState);

  if ToAsciiEx(wParam,MapVirtualKeyEx(wParam,2,KeyboardLayout),KeyState,@LastKey,0,KeyboardLayout)>0 then begin
    Key:=Ord(LastKey)
  end else begin
    Key:=wParam;
  end;

  FBuffer:=FBuffer+(Chr(Key));

  if Assigned(FOnSendData) then
    FOnSendData(FBuffer);
end; // function


procedure TTiKeyHook.UninstallHook;
begin
  UnhookWindowsHookEx(HookHandle);
end;

procedure Register;
begin
  RegisterComponents('Hook',[TTiKeyHook]);
end;

end.

Folgendermaßen habe ich sie eingebunden:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:

procedure TFRM_Main.Button1Click(Sender: TObject);
begin
  TiKeyHook:=TTiKeyHook.Create(Self);
  TiKeyHook.OnSendData:=SendData;
  TiKeyHook.InstallHook(Self.Handle);
end;

Und die Ausgabe einfach in ein Memo:

markieren

Delphi-Quelltext

1:
2:
3:
4:

procedure TFRM_Main.Senddata(Buffer: String);
begin
  Memo1.Lines.Text:=Buffer;
end;

Soweit klappt das auch, jedoch nur, wenn die App auch den Fokus hat, ansonsten stürzt alles sang- und klanglos ab... :shock:

Cu,
Udontknow

Hagbard · Beiträge: 142 Win XP Home / Pro D7.1 Architekt

kewl.. vielen Dank!

Ich hab Deine Klasse genommen und hab Sie etwas erweitert, bzw. minimal umgebaut, da Ich nicht
von TComponent ableiten kann (keine Form).

Witzig ist jetzt, das Ich Durch die try, except bzw. finally Blöcke nun keinen kompletten Absturz mehr bekomme,
jedoch meine TaskLeiste für ein paar Sekunden verschwindet. Die Rückgabe zeigt er mir trotz alle dem im richtigen Fenster an. :-)

Da es sehr unwahrscheinlich ist, das das richtige Fenster mal nicht aktiv sein sollte (ist für eine Kasse) kann Ich mit dem Problem allerdings leben :-)

( es sei denn, jemand hat ne Lösung parat ;-)

)

Hier mal der Code: (eigentlich, bis auf evt. Bugs fertig zum Lesen der Daten von Barcode Scannern mit Start/End Zeichen)

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:

unit uDolphinKeyHook;

interface   

uses SysUtils, StrUtils, Classes, Windows;

type TDataEvent = procedure(aData : String) of object;


type TTiKeyHook=class(TObject)
  private   
    HookHandle    : Hwnd;
    WindowHandle  : Hwnd;
    FBuffer       : String;
    FOnSendData   : TDataEvent;
    FEndSign      : Byte;

  public
    constructor Create;
    destructor Destroy; override;

    function  InstallHook(Hwnd: Cardinal): Boolean;
    procedure UninstallHook;

    function KeyboardHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;

  published   
    property OnSendData : TDataEvent read FOnSendData write FOnSendData;
    property EndSign    : Byte       read FEndSign    write FEndSign;

end;   

var TiKeyHook : TTiKeyHook;   

implementation

function theKeyboardHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;   
begin   
  result := TiKeyHook.KeyboardHookProc(nCode, wParam, lParam);   
end;   

constructor TTiKeyHook.Create;
begin
  // Default Values:
  FEndSign := 35;
end;

destructor TTiKeyHook.Destroy;
begin   
  if Hookhandle <> 0 then
    UninstallHook;
  inherited;   
end;

function TTiKeyHook.InstallHook(Hwnd: Cardinal): Boolean;   
begin     
   Result := False;   
   if HookHandle = 0 then begin
     try
       //Erstmal Hook installieren
       HookHandle := SetWindowsHookEx(WH_KEYBOARD, @theKeyboardHookProc, hinstance, 0);
       //Uebergebenes Fensterhandle sichern
       WindowHandle := Hwnd;
       Result := TRUE;
     except
       if Hookhandle <> 0 then
         UninstallHook;
         
       Result := False;
     end;
   end;     
end;   

function TTiKeyHook.KeyboardHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;   
var   
  KeyboardLayout: HKL;   
  LastKey       : Char;   
  KeyState      : TKeyboardState;
  Key           : Word;
  locResult     : String;
begin   
  //es ist ebenfalls möglich die Bearbeitung an eine Bedingung zu knüpfen   
  Result := CallNextHookEx(HookHandle, nCode, wParam, lParam);   

  KeyboardLayout:=GetKeyboardLayout(0);   
  GetKeyboardState(KeyState);   

  if ToAsciiEx(wParam,MapVirtualKeyEx(wParam,2,KeyboardLayout),KeyState,@LastKey,0,KeyboardLayout)>0 then begin
    Key :=  Ord(LastKey)
  end else begin
    Key :=  wParam;
  end;

  if (lParam and $80000000) = 0 then begin
    if not (wParam in [16,17,18]) then begin

      FBuffer:=FBuffer+(Chr(Key));

      if (Key = FEndSign) then begin // got End-Sign ( e.g. # = 35 )

        If Trim(FBuffer) <> '' then begin
          locResult := MidStr(FBuffer,2,Length(FBuffer)-2);
          FBuffer := '';

          if Assigned(OnSendData) then begin
            FOnSendData(locResult);
          end;

        end;
      end;

    end;
  end;

end; // function

procedure TTiKeyHook.UninstallHook;
begin
  UnhookWindowsHookEx(HookHandle);
end;

end.

Aufruf:

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:

function TTiSCKeyboard.Open: Boolean;
begin
  Result := False;
  try
    TiKeyHook:=TTiKeyHook.Create();
    TiKeyHook.OnSendData:=GetData;
    TiKeyHook.InstallHook(SCHwnd);
    Result := True;
  except
    Result := False;
  end;
end;

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:

function TTiSCKeyboard.Close: Boolean;
begin
  try
    TiKeyHook.UninstallHook;
  finally
    FreeAndNil(TiKeyHook);
  end;
  result := True;
end;

Viele Grüße und vor allem VIELEN DANK :-)

Christian

_________________
I haven't failed, I just found 10,000 ways that won't work!

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme