Форум: "Основная";
Текущий архив: 2002.11.11;
Скачать: [xml.tar.bz2];
ВнизЛюди поможите! Опять с хуками... Найти похожие ветки
← →
TankMan (2002-10-30 21:41) [0]Я уже писал, что поиск сдесь (мягко говоря) не важный, а перелопачивать столько инфы в ручную, в поисках примера глобального хука ну просто нет возможности.Поэтому не мог бы кто, дать ссылку сдесь в FAQ, или ссылку еще где, где можно посмотреть пример глобального хука на клаву и на мышь. Заранее благодарен.
← →
Юрий Зотов (2002-10-31 00:45) [1]http://delphi.mastak.ru/articles/hooks/index.html
← →
TankMan (2002-10-31 18:42) [2]А других примеров нет?
← →
Юрий Зотов (2002-10-31 19:08) [3]В Греции все есть. Вот пример WH_SHELL.
Ловит появление/исчезновение/изменение окон на таскбаре.
Если пример не запускается под NT/2k/XP, пропишите в константе DLLName полный путь к DLL.
=====================================
Код проекта DLL (файл DLL.DPR):
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.
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2002.11.11;
Скачать: [xml.tar.bz2];
Память: 0.47 MB
Время: 0.007 c