и опять хук....

← →
shiva1 (2001-11-15 18:10) [0]

Коллеги, я понимаю, что тема несколько навязла в зубах, однако я плотненько засел.
Задача у меня простая, приложение должно полностью перехватывать на себя весь ввод с клавиатуры, даже если оно скрыто под другими окнами. Естественно, первым моим телодвижением было воспользоваться примером из FAQ. Увы, при попытке запуска приложения - сообщения об ошибке. Тогда я взял пример работающей связки DLL+приложение, которая появлялась в данном форуме, и попробовал переработать. Ошибок нет, все запускается (правда, несколько медленно), но не работает. Код предоставляю...

DLL
library sendkey;
uses
WinTypes,
WinProcs,
Messages;

const
{пользовательские сообщения}
MapID="HOOK";
wm_NextShow_Event = wm_User + 133;
wm_PrevShow_Event = wm_User + 134;
{handle для ловушки}
HookHandle: hHook = 0;
type
PData = ^TData;
TData= record
AppWND : HWND;
OldHook:HHOOK
end;

var
HMap:THandle=0;
Data:Pdata = nil;
//SaveExitProc : Pointer;

procedure DLLEntryPoint(dwReason:DWORD); stdcall;
Begin
case dwReason of
DLL_PROCESS_ATTACH:
Begin
HMap:=CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(TData), "HOOK");
Data:=MapViewOfFile(HMap, FILE_MAP_ALL_ACCESS,0,0,sizeof(TDATA))
End;
DLL_PROCESS_DETACH:
Begin
UnMapViewOfFile(Data);
CloseHandle(HMap);
End;
end
End;

{собственно ловушка}
function Key_Hook(Code: integer; ParamW: WPARAM; ParamL: LPARAM): LRESULT; stdcall;
var
H: HWND;
begin
{если Code>=0, то ловушка может обработать событие}
if (Code in [HSHELL_WINDOWCREATED, HSHELL_WINDOWDESTROYED, HSHELL_REDRAW]) then
begin
{это те клавиши?}
if ((ParamW = VK_ADD) or (ParamW = VK_SUBTRACT)) and (ParamL and $40000000 = 0)
then
begin
{ищем окно по имени класса и по заголовку}
H := FindWindow("TForm1", "XXX");
{посылаем сообщение}
if ParamW = VK_ADD then
SendMessage(H, wm_NextShow_Event, 0, 0)
else
SendMessage(H, wm_PrevShow_Event, 0, 0);
end;
{если 0, то система должна дальше обработать это событие}
{если 1 - нет}
end;

{если Code<0, то нужно вызвать следующую ловушку}
Result := CallNextHookEx(Data^.OldHook, Code, ParamW, ParamL);
end;
{при выгрузке DLL надо снять ловушку}
//procedure LocalExitProc; far;
//begin
// if HookHandle<>0 then
// begin
// UnhookWindowsHookEx(HookHandle);
// ExitProc := SaveExitProc;
// end;
// end;

function SetShellHook(Wnd:HWND): BOOL; stdcall;
begin
if DATA<>nil Then
begin
Data^.AppWnd:=Wnd;
Data^.OldHook:=SetWindowsHookEx(WH_SHELL, @Key_Hook, HInstance, 0);
Result:=Data^.OldHook <> 0
end
else Result:=False;
end;

function RemoveShellHook: BOOL; stdcall;
begin
Result:=UnhookWindowsHookEx(Data^.OldHook);
end;

exports
SetShellHook,
RemoveShellHook;
{инициализация DLL при загрузке ее в память}
begin
{устанавливаем ловушку}
{HookHandle := SetWindowsHookEx(wh_Keyboard, @Key_Hook, hInstance, 0);
if HookHandle = 0 then
MessageBox(0, "Unable to set hook!", "Error", mb_Ok)
else
begin SaveExitProc := ExitProc; ExitProc := @LocalExitProc;
end;}
if DLLProc=nil Then
DllProc:=@DLLEntryPoint;
DLLEntryPoint(DLL_PROCESS_ATTACH);
end.

← →
shiva1 (2001-11-15 18:11) [1]

Приложение...

Приложение...

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Db, DBTables, Buttons;

const {пользовательские сообщения}
wm_1_Event = wm_User + 131;
wm_2_Event = wm_User + 132;
wm_3_Event = wm_User + 133;
wm_4_Event = wm_User + 134;
wm_5_Event = wm_User + 135;
wm_6_Event = wm_User + 136;
wm_7_Event = wm_User + 137;
wm_8_Event = wm_User + 138;
wm_9_Event = wm_User + 139;
wm_0_Event = wm_User + 140;
wm_en_Event = wm_User + 141;

type
TForm1 = class(TForm)
Memo1: TMemo;
BitBtn1: TBitBtn;
Table1: TTable;
Table1CODE: TStringField;
procedure BitBtn1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
procedure WM_1MSG (Var M : TMessage); message wm_1_Event;
procedure WM_2MSG (Var M : TMessage); message wm_2_Event;
procedure WM_3MSG (Var M : TMessage); message wm_3_Event;
procedure WM_4MSG (Var M : TMessage); message wm_4_Event;
procedure WM_5MSG (Var M : TMessage); message wm_5_Event;
procedure WM_6MSG (Var M : TMessage); message wm_6_Event;
procedure WM_7MSG (Var M : TMessage); message wm_7_Event;
procedure WM_8MSG (Var M : TMessage); message wm_8_Event;
procedure WM_9MSG (Var M : TMessage); message wm_9_Event;
procedure WM_0MSG (Var M : TMessage); message wm_0_Event;
procedure WM_enMSG (Var M : TMessage); message wm_en_Event;
{ Private declarations }
public
{ Public declarations }
protected

procedure CreateWnd; Override;
end;

var
Form1: TForm1;
P:Pointer;

implementation

{$R *.DFM}
const
DLLName= "SendKey.dll";
//function Key_Hook : Longint; far; external "sendkey.dll";
function SetShellHook(Wnd:HWND): BOOL; stdcall; external DLLName name "SetShellHook";
function RemoveShellHook: BOOL; stdcall; external DLLName name "RemoveShellHook";

procedure TForm1.WM_1MSG (Var M : TMessage);
Var i:Integer;
s:String;
Begin
...
end;

procedure TForm1.CreateWnd;
begin
inherited;
if NOT SetShellHook(Handle) Then
MessageBox(Handle, "Unable to set hook", PChar(Application.Title), MB_OK or MB_ICONHAND)
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if NOT RemoveShellHook then
MessageBox(Handle, "Unable to remove hook", PChar(Application.Title), MB_OK or MB_ICONHAND)
end;

И что, спрашивается, этой гадости надо????

и опять хук.... Найти похожие ветки