Корректно ли так устанавливать глобальный хук на клавиатуру?

← →
leonidus (2008-07-30 13:19) [0]

Господа, подскажите корректно ли я ставлю глобальный хук, а то некоторые пользователи жалуются, что вроде из-за моей программы у них подвисает система и хочется понять это причина именно в моей проге или нет.

Глобальный хук на клаву на клавишу Ctrl ставлю в dll:

library key_mouse_hook;

uses
SysUtils, Classes, Windows, Messages;

const
wm_LCtrl_Down=wm_User+1;
wm_RCtrl_Down=wm_User+2;

var
Key_SysHook:HHook = 0;

{$R *.res}

function Key_SysMsgProc(code : integer; wParam : word; lParam : longint) : longint; stdcall;
var H: HWND;
begin
if (Code >= 0) and (lParam and $40000000 = 0) then
begin
H := FindWindow("TForm1", "MainWindow");

if HiWord(GetAsyncKeyState(VK_LCONTROL))<>0 then SendMessage(H, wm_LCtrl_Down, 0, 0);
if HiWord(GetAsyncKeyState(VK_RCONTROL))<>0 then SendMessage(H, wm_RCtrl_Down, 0, 0);
end;
Result:= CallNextHookEx(Key_SysHook, Code, wParam, lParam);
end;

{ Процедура установки HOOK-а}
procedure hook(switch : Boolean) export; stdcall;
begin
if switch=true then
//Устанавливаю HOOK, если он не установлен (switch=true).
begin
Key_SysHook := SetWindowsHookEx(WH_Keyboard, @Key_SysMsgProc, HInstance, 0);
if Key_SysHook <> 0 then //MessageBox(0, "Keyboard hook is working", "", 0)
else MessageBox(0, "Keyboard hook is not working", "", 0);

end
else
begin
//Удаляю функцию-фильтр, если она установлена (т.е. switch=false).
if UnhookWindowsHookEx(Key_SysHook) then //MessageBox(0, "Keyboard hook is unload", "", 0)
else MessageBox(0, "Keyboard hook is not unload", "", 0);

Key_SysHook := 0;
end;
end;

exports hook;

begin
end.

А уже в самой программу устанавливаю хук так:

@hook:= nil; // инициализируем переменную hook
// ********* динамическая загрузка **************
Hdll:= LoadLibrary(PChar("key_mouse_hook.dll")); //загрузка DLL
if Hdll > HINSTANCE_ERROR then // если всё без ошибок, то
begin
@hook:=GetProcAddress(Hdll, "hook"); // получаем указатель на необходимую процедуру
hook(true);
end
else
ShowMessage("Error key_mouse_hook.dll loading!");

Может я что-то делаю не так?

← →
brother © (2008-07-30 13:22) [1]

> что вроде из-за моей программы у них подвисает система

имхо не из-за нее...

← →
Eraser © (2008-07-30 15:03) [2]

> Может я что-то делаю не так?

> SendMessage

тут может быть задержка, лучше асинхронно высылать.

← →
leonidus (2008-07-30 17:22) [3]

"тут может быть задержка, лучше асинхронно высылать."
а это как?

← →
Eraser © (2008-07-30 17:52) [4]

PostMessage

← →
Leonid Troyanovsky © (2008-07-31 08:01) [5]

> leonidus (30.07.08 13:19)

> Может я что-то делаю не так?

При каждом нажатии H := FindWindow("TForm1", "MainWindow");

Терпеливые юзеры, я б убил.

--
Regards, LVT.

← →
Leonid Troyanovsky © (2008-07-31 09:48) [6]

> leonidus (30.07.08 13:19)

> function Key_SysMsgProc(code : integer; wParam : word; lParam
> : longint) : longint; stdcall;

wParam: WPARAM;

> Result:= CallNextHookEx(Key_SysHook, Code, wParam, lParam);

Здесь Key_SysHook всегда будет 0. Т.е., в 9х это работать не будет.

И, во-ще, для ловли пары клавиш проще WH_KEYBOARD_LL hook.

--
Regards, LVT.

← →
leonidus (2008-07-31 22:52) [7]

Leonid Troyanovsky, значит я CallNextHookEx неправильно вызываю?

