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

Глобальный хук на клаву на клавишу 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!');

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

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

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

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


> SendMessage

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

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

PostMessage

> leonidus   (30.07.08 13:19)  

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

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

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

--
Regards, LVT.

> 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.

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 пары, это я пока просто хочу принцип понять.

> 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.

> leonidus   (31.07.08 22:52) [7]

> SendMessageTimeOut вместо SendMessage.

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

--
Regards, LVT.

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

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

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;

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

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

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

> 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.

Лучше здесь
 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 точно не будет зацикливания ни в одном случае.

> 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 бит часто менялся хендл окна приложения
> сам по себе (под некоторыми сборками). Причину определить
> не удалось

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

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


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

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

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

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

--
Regards, LVT.

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


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