Ловушки Windows

← →
real_dimedrol (2003-01-18 03:24) [0]

Люди, помогите справится с HOOK SYSTEM. Раньше никаких проблем не было. Пока не понадобилось использовать WH_SHELL. Суть в том, что при установке ловушки на таскбаре не появляются кнопки запускаемых приложений!!! После снятия ловушки все опять нормально. Мало того, после замены WH_SHELL на любой другой (WH_CBT, WH_KEYBOARD, WH_DEBUG) тоже все работает нормально. То есть у WH_SHELL есть какая-то особенность. Ниже приведен весь код тестового приложения.

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,unit2;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
function SetHook(Activate : BOOL): BOOL; stdcall;
external "HookDLL.DLL";

implementation

{$R *.DFM}

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

procedure TForm1.FormDestroy(Sender: TObject);
begin
SetHook(false);
end;

end.

unit Unit2;

interface

uses Forms,Windows,inifiles,sysutils,classes,dialogs;

type
PKeyboardHookInfo = ^TKeyboardHookInfo;
TKeyboardHookInfo = packed record
HookHandle: THandle;
end;

var
WMKeyHook: Integer = 0;
CommonArea: PKeyboardHookInfo = NIL;

var
Mapping: THandle = 0;

const
UniqueHookId = "{632E4740-2A70-11D7-AC1A-A6178C57445D}";

implementation
initialization

Mapping := CreateFileMapping($FFFFFFFF, NIL, PAGE_READWRITE, 0,
SizeOf(CommonArea), UniqueHookId);
CommonArea := MapViewOfFile(Mapping, FILE_MAP_ALL_ACCESS,
0, 0, 0);
WMKeyHook := RegisterWindowMessage(UniqueHookId);
commonarea^.HookHandle:=0;

finalization
if Assigned(CommonArea) then
UnmapViewOfFile(CommonArea);
if Mapping <> 0 then
CloseHandle(Mapping);
end.

library HookDll;

uses
Windows,
Unit2;

function ShellProc(Code: Integer; wParam: WPARAM;
lParam: LPARAM): Integer; stdcall;
begin
if code<0 then result:=CallNextHookEx(CommonArea^.HookHandle, Code, wParam,lParam) else
result:=0;
end;

function SetHook(Activate : BOOL): BOOL; stdcall; export;

begin
Result := FALSE;
if Activate then
begin
CommonArea^.HookHandle := SetWindowsHookEx(WH_SHELL,
@ShellProc, hInstance, 0);
Result := (CommonArea^.HookHandle <> 0);

end
else
begin

if CommonArea^.HookHandle <> 0 then
begin
Result := UnhookWindowsHookEx(CommonArea^.HookHandle);
if Result then
CommonArea^.HookHandle := 0;
end;
end;
end;

exports
SetHook;

begin
end.

Я перекопал весь интернет в поисках решения и, похоже, эта проблема никого больше не волнует. И есть еще одна проблемка. SetHook(false) после запуска любого придожения "поверх" моего срабатывает только по выходу из программы (form destroy), причем функция возвращает false но ловушка снимается. Опять же попробовал вместо WH_SHELL WH_Keyboard - ловушка прекрасно снимается в любое время, с WH_DEBUG та же проблема что и с WH_SHELL.

← →
Юрий Зотов (2003-01-18 06:19) [1]

Никаких таких особых особенностей у WH_SHELL нет. Наверняка виноват все же код. Скорее всего - CallNextHookEx надо вызывать всегда, независимо от Code (иначе блокируется стандартная обработка, а Explorer, похоже, сам пользуется тем же механизмом для создания окон на таскбаре).

В общем, привожу работающий пример WH_SHELL хука. Сравните сами.

library DLL;

uses
Windows, Messages;

const
MapID = "Global Hook Demo";

type
PData = ^TData;
TData = record
AppWnd: HWND;
OldHook: HHOOK
end;

var
HMap: THandle = 0;
Data: PData = nil;

procedure DLLEntryPoint(dwReason: DWORD); stdcall;
begin
case dwReason of
DLL_PROCESS_ATTACH:
begin
HMap := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(TData), MapID);
Data := MapViewOfFile(HMap, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TData))
end;
DLL_PROCESS_DETACH:
begin
UnMapViewOfFile(Data);
CloseHandle(HMap)
end
end
end;

