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

Вниз

ПРОБЛЕМА С 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)???



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

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

Наверх





Память: 0.57 MB
Время: 0.019 c
1-75608
Трынкин Сергей
2002-01-08 10:52
2002.01.24
Подскажите пожалуйста где взять ADOExpress Update Pack 1


7-75699
BigFoot
2001-10-12 12:24
2002.01.24
Опять сервисы !!!


7-75702
Andrews
2001-10-09 15:36
2002.01.24
Формат *.icl (Icon Library)


1-75621
Eraser
2002-01-07 22:25
2002.01.24
to panov


1-75596
Delphimun
2002-01-07 22:01
2002.01.24
Структура консольного приложения





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский