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

Delphi Sources



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

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

Помогите, ставлю глобальную ловушк которая перехватывает нажатие на клавишу после чего посыаю сообщение в приложение на которое что-то срабатывает. Почему что-то срабатывает два раза?
Код:
=========================================================
модуль
=========================================================
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.
Ответить с цитированием
 


Delphi Sources

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

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

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

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


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


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

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

ВКонтакте   Facebook   Twitter