Главная страница
    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.



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

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

Наверх





Память: 0.45 MB
Время: 0.003 c
1-75598
Masa
2002-01-06 23:09
2002.01.24
Помогите написать алгоритм вычисления простых чисел из множества !!!


1-75553
Анатолий
2002-01-06 06:21
2002.01.24
Литература по отчётам


7-75689
AKV
2001-10-03 15:34
2002.01.24
Виртуальный принтер?


1-75549
3d[Power]
2002-01-02 23:42
2002.01.24
record


1-75539
Misha
2002-01-05 11:43
2002.01.24
HELP





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