Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > ОС и железо
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 15.10.2009, 12:31
avanes avanes вне форума
Прохожий
 
Регистрация: 14.10.2008
Сообщения: 9
Репутация: 10
По умолчанию Hook

Помогите, ставлю глобальную ловушк которая перехватывает нажатие на клавишу после чего посыаю сообщение в приложение на которое что-то срабатывает. Почему что-то срабатывает два раза?
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
=========================================================
модуль
=========================================================
unit Main;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Novator, StdCtrls;
 
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    procedure WndProc(var Msg: TMessage); override;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  Par:ParamConnect;
  hDLL: THandle;
  WM_MYKEYHOOK: Cardinal;
   
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
var
  Hook: procedure (switch : Boolean; hMainProg: HWND) stdcall;
begin
Par.Host := 'localhost';
Par.Port := 1067;
Par.AOwner := Self;
 
//Регистрируем сообщение
WM_MYKEYHOOK:= RegisterWindowMessage('WM_MYKEYHOOK');
 
//Устанавливаем хук
@hook:= nil;
hDLL:= LoadLibrary(PChar('keyhook.dll'));
@hook:=GetProcAddress(Hdll, 'hook');
hook(true, Form1.Handle);
end;
 
procedure TForm1.WndProc(var Msg: TMessage);
begin
inherited ;
 
if Msg.Msg = WM_MYKEYHOOK then
  begin
  If Msg.wParam = VK_F8 then
    Begin
    //ShowMessage('Нажата F8');
    Exit;
    End;
  If Msg.WParam = VK_F5 then
    Begin
    //ShowMessage('Нажата F5');
    Exit;
    End;
  If Msg.WParam = VK_ESCAPE then
    Begin
    //ShowMessage('Нажата ESC');
    Exit;
    End;
  End;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
var
  Hook: procedure (switch : Boolean; hMainProg: HWND) stdcall;
begin
//Удаляем хук
@hook:= nil;
@hook:=GetProcAddress(Hdll, 'hook');
hook(false, Form1.Handle);
end;
 
end.
 
==========================================================
библиотека
==========================================================
library keyhook;
 
uses
  SysUtils,
  Windows,
  Messages,
  Forms;
var
  CurHook:HWND;
  WM_MYKEYHOOK:Cardinal;
 
//Процедура обработки
function KeyboardProc(code : integer; wParam : word; lParam : longint) : longint; stdcall;
  Var AppWnd:HWND;
  Begin
  if code < 0 then
  begin
    Result:= CallNextHookEx(CurHook, Code, wParam, lParam);
    Exit;
  end;
 
  CallNextHookEx(CurHook, Code, wParam, lParam);
  Result:= 0;
 
if  ((lParam and KF_UP)=0) and ((wParam=VK_F5)or(wParam=VK_F8)or(wParam=VK_ESCAPE))  then
   begin
     AppWnd:= GetForegroundWindow();
     SendMessage(HWND_BROADCAST, WM_MYKEYHOOK, wParam, AppWnd);
   end;
end;
 
{Процедура установки HOOK-а}
procedure hook(switch : Boolean; hMainProg: HWND) export; stdcall;
begin
  if switch=true then
  begin
    {Устанавливаю HOOK, если он не установлен (switch=true). }
    CurHook:= SetWindowsHookEx(WH_KEYBOARD, @KeyboardProc, HInstance, 0);
    if CurHook <> 0 then
        MessageBox(0, 'KEYBOARD HOOK установлен !', 'Message from keyhook.dll', 0)
      else
        MessageBox(0, 'HOOK установить не удалось !', 'Message from keyhook.dll', 0);
  end
  else
  begin
    {Удаляю функцию-фильтр, если она установлена (т.е. switch=false). }
    if UnhookWindowsHookEx(CurHook) then
      MessageBox(0, 'HOOK снят !', 'Message from keyhook.dll', 0)
    else
      MessageBox(0, 'HOOK снять не удалось !', 'Message from keyhook.dll', 0);
  end;
end;
 
exports hook;
 
begin
{регестрируем свой тип сообщения в системе}
WM_MYKEYHOOK:= RegisterWindowMessage('WM_MYKEYHOOK');
end.
Admin: Пользуемся тегами!
Вложения
Тип файла: zip Инструмент.zip (9.5 Кбайт, 29 просмотров)

Последний раз редактировалось Admin, 15.10.2009 в 12:34.
Ответить с цитированием
  #2  
Старый 17.10.2009, 01:56
Аватар для Vlad55
Vlad55 Vlad55 вне форума
Прохожий
 
Регистрация: 17.10.2009
Сообщения: 17
Версия Delphi: Delphi XE
Репутация: 10
По умолчанию

Собственно исправлять практически ничего не пришлось И срабатывала ловушка не 2 раза, а оч-оч много раз.
Держи код своей ловушки
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
library HookLib;
 
uses
  SysUtils,
  Windows,
  Messages,
  Forms,Ariphm;
 
var
  CurHook:HWND;
  WM_MYKEYHOOK:Cardinal;
 
//Процедура обработки
function KeyboardProc(code : integer; wParam : word; lParam : longint) : longint; stdcall;
  Var AppWnd:HWND;
  Begin
  if code < 0 then
  begin
    Result:= CallNextHookEx(CurHook, Code, wParam, lParam);
    Exit;
  end;
 
  CallNextHookEx(CurHook, Code, wParam, lParam);
  Result:= 0;
 
if  ((lParam and KF_UP)=0) and ((wParam=VK_F5)or(wParam=VK_F8)or(wParam=VK_ESCAPE))  then
   begin
     if Byte(LParam shr 24)<$80 then //обрабатываем только нажатие
        begin
          AppWnd:= GetForegroundWindow();
          SendMessage(AppWnd,WM_MYKEYHOOK,wParam,lParam);
//          SendMessage(HWND_BROADCAST, WM_MYKEYHOOK, wParam, AppWnd);
          CallNextHookEx(CurHook, Code, wParam, lParam);
        end;
   end;
end;
 
{Процедура установки HOOK-а}
procedure hook(switch : Boolean; hMainProg: HWND) export; stdcall;
begin
  if switch=true then
  begin
    {Устанавливаю HOOK, если он не установлен (switch=true). }
    CurHook:= SetWindowsHookEx(WH_KEYBOARD, @KeyboardProc, HInstance, 0);
    if CurHook <> 0 then
        MessageBox(0, 'KEYBOARD HOOK установлен !', 'Message from keyhook.dll', 0)
      else
        MessageBox(0, 'HOOK установить не удалось !', 'Message from keyhook.dll', 0);
  end
  else
  begin
    {Удаляю функцию-фильтр, если она установлена (т.е. switch=false). }
    if UnhookWindowsHookEx(CurHook) then
      MessageBox(0, 'HOOK снят !', 'Message from keyhook.dll', 0)
    else
      MessageBox(0, 'HOOK снять не удалось !', 'Message from keyhook.dll', 0);
  end;
end;
 
exports hook;
 
begin
{регестрируем свой тип сообщения в системе}
WM_MYKEYHOOK:= RegisterWindowMessage('WM_MYKEYHOOK');
end.

Модуль Ariphm можно скачать тут (самый первый исходник) Ловушку можешь даж не смотреть ибо глючная она...исправлю скоро по-новой выложу

Да, и вот это:
Цитата:
((lParam and KF_UP)=0) and
можно удалить, т.к. смысла в этом нету сейчас никакого
__________________
Delphi в Internet - блог о программировании. Малоизвестные и редко обсуждаемые темы программирования на Delphi

Последний раз редактировалось Vlad55, 17.10.2009 в 16:48.
Ответить с цитированием
  #3  
Старый 22.10.2009, 09:54
avanes avanes вне форума
Прохожий
 
Регистрация: 14.10.2008
Сообщения: 9
Репутация: 10
По умолчанию

Спасибо за помощь.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 15:05.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025