| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Хук на клавиатуру и мышь

juiceman ©   (2004-04-05 08:32:00) 

Ставлю глобальный хук на клавиатуру...
Библиотека:

library hook_dll1;

uses
 Windows,
 Messages,
 Forms;

var
 H : THandle;
 MouseHook: HWND; // дескриптор установленной ловушки

{Данная ф-ия вызывается системой каждый раз, когда возникает какое-то событие в
dialog box-е, message box-е, menu, или scroll bar-е}
function MouseProc(code : integer; wParam : word; lParam : longint) : longint; stdcall;
begin
if code >= 0 then
 begin
 {Проверяю, нажата ли правая кнопка мыши}
     {Вывожу сообщение при удачной работе.}
 //if wParam= then
   SendMessage(FindWindow('TForm1','Form1'),WM_CHAR,wparam,0);
 end;
 {Пытаемся передать сообщение дальше по цепочке hook-ов. }
 Result:= CallNextHookEx(H, Code, wParam, lParam);
end;

{Процедура установки HOOK-а}
procedure hook(switch : Boolean) export; stdcall;
begin
 if switch=true then
 begin
   {Устанавливаю HOOK, если он не установлен (switch=true). }
   H := SetWindowsHookEx(WH_KEYBOARD, @MouseProc, HInstance, 0);
   if H <> 0 then
       MessageBox(0, 'Mouse HOOK установлен !', 'Message from Exampel2/Process1', 0)
     else
       MessageBox(0, 'Mouse HOOK установить не удалось !', 'Message from Exampel2/Process1', 0);
 end
 else
 begin
   {Удаляю функцию-фильтр, если она установлена (т.е. switch=false). }
   if UnhookWindowsHookEx(H) then
     MessageBox(0, 'Mouse HOOK снят !', 'Message from Exampel2/Process1', 0)
   else
     MessageBox(0, 'Mouse HOOK снять не удалось !', 'Message from Exampel2/Process1', 0);

 end;
end;

exports hook;

begin
end.


Сама программа:

...
TForm1 = class(TForm)
   Button1: TButton;
   Timer1: TTimer;
   Memo1: TMemo;
   Button2: TButton;
   Button3: TButton;
   procedure Button1Click(Sender: TObject);
   procedure Timer1Timer(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure Button2Click(Sender: TObject);
   procedure Button3Click(Sender: TObject);
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
 private
   procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
   procedure HOOKEVENT(var Msg:TWMCHAR);message WM_CHAR;
 public
   { Public declarations }
 end;

 MyProcType = procedure (flag : Boolean); stdcall;

var
 Form1: TForm1;
 Hdll : HWND; { дескриптор загружаемой DLL (для динамической загрукзки)}
...
procedure TForm1.Button2Click(Sender: TObject);
var
 hook: MyProcType;
begin

 @hook:= nil; // инициализируем переменную hook

{ ********* динамическая загрузка **************}

 Hdll:= LoadLibrary(PChar('hook_dll1.dll')); { загрузка DLL }
 if Hdll > HINSTANCE_ERROR then            { если всё без ошибок, то }
   begin
     @hook:=GetProcAddress(Hdll, 'hook');     { получаем указатель на необходимую процедуру}
     Button2.Enabled:=True;
     Button1.Enabled:=False;
     hook(true);
   end
 else
   ShowMessage('Ошибка при загрузке DLL !');

{ **********************************************}
end;

procedure TForm1.Button3Click(Sender: TObject);
var
 hook: MyProcType;
begin
 @hook:= nil; // инициализируем переменную hook
 if Hdll > HINSTANCE_ERROR then
   begin                                   { если всё без ошибок, то }
     @hook:=GetProcAddress(Hdll, 'hook');  { получаем указатель на необходимую процедуру}
     Button1.Enabled:=True;
     Button2.Enabled:=False;
     hook(false);                           {вызываем нужную процедуру из DLL}
   end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 FreeLibrary(Hdll); { при закрытии формы - освобождаем DLL }
end;

procedure TForm1.HOOKEVENT(var Msg:TWMKEY);
begin
Memo1.Lines.Add(chr(Msg.CharCode));
if Msg.CharCode=13 then showmessage('enter!');
Msg.Result:=0;
end;

end.

Все вроде нормально работает, только клавиша "двоится" - нажимаю раз, показывает как за два. ??????

---

juiceman   (2004-04-07 09:41:00) [1]

спасибо

---

rimd   (2004-04-05 12:00:00) [2]

все дело в том что этот хук ловит up и down, т.е. когда ты нажимаешь кнопку срабатывает ф-ция, а когда отпускаешь то тоже срабатывает.

---

Наверх