Проблема с hook

← →
xghost (2003-11-04 09:41) [0]

Нашёл код для тогоо чтобы ставить хук на нажатие клавишь , всё работает но приложение пошет при одном нажатит на клавишу 2 буквы, как будто дублирует :( подскажите как исправить данную проблему

Вот код :

Чтобы перехватить нажатые клавиши в других процессах обычно используется hook, или ловушка. Для глобального перехвата используется DLL(Dynamic Link Library).
Пример:

Код библиотеки:
-----------------------------------------------------------------------
library keyboardhook;

uses
SysUtils,
Windows,
Messages,
Forms;

const
MMFName:PChar="Keys";

type
PGlobalDLLData=^TGlobalDLLData;
TGlobalDLLData=packed record
SysHook:HWND; //дескриптор установленной ловушки
MyAppWnd:HWND; //дескриптор нашего приложения
end;

var
GlobalData:PGlobalDLLData;
MMFHandle:THandle;
WM_MYKEYHOOK:Cardinal;

function KeyboardProc(code:integer;wParam:word;lParam:longint):longint;stdcall;
var
AppWnd:HWND;
begin
if code < 0 then
begin
Result:=CallNextHookEx(GlobalData^.SysHook,Code,wParam,lParam);
Exit;
end;
if (((lParam and KF_UP)=0)and
(wParam>=0)and(wParam<=255))OR {поставь от 65 до 90, если тебе}
(((lParam and KF_UP)=0)and {нужны только A..Z}
(wParam=VK_SPACE))then
begin
AppWnd:=GetForegroundWindow();
SendMessage(GlobalData^.MyAppWnd,WM_MYKEYHOOK,wParam,AppWnd);
end;
CallNextHookEx(GlobalData^.SysHook,Code,wParam,lParam);
Result:= 0;
end;

{Процедура установки HOOK-а}
procedure hook(switch : Boolean; hMainProg: HWND) export; stdcall;
begin
if switch=true then
begin
{Устанавливаем HOOK, если не установлен (switch=true). }
GlobalData^.SysHook := SetWindowsHookEx(WH_KEYBOARD, @KeyboardProc, HInstance, 0);
GlobalData^.MyAppWnd:= hMainProg;
end
else
UnhookWindowsHookEx(GlobalData^.SysHook)
end;

procedure OpenGlobalData();
begin
{регестрируем свой тип сообщения в системе}
WM_MYKEYHOOK:= RegisterWindowMessage("WM_MYKEYHOOK");
{получаем объект файлового отображения}
MMFHandle:= CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE,0,SizeOf(TGlobalDLLData),MMFName);
{отображаем глобальные данные на АП вызывающего процесса и получаем указатель
на начало выделенного пространства}
GlobalData:= MapViewOfFile(MMFHandle,FILE_MAP_ALL_ACCESS,0,0,SizeOf(TGlobalDLLData));
if GlobalData=nil then
begin
CloseHandle(MMFHandle);
Exit;
end;

end;

procedure CloseGlobalData();
begin
UnmapViewOfFile(GlobalData);
CloseHandle(MMFHandle);
end;

procedure DLLEntryPoint(dwReason: DWord); stdcall;
begin
case dwReason of
DLL_PROCESS_ATTACH: OpenGlobalData;
DLL_PROCESS_DETACH: CloseGlobalData;
end;
end;

exports hook;

begin
DLLProc:= @DLLEntryPoint;
{вызываем назначенную процедуру для отражения факта присоединения данной
библиотеки к процессу}
DLLEntryPoint(DLL_PROCESS_ATTACH);
end.
----------------------------------------------------------------------
Программа:

unit Unit11;

interface

uses
Windows, Messages, SysUtils, {Variants, }Classes, Graphics, Controls, Forms,
Dialogs, ImgList, ComCtrls, ToolWin, StdCtrls, ExtCtrls, Menus;

type
TForm1 = class(TForm)
Label1: TLabel;
Button1: TButton;
Button2: TButton;
Label2: TLabel;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{изменяем стандартную процедуру}
procedure WndProc(var Msg: TMessage); override;
public
{ Public declarations }
end;

var
Form1: TForm1;
WndFlag: HWND; // дескриптор последнего окна
keys: string; // нажатые клавишы
hDLL: THandle; // дескриптор загружаемой библиотеки
WM_MYKEYHOOK: Cardinal; // новое сообщение

implementation

{$R *.dfm}

procedure Init;
var
Hook: procedure (switch : Boolean; hMainProg: HWND) stdcall;
begin
{посылаю своему окну сообщение для того что бы не выводился первый символ}
SendMessage(Form1.Handle, WM_MYKEYHOOK, VK_SPACE, Application.MainForm.Handle);
@hook:= nil; // инициализируем переменную hook
hDLL:=LoadLibrary(PChar("keyboardhook.dll")); { загрузка DLL }
if hDLL > HINSTANCE_ERROR then
begin { если всё без ошибок, то }
@hook:=GetProcAddress(Hdll, "hook"); { получаем указатель на необходимую процедуру}
hook(true, Form1.Handle);
end
else
begin
ShowMessage("Ошибка при загрузке DLL !");
Exit;
end;

end;

procedure Destroyhook;
var
Hook: procedure (switch : Boolean; hMainProg: HWND) stdcall;
begin
@hook:= nil; // инициализируем переменную hook
if hDLL > HINSTANCE_ERROR then
begin { если всё без ошибок, то }
@hook:=GetProcAddress(Hdll,"hook"); { получаем указатель на необходимую процедуру}
hook(false, Form1.Handle);
if FreeLibrary(hDLL) then
sleep(1000)
else
Exit;
end;

end;

procedure TForm1.WndProc(var Msg: TMessage);
begin
inherited ; // выполняем всё то, что должно происходить при поступлении сообщеня окну
{Но если пришло наше сообщение - выполняем следующий код}
if Msg.Msg = WM_MYKEYHOOK then
label1.caption:=label1.caption+Chr(Msg.wParam);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
freelibrary(hDLL);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
init;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
destroyhook;
end;

initialization
WndFlag:=0;
keys:= "";
{ регистрирую своё сообщение в системе - точно так же надо сделать и в теле DLL
что бы DLL могла посылать главному приложению это сообщение.
}
WM_MYKEYHOOK:=RegisterWindowMessage("WM_MYKEYHOOK");
end.

← →
Song (2003-11-04 09:43) [1]

2xghost © (04.11.03 09:41)
на нажатие и на отжатие :)

← →
xghost (2003-11-04 09:49) [2]

> Song

Понял , спасибо !

Блин как я не подумал ... :)

Проблема с hook Найти похожие ветки