ПРОБЛЕМА С HOOK. HELP!

← →
Smart (2001-10-04 11:29) [0]

Сории за может ламерское обращение. Люди у меня НЕ РАБОТАЕТ код написанный Юрием Зотовым для хука который в ответе на вопрос Nostradamusa Lovushka(у меня Windows 2000). На всякий случай повторяю его:
======================== Библиотека ===========================

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 стандартный)==================
На форму (Name=AppMainForm, OnClose=FormClose) надо бросить ListBox (Name=WndList) и кнопку (Name=ClearButton, OnClick=ClearButtonClick).

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.
================================================================
После компиляции он отлавливает только свое появление а появление других окон не видит (пробовал дебугить DLL - просто в функции не идет дальше
if Code in [HSHELL_WINDOWCREATED, HSHELL_WINDOWDESTROYED, HSHELL_REDRAW] then ...
так вот то что после then не выполняется :-( , хотя CallNextHookEx вроде идет
Я не знаю как правильно писать хуки и плохо в этом разбираюсь. Я хотел найти работающий example собственно чтобы в этом разобраться.
HELP PLS.
Может сам автор - Юрий Зотов знает почему этот код может не работать?
Если кто может киньте просто работающий example.

← →
Юрий Зотов (2001-10-04 19:29) [1]

Судя по тому, что у других код работает, Вы или изменили его, или что-то сделали не так. Если меняли код, то приведите свой вариант. Если нет, то опишите последовательность Ваших действий по запуску примера.

← →
Smart (2001-10-05 11:28) [2]

Последовательность выполнения простая:
Ctrl+C
Ctrl+V :-).

Я просто скопировал код:
Сделал File->New->DLL туда скопировал код DLL и откомпилил.
File->New->Application кинул туда то что написано. Пообзывал так как надо.
Создал пустые события (что была referrence) onFormClose & onClearButtonClick. Скопировал весь текст для DPR себе в сырцы.
F9 :-).
RESULT: Отловилось только окно своего процесса.
Может я чего не понимайт но окна других приложений он не ловит.
Тут мой друг написал текст на C для того же самого
!!(в принципе нужно отловить появление окна от Messenger Service)!!
только он делал вообще не через ShellHookEx. Он олавливает все сообщения системы и делает:

SetWindowsHookEx(WH_GETMESSAGE, (HOOKPROC)fpMIHookProc, hHookDLL, 0)
=========================
Код из DLL :

....CUT_HERE....

__declspec(dllexport) LRESULT CALLBACK
MIHookProc(int nCode, WPARAM wParam, LPARAM lParam) {
MSG *info = (MSG *)lParam;
if (nCode == HC_ACTION && info->message == RegisterWindowMessage(TEXT("SHELLHOOK")) && info->wParam == 1)
{
....CUT_HERE....

Он ловит сообщение системы "SHELLHOOK". Это недокументированое в принцие сообщение при появлении проги на таскбаре.
==========================================================
Но вообще задача отловить окно ДО ТОГО как оно покажется (чтоб например из Far-а в полный экран не выбивало)
Если тебе некогда может просто скинь РАБОЧИЕ исходники+exe file
мылом ( smart@kma.mk.ua ) Буду очень признателен.

← →
Smart (2001-10-12 13:09) [3]

Так что никто не знает как отловить появление окна до
того как онон нарисовалося на экране.
(у меня это окно Messenger Service-a)???

ПРОБЛЕМА С HOOK. HELP! Найти похожие ветки