Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Связь хука с создавшей его программой

Karburator © (2003-07-20 00:03:00)
Как в процедуре хука обращаться к переменным и классам создавшей его программы при её неактивном состоянии?

Мой код на всяк случай:
var
GlobalPerem: integer = 0;
SysHook: HHook = 0;
Form1: TForm1;

implementation
{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
SysHook := SetWindowsHookEx(WH_GETMESSAGE, @SysMsgProc, HInstance, 0);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
UnhookWindowsHookEx(SysHook);
SysHook := 0;
end;

function SysMsgProc(code: integer; wParam: word; lParam: longint): longint; stdcall;
begin
CallNextHookEx(SysHook, Code, wParam, lParam);
if code = HC_ACTION then
begin
if TMsg(Pointer(lParam)^).message = WM_LBUTTONDOWN then
begin
// inc(GlobalPerem); - надо использовать глобальную переменную
( GlobalPerem)
Как в процедуре хука обращаться к переменным и классам создавшей его программы при её неактивном состоянии?

Мой код на всяк случай:
var
GlobalPerem: integer = 0;
SysHook: HHook = 0;
Form1: TForm1;

implementation
{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
SysHook := SetWindowsHookEx(WH_GETMESSAGE, @SysMsgProc, HInstance, 0);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
UnhookWindowsHookEx(SysHook);
SysHook := 0;
end;

function SysMsgProc(code: integer; wParam: word; lParam: longint): longint; stdcall;
begin
CallNextHookEx(SysHook, Code, wParam, lParam);
if code = HC_ACTION then
begin
if TMsg(Pointer(lParam)^).message = WM_LBUTTONDOWN then
begin
// inc(GlobalPerem); - надо использовать глобальную переменную
// Form1.caption:=inttostr(GlobalPerem); - надо обратится к объекту находящемуся в программе, создавшей хук
beep();
end;
end;
end;

m_a_r_t (2003-07-21 01:38:00) [1]
Вот исходник моего хука, может тебе поможет:

{
KeyHook
author: M_A_R_T
e-mail: m_a_r_t@mail.ru
http://home-mart.by.ru/

XProject
http://www.team-x.ru/
}

library khook;

uses
windows,
messages;

type
PHookRec = ^THookRec;
THookRec = record
MainWindow: HWND;
HookID: HHOOK;
MsgToSend: Integer;
end;

var
rHookRec: PHookRec;
FMHandle: THandle;

function KeybHook(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
AppWnd: HWND;
begin
if code=HC_ACTION then
AppWnd:=GetForegroundWindow();
if ((lParam shr 31) and 1)=1 then
SendMessage(rHookRec^.MainWindow,rHookRec^.MsgToSend,wParam,AppWnd)
else
SendMessage(rHookRec^.MainWindow,rHookRec^.MsgToSend+1,wParam,AppWnd);
Result := CallNextHookEx(rHookRec^.HookID,Code,wParam,lParam)
end;

procedure SetMainHandle(Handle: HWND);
begin
rHookRec^.MainWindow:= Handle;
end;

procedure SetMsgToSend(Msg: Integer);
begin
rHookRec^.MsgToSend:= Msg;
end;

procedure StartHook; stdcall;
begin
if rHookRec^.HookID=0 then
rHookRec^.HookID :=SetWindowsHookEx(WH_KEYBOARD,@KeybHook,HInstance,0);
end;

procedure StopHook; stdcall;
begin
if rHookRec^.HookID<>0 then
begin
UnhookWindowsHookEx(rHookRec^.HookID);
rHookRec^.HookID:=0;
end;
end;

procedure EntryPointProc(Reason: Integer);
begin
case reason of
DLL_PROCESS_ATTACH:
begin
FMHandle:= CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(THookRec), "khookFM");
rHookRec:= MapViewOfFile(FMHandle, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(THookRec));
end;

DLL_PROCESS_DETACH:
begin
try
UnmapViewOfFile(rHookRec);
CloseHandle(FMHandle);
except
end;
end;
end;
end;

exports
SetMainHandle,
SetMsgToSend,
StartHook,
StopHook;

begin
DllProc := @EntryPointProc;
( DLL_PROCESS_ATTACH)
Вот исходник моего хука, может тебе поможет:

{
KeyHook
author: M_A_R_T
e-mail: m_a_r_t@mail.ru
http://home-mart.by.ru/

XProject
http://www.team-x.ru/
}

library khook;

uses
windows,
messages;

type
PHookRec = ^THookRec;
THookRec = record
MainWindow: HWND;
HookID: HHOOK;
MsgToSend: Integer;
end;

var
rHookRec: PHookRec;
FMHandle: THandle;

function KeybHook(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
AppWnd: HWND;
begin
if code=HC_ACTION then
AppWnd:=GetForegroundWindow();
if ((lParam shr 31) and 1)=1 then
SendMessage(rHookRec^.MainWindow,rHookRec^.MsgToSend,wParam,AppWnd)
else
SendMessage(rHookRec^.MainWindow,rHookRec^.MsgToSend+1,wParam,AppWnd);
Result := CallNextHookEx(rHookRec^.HookID,Code,wParam,lParam)
end;

procedure SetMainHandle(Handle: HWND);
begin
rHookRec^.MainWindow:= Handle;
end;

procedure SetMsgToSend(Msg: Integer);
begin
rHookRec^.MsgToSend:= Msg;
end;

procedure StartHook; stdcall;
begin
if rHookRec^.HookID=0 then
rHookRec^.HookID :=SetWindowsHookEx(WH_KEYBOARD,@KeybHook,HInstance,0);
end;

procedure StopHook; stdcall;
begin
if rHookRec^.HookID<>0 then
begin
UnhookWindowsHookEx(rHookRec^.HookID);
rHookRec^.HookID:=0;
end;
end;

procedure EntryPointProc(Reason: Integer);
begin
case reason of
DLL_PROCESS_ATTACH:
begin
FMHandle:= CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(THookRec), "khookFM");
rHookRec:= MapViewOfFile(FMHandle, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(THookRec));
end;

DLL_PROCESS_DETACH:
begin
try
UnmapViewOfFile(rHookRec);
CloseHandle(FMHandle);
except
end;
end;
end;
end;

exports
SetMainHandle,
SetMsgToSend,
StartHook,
StopHook;

begin
DllProc := @EntryPointProc;
EntryPointProc(DLL_PROCESS_ATTACH);
end.

Karburator (2003-07-21 01:14:00) [2]

Смотрю... А как их прменять? :)

Spawn (2003-07-20 06:43:00) [3]

Смотри CreateFileMapping+MapViewOfFile

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »