Hooks in Delphi
Frank Woehner
Hi ihr!
Ich bin gerade dabei ein kleines Progrämmchen zu schreiben, das mir alle
Tastatureingaben (auch die, die andere Programme betreffen) in eine
Datei schreiben soll. Dazu setze ich einen Hook im OnCreate-Ereignis
meines Hauptformulars:
HOOK:=SetWindowsHookEx(WH_KEYBOARD, @Speichern,
GetModuleHandle('mydll.dll'), 0);
Die Funktion Speichern befindet sich in "mydll.dll" und ist
folgendermaßen deklariert:
function Speichern(nCode : Integer; wparam : wParam; lparam :
lParam):LRESULT; stdcall;
Danach erfolgt die Abarbeitung der Nachrichtenwarteschlange mit:
while GetMessage(msg,0,0,0) do
Begin
TranslateMessage(msg);
DispatchMessage(msg);
End;
Soweit so gut
Wenn meine Anwendung im Vordergrund ist funktioniert die Sache auch ganz
gut. Drücke ich jedoch eine Taste in einem anderen Anwendungsprogramm
wird dieses aufgrund eines ungültigen Vorgangs geschlossen. :-(
Was könnte dafür die Ursache sein?
Vielen Dank für Deine Bemühungen!!
Bye
Frank
Hoffmann René
Frank Woehner schrieb:
> Hi ihr!
>
> Ich bin gerade dabei ein kleines Progrämmchen zu schreiben, das mir
> alle
> Tastatureingaben (auch die, die andere Programme betreffen) in eine
> Datei schreiben soll.
Ei, ei, ei, na sowas!!! Ist aber nicht die feine englische Art.
>
Hallo,
wenn Dein Programm auch unter NT laufen soll, kannst Du auf diese Art
und Weise keine systemweiten Botschaftsfilter verwenden. Da in der
Zukunft nur noch ein Windows geben soll, das auf der Basis von NT
entwickelt werden soll beschaeftige Dich lieber mit der Entwicklung von
VxD's.
Ich habe selber unter Win95/3.x einen systemweiten Botschaftsfilter (für
Maus und Tastatur) geschrieben und kann ihn Dir ja mal als Mail
zuschicken.
Tschuess
Aiko Berge
Andreas Hahn
Frank Woehner wrote:
> Danach erfolgt die Abarbeitung der Nachrichtenwarteschlange mit:
>
> while GetMessage(msg,0,0,0) do
> Begin
> TranslateMessage(msg);
> DispatchMessage(msg);
> End;
Damit haut die DLL 'runter, sobald Du in einem anderen Prozessraum bist.
>
> Wenn meine Anwendung im Vordergrund ist funktioniert die Sache auch ganz
> gut. Drücke ich jedoch eine Taste in einem anderen Anwendungsprogramm
> wird dieses aufgrund eines ungültigen Vorgangs geschlossen. :-(
> Was könnte dafür die Ursache sein?
s.o.
Yo,
erstmal ein paar Worte zu Hooks. Die Hook-Callback-Funktionen sind
deshalb in einer DLL, da sie vom System in den Prozessraum eingeblendet
werden, in dem das Hook-Event passiert. Bei deiner Lösung zapfst Du also
die Nachrichtenschlange eines Fremdprozesses an. Windows will das aber
in dieser Form nicht.
Hier erstmal eine Source, die ich im Experts-Exchange-Forum geposted
habe. Kommentare sind in Englisch und sollten eigentlich ganz gut
erklären, wie die Sache läuft.
Es sind 2 Listings, das erste ist die DLL, das zweite die Host-App, die
die Nachrichten speichert.
Viel Spaß !
///////////////////////////////
// hook library
// to be hooktest.dpr
library hooktest;
uses
Windows,
Messages;
// because the DLL is mapped in each process space the hook event
originates,
// it is instanciated for each such process. All global variables for
all
// instances are independent. So we cannot init the DLL and set
parameters on
// runtime to communicate with the host application. Therefore we use
constants.
//
// MainAppClassName is used by the hook procedure to send the catched
char to
// the host application. MainAppClassName is equivalent to the class
name of
// the TWinControl descendant instance that carries the message handler.
//
// MainAppMessageNumber defines the message number that is sent to the
host
// application. It should be wm_User + n. MainAppMessageID is just to
make
// sure the message is sent from the hook procedure, because wm_User + n
// can be used by anyone. Can be any value you like.
//
// If you change any of these values, DO NOT FORGET to change them also
in
// the host application !!!
const
MainAppClassName = 'TSpyKeyHookWnd';
MainAppMessageNumber = wm_User + 1;
MainAppMessageID = 123;
// these variables have to be in the DLL
// because the keyboard state depends on
// the process space. The DLL is mapped
//
// originates.
// For performance reasons, this variables
// are global.
var
KeyState : TKeyboardState;
CharCode : LPARAM;
function KeyHookProc(nCode: integer; wp: WPARAM; lp: LPARAM): LRESULT;
stdcall;
begin
// we shall to this refering to the Win32API documentation
if(nCode < 0) then
begin
Result := CallNextHookEx(0, nCode, wp, lp);
end
else
// here we go
begin
// we only react on a global KEYDOWN event, check bit 32 in lParam
// otherwise a message will be sent when a key is pressed and
// a second time when the key is released
if (lp and (1 shl 31)) = 0 then
begin
// clean old value
CharCode := 0;
// get keyboard state (shift, shift lock, etc.)
GetKeyboardState(KeyState);
// if this function returns 0, no character is translated
// e.g. when ALT or SHIFT is pressed. We only accept non-dead
keys.
// if 2 is returned, we have a multibyte system. I will not
// support it here.
if ToASCII(wp, HiWord(lp), KeyState, @CharCode, 0) = 1
// send a message containing the translated char in lParam.
// see the comment on top of the project for a description
// on this function
then PostMessage(FindWindow(MainAppClassName, nil),
MainAppMessageNumber, MainAppMessageID, CharCode);
end;
// we shall to this refering to the Win32API documentation
Result := CallNextHookEx(0, nCode, wp, lp);
end;
end;
exports
KeyHookProc;
begin
end.
///////////////////////////////
// demo application
// to be hookexe.dpr
program hookexe;
uses
Forms,
_hookexe in '_hookexe.pas' {SpyKeyHookWnd};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TSpyKeyHookWnd, SpyKeyHookWnd);
Application.Run;
end.
// to be _hookexe.pas
unit _hookexe;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
ComCtrls, StdCtrls;
// KeyHookDllName is the name of the DLL containing the hook procedure.
// Equivalent to the DLLs project name.
//
// KeyHookProc is the name of the hook procedure in the DLL.
//
// MainAppMessageNumber and MainAppMessageID -> See DLL source code.
const
KeyHookDllName = 'hooktest.dll';
HookProcName = 'KeyHookProc';
MainAppMessageNumber = wm_User + 1;
MainAppMessageID = 123;
type
TSpyKeyHookWnd = class(TForm)
StatusBar1: TStatusBar;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
LibHandle,
HHookProc : THandle;
HookProc : function(nCode: integer; wp: WPARAM; lp: LPARAM):
LRESULT; stdcall;
// this is the handler for the MainAppMessageNumber message
procedure WMUser_KeyPressedGlobal(var Message : TMessage); message
MainAppMessageNumber;
public
{ Public declarations }
end;
var
SpyKeyHookWnd: TSpyKeyHookWnd;
implementation
{$R *.DFM}
procedure TSpyKeyHookWnd.WMUser_KeyPressedGlobal(var Message :
TMessage);
var KeyBuf : array[0..1] of Char;
begin
// check if message is sent from DLL
if Message.wParam = MainAppMessageID then
begin
// clean structure
FillChar(KeyBuf[0], 2, 0);
// translate character from lParam
KeyBuf[0] := Chr(LoByte(LoWord(Message.lParam)));
// put it into the memo
Memo1.SetSelTextBuf(KeyBuf);
end;
end;
procedure TSpyKeyHookWnd.FormCreate(Sender: TObject);
var DllName : string;
begin
// get full qualified path to the DLL, assuming it is in the
// same directory as the host application
DllName := ExtractFilePath(Application.ExeName) + KeyHookDllName;
// load DLL
LibHandle := LoadLibrary(PChar(DllName));
if LibHandle <> 0 then
begin
// find hook procedure address
@HookProc := GetProcAddress(LibHandle, HookProcName);
if @HookProc <> nil
// insert the hook procedure into the systems hook chain
then HHookProc := SetWindowsHookEx(WH_KEYBOARD, HookProc,
LibHandle, 0)
else Application.MessageBox('Failed to get HookProc address',
'Error', mb_ok);
end
else Application.MessageBox('Failed to load DLL', 'Error', mb_ok);
end;
procedure TSpyKeyHookWnd.FormDestroy(Sender: TObject);
begin
if LibHandle <> 0 then
begin
if HHookProc <> 0
// remove the hook procedure from the systems hook chain
then UnhookWindowsHookEx(HHookProc);
// unload DLL
FreeLibrary(LibHandle);
end;
end;
end.
// to be hookexe.dfm
object SpyKeyHookWnd: TSpyKeyHookWnd
Left = 208
Top = 113
Width = 325
Height = 195
Caption = 'Systemwide Keystrokes - here they are'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Memo1: TMemo
Left = 0
Top = 0
Width = 317
Height = 168
Align = alClient
ReadOnly = True
TabOrder = 0
end
end
///////////////////////