Форум: "WinAPI";
Текущий архив: 2004.05.23;
Скачать: [xml.tar.bz2];

Вниз

Хук на клавиатуру и мышь   Найти похожие ветки 

← →
juiceman ©   (2004-04-05 08:32) [0]

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

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.

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

---

← →
rimd ©   (2004-04-05 12:00) [1]

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

---

← →
juiceman ©   (2004-04-07 09:41) [2]

спасибо

---

Страницы: 1 вся ветка

Форум: "WinAPI";
Текущий архив: 2004.05.23;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.036 c