Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2002.01.14;
Скачать: [xml.tar.bz2];

Вниз

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

 
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;

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




Страницы: 1 вся ветка

Форум: "WinAPI";
Текущий архив: 2002.01.14;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.56 MB
Время: 0.016 c
1-42429
VID
2001-12-22 16:28
2002.01.14
Выделение слова из строки


14-42543
skiph
2001-11-12 08:31
2002.01.14
HTML help


7-42582
Maestro
2001-09-23 13:14
2002.01.14
Как сделать форму прозрачной


3-42351
psv
2001-12-07 15:27
2002.01.14
Как отделить копейки в Grid


1-42497
Victor
2001-12-25 19:40
2002.01.14
ColorDialog





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский