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

Вниз

Lovushka   Найти похожие ветки 

 
Nostradamus   (2001-06-15 18:52) [0]

У меня такая проблема: я сделал ловушку :
SetWindowsHookEx(WH_Shell, ... и тд). Эта ловушка ловит создание и удаление
окон других приложений и посылает сообщение основной программе (ловушка в dll конечно).
Проблема состоит в том что все пойманные ловушкой окна не
появляются в трее как будто у них isLibrary в True стоит. Как этого избежать?


 
StAL   (2001-06-18 14:30) [1]

У меня точно такая проблема. Я ТРИ раза вопрос задавал. Никто не отвечает. Попробуй написать Юрию Зотову. (Я тоже ему писал). Он знает. Если узнаешь пожалуйста напиши.


 
Юрий Зотов   (2001-06-19 21:26) [2]

To Nostradamus.

Письмо Ваше вчера получил. Причину ошибки предполагаю, но ее надо проверять. Но Вы не приложили код DLL, а что же я могу сказать, не видя кода?

Пытался отправить Вам этот же ответ в письме, но почему-то оно не уходит. Вероятно, у меня какие-то проблемы с почтой, буду разбираться. Но на прием она, кажется, все же работает - так что, если хотите, шлите код, попробуем разобраться. А ответить смогу здесь, на форуме.


 
StAL   (2001-06-21 13:27) [3]

Ув. Юрий. Пожалуйста, посмотрите. Этот код я списал с Вашего дилога с Masik, когда Вы разобрались с MsgHandle. Что здесь не так?
Это DLL
library AppH;

uses
SysUtils,
windows,
messages,
Classes;

{$R *.RES}
const
wm_WindCreat = wm_User + 511;
wm_WindDestr = wm_user + 512;
var
ShellHook: HHOOK = 0;

function ShellHookProc(HookCode: Integer; wParam: Longint; lParam: Longint): Longint; stdcall;
begin
Result := 0;
if (HookCode = HSHELL_WINDOWCREATED) or (HookCode = HSHELL_WINDOWDESTROYED) then
begin
if HookCode = HSHELL_WINDOWCREATED then
PostMessage(findwindow("TWinLooker","WinLooker"), wm_WindCreat, WParam, lParam);
if HookCode = HSHELL_WINDOWDESTROYED then
PostMessage(findwindow("TWinLooker","WinLooker"), wm_WindDestr, WParam, lParam);
end
else
Result:=CallNextHookEx(ShellHook, HookCode, wParam, lParam);
end;

function SetHook: boolean; export;
begin
ShellHook := SetWindowsHookEx(WH_shell, @ShellHookProc, hInstance, 0);
Result := ShellHook <> 0
end;

function RemoveHook: boolean; export
begin
Result := UnhookWindowsHookEx(shellhook);
end;
exports SetHook,
RemoveHook;
begin
end.

А это unit

unit Unit1;

interface

uses
SysUtils,WinTypes,WinProcs,Messages,Classes,Graphics,Controls,Forms,Dialogs,StdCtrls;
const
wm_WindCreat = wm_User + 511;
wm_WindDestr = wm_user + 512;
DLLName = "AppH.dll";
type
TWinLooker = class(TForm)
wndlist: TListBox;
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure WMWindCreat (Var M : TMessage); message wm_WindCreat;
procedure WMWindDestr (Var M : TMessage); message wm_WindDestr;
public
{ Public declarations }
end;

function SetHook: boolean; external DLLName name "SetHook";
function RemoveHook: boolean; external DLLName name "RemoveHook";

var
WinLooker: TWinLooker;
buff: ARRAY [0..127] OF Char;
WinF:string;
implementation

{$R *.DFM}

procedure TWinLooker.WMWindCreat(var M: TMessage);
begin
GetWindowText(m.WParam, buff, sizeof(buff));
wndlist.items.Add("Запущено приложение: ""+strpas(buff)+"" "+timetostr(time)+" "+ datetostr(date));
end;

procedure TWinLooker.WMWindDestr(var M: TMessage);
begin
GetWindowText(m.WParam, buff, sizeof(buff));
wndlist.items.Add("Закрыто приложение : ""+strpas(buff)+"" "+timetostr(time)+" "+ datetostr(date));
end;

procedure TWinLooker.FormDestroy(Sender: TObject);
begin
removehook;
wndlist.items.SaveToFile(winf);
end;

procedure TWinLooker.FormCreate(Sender: TObject);
begin
sethook;
winf:=extractfilepath(application.exename)+"data\"+datetostr(date);
if fileexists(winf) then
WndList.Items.LoadFromFile(winf);
end;

end.

Помогите пожалуйста!



 
Алексей Петров   (2001-06-22 00:01) [4]

Сразу в глаза бросается следующая ошибка:

var
ShellHook: HHOOK = 0;

Эта переменная инициализируется только в одном процессе, который выполняет SetWindowsHookEx.

Для всех остальных процессов там останется 0 и соответственно CallNextHookEx вызывается не корректно.

Является ли именно это причиной Вашей проблемы или нет - не знаю. Попробуйте исправить - не заработает - будем смотреть дальше...



 
StAL   (2001-06-22 11:42) [5]

To Алексей Петров. Спасибо! Я попробую.


 
Nostradamus   (2001-06-22 20:45) [6]

что я только с ShellHook не пробовал ничего не получилось.
Но что интересно если поставить CallNextHookEx даже если сам поймал
сообщение то по крайней мере главное приложение запускается
нормально(появляется в трее), но правда сразу виснет. Да и еще я запустил
прогу на NT и этого глюка вообще не было.


 
Юрий Зотов   (2001-06-23 19:05) [7]

Об одной, очень распространенной ошибке уже сказал Алексей Петров - в глобальных хуках надо учитывать изолированность адресных пространств процессов.

Далее, если поступать так, как написано в SDK и при Code>=0 возвращать из хука Result=0, то окна в TaskBar"е действительно не появляются. Я предположил, что в SDK имеется в виду, что Result должен быть нулевым, если хук хочет сказать, что сообщение им уже обработано и его дальнейшее прохождение надо отменить. Соответственно, если сообщение должно проходить дальше, то наш хук в любом случае должен вызывать предыдущий хук.

Предположение это, кажется, оказалось верным. В общем, набросал я следующий код. Проверялся он под WinME и работает, вроде бы, нормально (но полное отсутствие багов, конечно, не гарантирую).

========================= Библиотека =================================

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.


 
Юрий Зотов   (2001-06-23 23:59) [8]

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

Предлагаю всем желающим высказать свое мнение по этому поводу. Но, РАДИ БОГА, конкретно и обоснованно.


 
Алексей Петров   (2001-06-24 00:12) [9]

То, что вызывается всегда - правильно.

Если мы вызываем CallNextHook, фактически вызывается тот Hook который поставили раньше нас, он - в свою очередь дальше и т.д.
Если мы не вызываем CallNextHook, все ранее поставленные Hook-и не отрабатывают, а так делать явно не хорошо.

в MSDN сказано:
-----------------------------------------------------------------------------

SetWindowsHookEx, Remarks:
Calling the CallNextHookEx function to chain to the next hook procedure is optional, but it is highly recommended; otherwise, other applications that have installed hooks will not receive hook notifications and may behave incorrectly as a result. You should call CallNextHookEx unless you absolutely need to prevent the notification from being seen by other applications.

--------------------------------------------------------------------------------

а этот фрагмент:
ShellProc, Parameters
nCode
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.

Я понимаю так, что если nCode<0, обрабатывать его не надо, а вызвать NextHook надо все равно.



 
Юрий Зотов   (2001-06-24 00:48) [10]

В общем-то, я исходил из тех же соображений (первый фрагмент) - вызов предыдущего хука позволяет правильно работать всем остальным программам.

Но, с другой стороны, второй фрагмент (из SDK) можно толковать и так, что при Code>=0 вызывать CallNextHookEx не нужно, а следует просто вернуть ноль. Действительно, ведь далее написано:

Return Values
The return value should be zero.

То есть, ДОЛЖЕН быть ноль. И нигде не сказано, что этот ноль блокирует дальнейшую обработку (хотя, по логике, так оно должно и быть).

Есть еще какие-нибудь мнения, мастера?


 
Алексей Петров   (2001-06-24 01:12) [11]

Маленькое наблюдение в дополнение к вышесказанному.
CallNextHookEx возвращает результат вызова предыдущей ловушки или 0, если её нет.

А по поводу SDK
Return Values
The return value should be zero.

В MSDN написано чуть подробнее, потому наверное я на эти грабли и не наступал, когда сам Hook-и ставил:
Return Values
If nCode is less than zero, the hook procedure must return the value returned by CallNextHookEx.

If nCode is greater than or equal to zero, it is highly recommended that you call CallNextHookEx and return the value it returns; otherwise, other applications that have installed WH_CALLWNDPROCRET hooks will not receive hook notifications and may behave incorrectly as a result. <B>If the hook procedure does not call CallNextHookEx, the return value should be zero.</B>





 
Алексей Петров   (2001-06-24 01:17) [12]