function ShellHook(Code: Integer; ParamW: WPARAM; ParamL: LPARAM): LRESULT; stdcall;
begin
if Code in [HSHELL_WINDOWCREATED, HSHELL_WINDOWDESTROYED, HSHELL_REDRAW] then
SendMessage(Data^.AppWnd, WM_USER, ParamW, Code);
Result := CallNextHookEx(Data^.OldHook, Code, ParamW, ParamL)
end;

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

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

exports
SetShellHook,
RemoveShellHook;

begin
if DLLProc = nil then
DLLProc := @DLLEntryPoint;
DLLEntryPoint(DLL_PROCESS_ATTACH)
end.

========== Форма тестирующего приложения (DPR обычный) ==========

unit AppUnit;

interface

uses
Windows, Messages, Classes, Controls, Forms, StdCtrls;

type
TAppMainForm = class(TForm)
WndList: TListBox;
ClearButton: TButton;
procedure ClearButtonClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
procedure WMUser(var Message: TMessage); message WM_USER;
protected
procedure CreateWnd; override;
end;

var
AppMainForm: TAppMainForm;

implementation

{$R *.DFM}

const
DLLName = "DLL.dll";

function SetShellHook(Wnd: HWND): BOOL; stdcall; external DLLName name "SetShellHook";
function RemoveShellHook: BOOL; stdcall; external DLLName name "RemoveShellHook";

function GetWndText(Wnd: HWND): string;
var
L: Integer;
begin
L := GetWindowTextLength(Wnd) + 1;
if L > 1 then
begin
SetLength(Result, L);
GetWindowText(Wnd, @Result[1], L);
end
else Result := "???"
end;

{ TAppMainForm }

procedure TAppMainForm.WMUser(var Message: TMessage);
var
I: Integer;
begin
case Message.LParam of
HSHELL_WINDOWCREATED:
WndList.Items.AddObject(GetWndText(Message.WParam), TObject(Message.WParam));
HSHELL_WINDOWDESTROYED:
begin
I := WndList.Items.IndexOfObject(TObject(Message.WParam));
if I >= 0 then WndList.Items.Delete(I)
end;
HSHELL_REDRAW:
begin
I := WndList.Items.IndexOfObject(TObject(Message.WParam));
if I >= 0 then WndList.Items[I] := GetWndText(Message.WParam)
end
end
end;

procedure TAppMainForm.ClearButtonClick(Sender: TObject);
begin
WndList.Clear
end;

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

procedure TAppMainForm.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;

end.

← →
Song (2003-01-18 10:03) [2]

real_dimedrol © (18.01.03 03:24)
2Дык ошибка-то очевидна: Вы в результате обработки call-back ф-ии хука возвращаете ноль. Сначала всё правильно т.е. Result:=CallNextHookEx() .. а потом Result:=0 зачем ?

← →
Юрий Зотов (2003-01-18 10:15) [3]

> Song © (18.01.03 10:03)

Не совсем так - Вы не заметили else в конце строки. Человек писал строго по хелпу:

1. If nCode is less than zero, the hook procedure must pass the message to the CallNextHookEx function without further processing and should return the value returned by CallNextHookEx.

2. The return value should be zero.

Видимо, нужно признать, что в хелпе имеет место некоторая путаница. CallNextHookEx можно (и в данном случае нужно) вызывать всегда, независимо ни от каких Code. Это обеспечивает нормальную обработку сообщения далее по цепочке. Если же в цепочке больше хуков нет, CallNextHookEx сама вернет ноль - и тоже будет как раз то, что требуется.

← →
real_dimedrol (2003-01-18 12:39) [4]

Спасибо, что откликнулись. Нашел я сам ошибку. Удивляюсь только, как с такой WH_Keyboard работает. В Unit2 при инициализации в каждый раз обнуляется HookHandle, т.е. при подключении к каждому процессу. Смешно. А вот с возвращаемым значением: и правда, иконки на таскбаре показываются только при result:=callnexthook(). Странно, поскольку именно в хелпе я и вычитал про возвращаемое значение. Так или иначе, проблема снята. Спасибо за участие.

← →
Юрий Зотов (2003-01-18 14:34) [5]

Думаю, здесь нет ничего странного. Скорее всего, для создания окон на таскбаре Explorer пользуется тем же хуком. А свой мы ставим поверх него. Поэтому, возвращая ноль, наш хук разрывает цепочку и до Explorer"а просто ничего не доходит. Поэтому он никаких окон и не создает. Если же мы вызываем CallNextHookEx, то цепочка отрабатывает и все идет, как нужно.

С переключением языка - то же самое.

Ловушки Windows Найти похожие ветки