[avanes]

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

Код:

=========================================================
модуль
=========================================================
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: Пользуемся тегами!

[Vlad55]

Собственно исправлять практически ничего не пришлось И срабатывала ловушка не 2 раза, а оч-оч много раз.
Держи код своей ловушки

Код:

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

можно удалить, т.к. смысла в этом нету сейчас никакого

[avanes]

Спасибо за помощь.