powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Не устанавливается хук WH_CBT
25 сообщений из 44, страница 1 из 2
Не устанавливается хук WH_CBT
    #39547091
Miracle9
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Код
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
uses
  Windows, Messages, SysUtils, Classes, Dialogs, menus, Forms;

  procedure SetHook;
  procedure UnSetHook;


implementation


var
  MyHook: HHOOK;

function CBTProc(Code: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
begin
  if Code = 0 then
  begin
    Result:= CallNextHookEx(MyHook, Code, WParam, LParam);
    Exit;
  end;
  case Code of
    HCBT_CREATEWND: ShowMessage('1');
  end;
end;

procedure SetHook;
begin
  MyHook:= SetWindowsHookEx(WH_CBT, @CBTProc, HInstance, 0);
  if MyHook = 0 then
     ShowMessage('error');
end;

procedure UnSetHook;
begin
  UnHookWindowsHookEx(MyHook);
end;

end.



А WH_MOUSE_LL ставиться и робит без проблем.
...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547109
ma1tus
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Miracle9
Код: pascal
1.
2.
uses
... Dialogs, menus, Forms;

EXE или DLL?
...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547110
Miracle9
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
EXE
...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547111
ma1tus
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Miracle9EXE
Код: pascal
1.
SetWindowsHookEx(WH_CBT, @CBTProc, 0, MainThreadID);
...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547296
Фотография X-Cite
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
В EXE нельзя создавать глобальные хуки, только под конкретную нить.
Хуки на глобальные нити разрешены только в DLL
...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547301
Miracle9
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
X-CiteВ EXE нельзя создавать глобальные хуки, только под конкретную нить.
Хуки на глобальные нити разрешены только в DLL
Да, спасибо.
Когда то читал про это, но на практике WH_MOUSE_LL встал в EXE, а он вроде тоже бы глобальный.
Сейчас пишу в DLL.
...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547304
GunSmoker
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547381
Miracle9
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Так, попытался реализовать через длл
Код EXE
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
unit MU;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, sButton, sMemo;

type
  TMF = class(TForm)
    Button_SetHook: TsButton;
    Memo: TsMemo;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button_SetHookClick(Sender: TObject);
  private
    procedure wmUser(var Msg: tMessage); message WM_USER + $125;
  public
    { Public declarations }
  end;

var
  MF: TMF;

implementation

{$R *.dfm}

var
  HOOK: THandle;
  SetHook: function(wnd: hwnd): boolean; stdcall;
  UnSetHook: procedure; stdcall;

procedure TMF.wmUser(var Msg: tMessage);
begin
  Memo.Lines.Add(Msg.WParam.ToString);
end;

procedure TMF.Button_SetHookClick(Sender: TObject);
begin
  SetHook(Self.Handle);
end;

procedure TMF.FormCreate(Sender: TObject);
begin
  @SetHook := nil;
  @UnSetHook := nil;
  HOOK := LoadLibrary('HOOK.dll');
  if HOOK <> 0 then
  begin
    @SetHook := GetProcAddress(HOOK, 'SetHook');
    if not Assigned(@SetHook) then
      raise Exception.Create('Функция с именем "SetHook" не найдена в библиотеке "HOOK"!');

    @UnSetHook := GetProcAddress(HOOK, 'UnSetHook');
    if not Assigned(@UnSetHook) then
      raise Exception.Create('Функция с именем "UnSetHook" не найдена в библиотеке "HOOK"!');
  end else
  ShowMessage('Не удалось подрузить DLL "HOOK"');
end;

procedure TMF.FormDestroy(Sender: TObject);
begin
  UnSetHook;
  FreeLibrary(HOOK);
end;



DLL
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
library HOOK;

uses
  System.SysUtils,
  System.Classes,
  Vcl.Dialogs,
  Winapi.Windows,
  Winapi.Messages;

{$R *.res}

const
  HookMsg = WM_USER + $125;

var
  MyHook: hwnd;
  AppWnd: hwnd;

//------------------------------------------------------------------------------
// CBTProc
//------------------------------------------------------------------------------
function CBTProc(Code: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
begin
  if Code < 0 then
    Result := CallNextHookEx(MyHook, Code, wParam, lParam);
  case Code of
    HCBT_CREATEWND: PostMessage(AppWnd, HookMsg, wParam, 0);
  end;
  Result := CallNextHookEx(MyHook, Code, wParam, lParam);
end;

//------------------------------------------------------------------------------
// SetHook
//------------------------------------------------------------------------------
function SetHook(wnd: hwnd): boolean; export; stdcall;
begin
  AppWnd := wnd;
  MyHook:= SetWindowsHookEx(WH_CBT, @CBTProc, HInstance, 0);
  if MyHook = 0 then
    Result := false else
    Result := true;
end;

//------------------------------------------------------------------------------
// UnSetHook
//------------------------------------------------------------------------------
procedure UnSetHook; export; stdcall;
begin
  UnHookWindowsHookEx(MyHook);
end;

exports
  SetHook, UnSetHook;

begin

end.



При запуске EXE в МЕМО добавляется одна строка, хотя я никаких окон не открывали и дальше тишина.
Где то накосячил.
...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547385
schi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Miracle9,

А зачем в CBTProc вызывать CallNextHookEx 2 раза ?
...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547387
Miracle9
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
schiMiracle9,

А зачем в CBTProc вызывать CallNextHookEx 2 раза ?
Если оставить
Код: pascal
1.
2.
3.
4.
5.
  if Code < 0 then
  begin
    Result := CallNextHookEx(MyHook, Code, wParam, lParam);
    Exit;
  end;



То форма потом ни на что не реагирует.
...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547391
Miracle9
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
schiMiracle9,

А зачем в CBTProc вызывать CallNextHookEx 2 раза ?

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
function CBTProc(Code: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
begin
  Result := CallNextHookEx(MyHook, Code, wParam, lParam);
  case Code of
    HCBT_CREATEWND: PostMessage(AppWnd, HookMsg, wParam, 0);
  end;
 // Result := CallNextHookEx(MyHook, Code, wParam, lParam);
end;



При таком варианте форма не зависает, но в МЕМО ничего не пишется, лишь один хендл при установке.
...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547502
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Miracle9,

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
function CBTProc(Code: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
begin
  if Code < 0 then
    Result := CallNextHookEx(MyHook, Code, wParam, lParam);
  else begin
    Result := 0;
    case Code of
      HCBT_CREATEWND: PostMessage(AppWnd, HookMsg, wParam, 0);
    end;
  end;
end;
...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547515
schi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Miracle9schiMiracle9,

А зачем в CBTProc вызывать CallNextHookEx 2 раза ?
Если оставить
Код: pascal
1.
2.
3.
4.
5.
  if Code < 0 then
  begin
    Result := CallNextHookEx(MyHook, Code, wParam, lParam);
    Exit;
  end;



То форма потом ни на что не реагирует.

Это метод тыка теперь такой ?

CallNextHookEx надо вызывать всегда, но один раз.

"Calling CallNextHookEx 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."
https://msdn.microsoft.com/ru-ru/library/windows/desktop/ms644974(v=vs.85).aspx
...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547542
Фотография X-Cite
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Все работает...
Просто не все программы походу генерируют событие. Например Calc.exe почему то не генерирует вызов HCBT_CREATEWND
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
library Project4;

uses
  Winapi.Windows,
  System.SysUtils,
  CodeSiteLogging;

{$R *.res}

var
  MyHook: HHOOK;

function CBTProc(aCode: Integer; aWParam: WPARAM; aLParam: LPARAM): LRESULT; stdcall;
begin
  if aCode < 0 then
    Exit(CallNextHookEx(MyHook, aCode, aWParam, aLParam));
  case aCode of
    HCBT_CREATEWND:
      CodeSite.Send('WParam = ' + aWParam.ToString());
  end;
  Exit(CallNextHookEx(MyHook, aCode, aWParam, aLParam));
end;

function SetHook: Boolean; stdcall;
begin
  MyHook := SetWindowsHookEx(WH_CBT, @CBTProc, HInstance, 0);
  Result := MyHook <> 0;
end;

procedure UnSetHook; stdcall;
begin
  UnHookWindowsHookEx(MyHook);
end;

exports SetHook, UnSetHook;

begin
end.



Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
type
  TForm7 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  function SetHook: Boolean; stdcall; external 'Project4' delayed;
  procedure UnSetHook; stdcall; external 'Project4' delayed;

var
  Form7: TForm7;

implementation

{$R *.dfm}

procedure TForm7.Button1Click(Sender: TObject);
begin
  SetHook();
end;

procedure TForm7.Button2Click(Sender: TObject);
begin
  UnSetHook();
end;


...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547543
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
X-CiteВсе работает...
Просто не все программы походу генерируют событие. Например Calc.exe почему то не генерирует вызов HCBT_CREATEWND

Если это Windows 10 то, возможно, это потому что calc.exe там - это не нативное приложение.
...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547550
Фотография X-Cite
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
alekcvpX-CiteВсе работает...
Просто не все программы походу генерируют событие. Например Calc.exe почему то не генерирует вызов HCBT_CREATEWND

Если это Windows 10 то, возможно, это потому что calc.exe там - это не нативное приложение.
Windows 7
Можно поставить API Monitor и посмотреть вообще что вызывает...
Походу все что работает через виртуальные машины, java .net это не отлавливается....
...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547571
Miracle9
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Я до этого ShellHookWindow тестил, там отлов новых окон отлично работает.
И на этом всё. А, ну ещё FLASH тоже хорошо работает.
Смена активного окна не работает.
А отлов уничтожения окна работает, но там один и тот же хендл окна по 10 раз присылается.
Вот решил потестить SetWindowsHookEx с WH_CBT.
...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547576
Miracle9
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
schi
"Это метод тыка теперь такой ?"
В точку)
Я до этого не практиковал установку хуков.
Обычно беру код из интернета, тестирую, а потом разбираю.
А тут в инете 100500 вариантов из статей и ни один не робит.
...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547581
Miracle9
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Итак весь день.
Использовал код X-Cite с поправкой на
Код: pascal
1.
PostMessage(AppWnd, HookMsg, wParam, 0);



При установке хука постоянно сразу какой то wnd кидается, хотя я никаких окон не открывал.
...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547583
Miracle9
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547633
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Miracle9,

вот тебе рабочий код hook.dll
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
library hook;

uses
  System.SysUtils,
  System.Classes,
  Vcl.Dialogs,
  Winapi.Windows,
  DBugIntf,
  Winapi.Messages;

{$R *.res}

const
  HookMsg = WM_USER + $0125;
  ID_APP = 'APPHWND';
  ID_HOOK = 'HHOOKID';

//------------------------------------------------------------------------------
// CBTProc
//------------------------------------------------------------------------------
function CBTProc(Code: NativeInt; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
var
  AppWnd: HWND;
begin
  AppWnd := GetDesktopWindow();
  if Code > 0 then begin
    Result := 0;
    AppWnd := GetProp(AppWnd, ID_APP);
    if Code = HCBT_CREATEWND then
      PostMessage(AppWnd, HookMsg, wParam, 0);
  end else
    Result := CallNextHookEx(GetProp(AppWnd, ID_HOOK), Code, wParam, lParam)
end;

//------------------------------------------------------------------------------
// SetHook
//------------------------------------------------------------------------------
function SetHook(wnd: hwnd): boolean; export; stdcall;
var
  hwndDsk: HWND;
  HookID: HHOOK;
begin
  hwndDsk := GetDesktopWindow();
  SetProp(hwndDsk, ID_APP, wnd);
  HookID:= SetWindowsHookEx(WH_CBT, @CBTProc, HInstance, 0);
  SetProp(hwndDsk, ID_HOOK, HookID);
  Result := HookID <> 0;
end;

//------------------------------------------------------------------------------
// UnSetHook
//------------------------------------------------------------------------------
procedure UnSetHook; export; stdcall;
var
  AppWnd: HWND;
  HookID: HHOOK;
begin
  AppWnd := GetDesktopWindow();
  HookID := GetProp(AppWnd, ID_HOOK);
  if HookID <> 0 then
    UnHookWindowsHookEx(HookID);
end;

exports
  SetHook, UnSetHook;

end.


Если вкратце, то:
Код: pascal
1.
2.
3.
var
  MyHook: hwnd;
  AppWnd: hwnd;


не канает, т.к. хук вызывается в контексте разных процессов, а в dll глобальные переменные глобальны только в рамках одного процесса, т.е. при выхове CBTProc в других процессах MyHook = AppWnd = 0.

Ну и не забывай, что если винда x64, приложение x86 ставит хуки только на такие же, и надо делать отдельно x86 хук и отдельно x64 хук.
...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547652
Фотография X-Cite
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
alekcvpне канает, т.к. хук вызывается в контексте разных процессов, а в dll глобальные переменные глобальны только в рамках одного процесса, т.е. при выхове CBTProc в других процессах MyHook = AppWnd = 0.

Ну и не забывай, что если винда x64, приложение x86 ставит хуки только на такие же, и надо делать отдельно x86 хук и отдельно x64 хук.
Кстати да... На моем скриншоте видно, что лог идет от приложения в которое внедрилась dll. Столбец AppName.
Но это можно легко решить через SharedMemory.
...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547671
Miracle9
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
alekcvp, Большое спасибо!
"Ну и не забывай, что если винда x64, приложение x86 ставит хуки только на такие же, и надо делать отдельно x86 хук и отдельно x64 хук."
Очень важная инфа на будущее, Только, на сколько я помню, x64 приложение работает с длл x64. Т.е. с одного приложения не получится сделать импорт функций из 2ух x86 и x64 длл.

Потестил работу хука, он получается отлавливает все окна и главные и вложенные. В этом плане RegisterShellHookWindow мне больше подходит. И там пофиг на разрядность. Жаль что HSHELL_WINDOWACTIVATED молчит.
...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547672
Фотография X-Cite
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Miracle9,

Вы читали ее описание?
автор[This function is not intended for general use. It may be altered or unavailable in subsequent versions of Windows.]
...
Рейтинг: 0 / 0
Не устанавливается хук WH_CBT
    #39547673
Фотография X-Cite
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Miracle9Потестил работу хука, он получается отлавливает все окна и главные и вложенные.
Это можно решить через те же API функции, например GetParent.. определить когда главное, а когда дочернее.
...
Рейтинг: 0 / 0
25 сообщений из 44, страница 1 из 2
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Не устанавливается хук WH_CBT
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]