Прошу прощения. Конкретно для Shell hook в MSDN про return value Предельно краток "should be zero".
Но суть от этого не меняется. NextHook всеравно zero и вернет.


 
Юрий Зотов   (2001-06-24 01:36) [13]

Ну, значит, все правильно и этот код можно рекомендовать, как пример глобального хука. Благодарю за обсуждение.

Но для того, чтобы превратить этот пример в нормальную программу, в него нужно добавить блокировку повторной установки хука, если юзер повторно запускает саму программу. Сделать это несложно.

1. В функции входа в DLL надо после вызова CreateFileMapping проверить результат и, если проекция действительно создана, а не открыта, то после вызова MapViewOfFile обнулить 8 байт (или 4 байта) по адресу PData.

2. Соответственно, в SetShellHook надо проверить не только PData <> nil, но еще и содержимое по этому адресу. И ставить хук только в том случае, если это содержимое - ноль.

Это все. Считаю, что на многочисленные поступившие ко мне письма по поводу Shell Hooks я ответил. Тем более, что продублировал ответы по e-mail.

Только странно - что это вдруг все бросились ловить запуск программ? Да еще таким странным способом - через таскбар. А если программа вообще не создает никаких окон, в том числе и на таскбаре?


 
Алексей Петров   (2001-06-24 16:51) [14]

Если уж использовать код как пример, стоит из него убрать еще одни грабли:
CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(TData), MapID);
вместо $FFFFFFFF должно стоять INVALID_HANDLE_VALUE.

В данный момент это одно и тоже, но грядет 64разрядная версия Windows и там INVALID_HANDLE_VALUE будет $FFFFFFFFFFFFFFFF.

Я сам эти грабли наступал при переходе с Delphi3 на Delphi5, когда появился тип Cardinal и INVALID_HANDLE_VALUE из -1 превратился в $FFFFFFFF.



 
Юрий Зотов   (2001-06-25 00:35) [15]

> Алексей Петров.

Tnx. Учтем.


 
Nostradamus   (2001-06-25 18:16) [16]

Спасибо за помощь


 
Igor   (2001-07-13 17:23) [17]

А кто-нибудь пробовал hook на события меню? Долго мучился - не получилось.
Может кто подскажет?


 
Алексей Петров   (2001-08-23 13:58) [18]

Вытащим на верх, чтоб хороший пример не канул в лету :)


 
Ray   (2001-08-24 16:08) [19]

Приведенный пример в принципе пашет нормально, я делал примерно также, а вот как в этом примере к примеру передавать все параметры из длл в основную программу? и LParam и WParam b Code? 8-)


 
Ketmar   (2001-08-24 17:00) [20]

2Ray:
я лично делал WM_COPYDATA

24-Aug-XXXVI A.S.


 
Юрий Зотов   (2001-08-26 21:30) [21]

Это же пример. К нему и надо относиться, как к примеру, а не как к готовому коду на все случаи жизни. Универсальных примеров не существует и собственной головы ни один пример тоже не заменит.

> как передавать все параметры

1. Никто не мешает переопределить запись TData под свои цели и передавать через ту же проекцию все, что угодно.
2. Еще один известный способ - WM_COPYDATA. Но я бы использовал первый.


 
Smart   (2001-10-04 11:21) [22]

Сории за может ламерское обращение. Люди у меня НЕ РАБОТАЕТ код написанный Юрием Зотовым для хука(у меня Windows 2000). После компиляции он висит и отлавливает только свое появление а появление других окон не видит (пробовал дебугить DLL он просто не идет:
if Code in [HSHELL_WINDOWCREATED, HSHELL_WINDOWDESTROYED, HSHELL_REDRAW] then
так вот то что после then не выполняется :-(
Я не знаю как правильно писать хуки и плохо в этом разбираюсь. Я хотел найти работающий example собственно чтобы в этом разобраться.
HELP PLS.
Может Юрий Зотов знает почему этот код может не работать.


 
Юрий Зотов   (2001-10-04 19:31) [23]

> Smart
Вы же открыли новую ветку - там и см. ответ.
http://delphi.mastak.ru/cgi-bin/forum.pl?look=1&id=1002180638&n=2



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

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

Наверх




Память: 0.53 MB
Время: 0.003 c
4-66393
romanK
2001-11-20 17:47
2002.01.21
хранитель екрана


1-66253
AndreyK
2001-12-30 17:32
2002.01.21
Помогите с формой


6-66322
star
2001-10-24 12:20
2002.01.21
как определить, кто подключен к машине?


14-66359
fliz
2001-11-23 17:14
2002.01.21
Пародия на


3-66219
-=CrazyFish=-
2001-12-17 23:26
2002.01.21
Восстановление БД Access





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