Мне тут посоветовали переписать функцию таким вот образом:

function Key_SysMsgProc(code : integer; wParam : word; lParam : longint) : longint; stdcall;
var
H: HWND;
Res: DWORD;
begin
Result:= CallNextHookEx(Key_SysHook, Code, wParam, lParam);

if (Code >= 0) and (lParam and $40000000 = 0) then
begin
H := FindWindow("TForm1", "MainWindow");

if HiWord(GetAsyncKeyState(VK_LCONTROL))<>0 then
SendMessageTimeOut(H, wm_Ctrl_Down, 0, 0,SMTO_BLOCK, 5000,Res);

if HiWord(GetAsyncKeyState(VK_RCONTROL))<>0 then
SendMessageTimeOut(H, wm_Shift_Down, 0, 0,SMTO_BLOCK, 5000,Res);
end;

end;

Т.е. CallNextHookEx поставить в самое начало, и использовать SendMessageTimeOut вместо SendMessage.

А в чем проблема с H := FindWindow("TForm1", "MainWindow"); ?

И на счет того что только пара клавиш, на самом деле нужно по крайней мере 4 пары, это я пока просто хочу принцип понять.

← →
Leonid Troyanovsky © (2008-08-01 00:20) [8]

> leonidus (31.07.08 22:52) [7]

> Мне тут посоветовали переписать функцию таким вот образом:

А какая разница, в хуковой процедуре Key_SysHook = 0,
можешь проверить отладчиком.

> А в чем проблема с H := FindWindow("TForm1", "MainWindow");

Предположим, что в системе 100 окон, а юзер набирает
текст со скоростью 120 символов/мин. Вот и тормоза.

Нужно что-то типа
if H = 0 then H := FindWindow("TForm1", "MainWindow");

Просто не надо после активации хука допускать RecreateWnd
для MainWindow.

--
Regards, LVT.

← →
Leonid Troyanovsky © (2008-08-01 00:25) [9]

> leonidus (31.07.08 22:52) [7]

> SendMessageTimeOut вместо SendMessage.

Не нужен здесь никакой Send.
Зацепленный поток получает нажатия через Post,
через Post же их и передавать дальше.

--
Regards, LVT.

← →
leonidus (2008-08-01 01:48) [10]

Начинаю понимать... а что значит "Просто не надо после активации хука допускать RecreateWnd для MainWindow." что это за функция такая RecreateWnd ? Или вы имеете ввиду что один раз получили хэндл H и больше окно не ищем ? Если так то как избежать этого самого RecreateWnd который я так понимаю вызовет смену хендла? На самом деле, факт нажатия передается главному окну приложения, оно креэйтится только один раз при старте программы.

← →
Slym © (2008-08-01 08:54) [11]

а ниче что dll твоя мапится в чужие процессы? а тама Key_SysHook:HHook - не определен...
читай http://www.delphimaster.ru/articles/hooks/index.html
и сохраняй Key_SysHook в "шареной" памяти (например именованый FileMapping)

← →
Slym © (2008-08-01 08:56) [12]

leonidus (30.07.08 13:19)
H := FindWindow("TForm1", "MainWindow");
if HiWord(GetAsyncKeyState(VK_LCONTROL))<>0 then SendMessage(H, wm_LCtrl_Down, 0, 0);
if HiWord(GetAsyncKeyState(VK_RCONTROL))<>0 then SendMessage(H, wm_RCtrl_Down, 0, 0);
end;

мессаги шлеш только когда надо... а адресата ищеш всегда... зачем?

← →
Slym © (2008-08-01 08:59) [13]

leonidus (30.07.08 13:19)
function Key_SysMsgProc(code : integer; wParam : word; lParam : longint) : longint; stdcall;
Слава богу не огреб :) т.к. за таких как ты система думает и выравнивает твой 2байтовый word на границу 4байт

← →
Slym © (2008-08-01 09:02) [14]

leonidus (30.07.08 13:19)
H := FindWindow("TForm1", "MainWindow");
можно не искать... а передать хендл при установке хука и сохнарить его рядом с Key_SysHook в шареной памяти для дальнейшего пользования... и конечно асинхронно PostMessage

← →
Leonid Troyanovsky © (2008-08-01 10:22) [15]

> leonidus (01.08.08 01:48) [10]

> хука допускать RecreateWnd для MainWindow." что это за функция
> такая RecreateWnd ?

Этот метод пересоздает окно формы, например, после изменения стиля
бордюра, иконок бордюра и т.д.

> хэндл H и больше окно не ищем ? Если так то как избежать
> этого самого RecreateWnd который я так понимаю вызовет

Посмотри в Forms.pas, какие действия вызовут RecreateWnd
и избегай их при работающем хуке.
Либо override CreateWnd формы, повторно передавая в хуковую
процедуру новый хендл.

Передать ей значение можно через keybd_event (or SendInput)
условленного нажатия, скажем, keybd_event(0, 0, 0, dwExtraInfo)
в последнем параметре.

И еще раз, low level hook проще - не нужно ничего передавать,
не нужна длл и т.д.

--
Regards, LVT.

> Slym © (01.08.08 09:02) [14]

> можно не искать... а передать хендл при установке хука и
> сохнарить его рядом с Key_SysHook в шареной памяти

Если 9х уже не нужны, то нет нужды и в Key_SysHook.

> Slym © (01.08.08 08:54) [11]
> Slym © (01.08.08 08:56) [13]

Ливия уже предупреждена.

--
Regards, LVT.

← →
Городской Шаман (2008-08-09 06:13) [17]

Лучше здесь
if HiWord(GetAsyncKeyState(VK_LCONTROL))<>0 then SendMessage(H, wm_LCtrl_Down, 0, 0);
if HiWord(GetAsyncKeyState(VK_RCONTROL))<>0 then SendMessage(H, wm_RCtrl_Down, 0, 0);

SendMessage замени на PostMessage точно не будет зацикливания ни в одном случае.

← →
Городской Шаман (2008-08-09 06:15) [18]

> Slym © (01.08.08 08:56) [12]
>
> leonidus (30.07.08 13:19)
> H := FindWindow("TForm1", "MainWindow");
> if HiWord(GetAsyncKeyState(VK_LCONTROL))<>0 then SendMessage(H,
> wm_LCtrl_Down, 0, 0);
> if HiWord(GetAsyncKeyState(VK_RCONTROL))<>0 then SendMessage(H,
> wm_RCtrl_Down, 0, 0);
> end;
>
> мессаги шлеш только когда надо... а адресата ищеш всегда.
> .. зачем?

Под той же Vista64 бит часто менялся хендл окна приложения сам по себе (под некоторыми сборками). Причину определить не удалось. Приходилось использовать поиск окна перед передачей сообщения.

> Под той же Vista64 бит часто менялся хендл окна приложения
> сам по себе (под некоторыми сборками). Причину определить
> не удалось

шойто мене это смущает, на каком основании винда вдруг стала менять хэндл работающего приложения? нонсенс?

← →
Городской Шаман (2008-08-12 15:45) [20]

> brother © (12.08.08 04:33) [19]
>
> > Под той же Vista64 бит часто менялся хендл окна приложения
> > сам по себе (под некоторыми сборками). Причину определить
> > не удалось
>
> шойто мене это смущает, на каком основании винда вдруг стала
> менять хэндл работающего приложения? нонсенс?

Это меня тоже смущало, так как баг наблюдался только у одного или двух пользователей.

> Городской Шаман (12.08.08 15:45) [20]

> Это меня тоже смущало, так как баг наблюдался только у одного
> или двух пользователей.

Ищи где вызывается RecreateWnd.

--
Regards, LVT.

← →
Городской Шаман (2008-08-12 23:38) [22]

> Leonid Troyanovsky © (12.08.08 20:28) [21]
>
>
> > Городской Шаман (12.08.08 15:45) [20]
>
> > Это меня тоже смущало, так как баг наблюдался только у
> одного
> > или двух пользователей.
>
> Ищи где вызывается RecreateWnd.
>
> --
> Regards, LVT.

Было лениво искать. Так как в том унаследованном коде не один скелет в шкафу был зарыт. Решил подобным способом - работает.

Корректно ли так устанавливать глобальный хук на клавиатуру? Найти похожие ветки