powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Не работает хук на мышь.
6 сообщений из 6, страница 1 из 1
Не работает хук на мышь.
    #39886874
Фотография Tech N9ne
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Добрый день, ребята, подскажите пожалуйста, почему не работает пример из delphi world ?
По идее в Listbox должен появляться соответствующий текст. Но нет никакой реакции..
Раньше работало.. Но это было на D7 и win7 x86. Может в этом проблема?
сейчас Windows 7 x64, delphi rio.
Заранее спасибо.
Код: 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.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
unit Unit1;

 interface

 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
   Dialogs, AppEvnts, StdCtrls;

 type
   TForm1 = class(TForm)
     ApplicationEvents1: TApplicationEvents;
     Button_StartJour: TButton;
     Button_StopJour: TButton;
     ListBox1: TListBox;
     procedure ApplicationEvents1Message(var Msg: tagMSG;
       var Handled: Boolean);
     procedure Button_StartJourClick(Sender: TObject);
     procedure Button_StopJourClick(Sender: TObject);
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
   private
     { Private declarations }
     FHookStarted : Boolean;
   public
     { Public declarations }
   end;

 var
   Form1: TForm1;


 implementation

 {$R *.dfm}

 var
   JHook: THandle;

 // The JournalRecordProc hook procedure is an application-defined or library-defined callback 
// function used with the SetWindowsHookEx function. 
// The function records messages the system removes from the system message queue. 
// A JournalRecordProc hook procedure does not need to live in a dynamic-link library. 
// A JournalRecordProc hook procedure can live in the application itself. 

// WH_JOURNALPLAYBACK Hook Function 

//Syntax 

// JournalPlaybackProc( 
// nCode: Integer;  {a hook code} 
// wParam: WPARAM;  {this parameter is not used} 
// lParam: LPARAM  {a pointer to a TEventMsg structure} 
// ): LRESULT;  {returns a wait time in clock ticks} 


function JournalProc(Code, wParam: Integer; var EventStrut: TEventMsg): Integer; stdcall;
 var
   Char1: PChar;
   s: string;
 begin
   {this is the JournalRecordProc}
   Result := CallNextHookEx(JHook, Code, wParam, Longint(@EventStrut));
   {the CallNextHookEX is not really needed for journal hook since it it not 
  really in a hook chain, but it's standard for a Hook}
   if Code < 0 then Exit;

   {you should cancel operation if you get HC_SYSMODALON}
   if Code = HC_SYSMODALON then Exit;
   if Code = HC_ACTION then
   begin
     { 
    The lParam parameter contains a pointer to a TEventMsg 
    structure containing information on 
    the message removed from the system message queue. 
    }
     s := '';

     if EventStrut.message = WM_LBUTTONUP then
       s := 'Left Mouse UP at X pos ' +
         IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);

     if EventStrut.message = WM_LBUTTONDOWN then
       s := 'Left Mouse Down at X pos ' +
         IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);

     if EventStrut.message = WM_RBUTTONDOWN then
       s := 'Right Mouse Down at X pos ' +
         IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);

     if (EventStrut.message = WM_RBUTTONUP) then
       s := 'Right Mouse Up at X pos ' +
         IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);

     if (EventStrut.message = WM_MOUSEWHEEL) then
       s := 'Mouse Wheel at X pos ' +
         IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);

     if (EventStrut.message = WM_MOUSEMOVE) then
       s := 'Mouse Position at X:' +
         IntToStr(EventStrut.paramL) + ' and Y: ' + IntToStr(EventStrut.paramH);

     if s <> '' then
        Form1.ListBox1.ItemIndex :=  Form1.ListBox1.Items.Add(s);
   end;
 end;

 procedure TForm1.Button_StartJourClick(Sender: TObject);
 begin
   if FHookStarted then
   begin
     ShowMessage('Mouse is already being Journaled, can not restart');
     Exit;
   end;
   JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, hInstance, 0);
   {SetWindowsHookEx starts the Hook}
   if JHook > 0 then
   begin
     FHookStarted := True;
   end
   else
     ShowMessage('No Journal Hook availible');
 end;

 procedure TForm1.Button_StopJourClick(Sender: TObject);
 begin
   FHookStarted := False;
   UnhookWindowsHookEx(JHook);
   JHook := 0;
 end;

 procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
   var Handled: Boolean);
 begin
   {the journal hook is automaticly camceled if the Task manager 
  (Ctrl-Alt-Del) or the Ctrl-Esc keys are pressed, you restart it 
  when the WM_CANCELJOURNAL is sent to the parent window, Application}
   Handled := False;
   if (Msg.message = WM_CANCELJOURNAL) and FHookStarted then
     JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, 0, 0);
 end;

 procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
 begin
   {make sure you unhook it if the app closes}
   if FHookStarted then
     UnhookWindowsHookEx(JHook);
 end;

 end.

...
Рейтинг: 0 / 0
Не работает хук на мышь.
    #39886889
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Tech N9ne
Раньше работало
А не должно было.

Глобальные хуки должны быть реализованы в dll. Это как минимум. Далее
MSDNSetWindowsHookEx can be used to inject a DLL into another process. A 32-bit DLL cannot be injected into a 64-bit process, and a 64-bit DLL cannot be injected into a 32-bit process. If an application requires the use of hooks in other processes, it is required that a 32-bit application call SetWindowsHookEx to inject a 32-bit DLL into 32-bit processes, and a 64-bit application call SetWindowsHookEx to inject a 64-bit DLL into 64-bit processes. The 32-bit and 64-bit DLLs must have different names.
...
Рейтинг: 0 / 0
Не работает хук на мышь.
    #39886897
Фотография garun
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Tech N9ne,

У меня тоже хук на мышь не работает в Rio
...
Рейтинг: 0 / 0
Не работает хук на мышь.
    #39886919
Фотография X-Cite
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
У меня работает...
Код: 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.
type
  TForm3 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    class var
      FHook: HHOOK;
  public
    class function JournalRecordProc(aCode: Integer; aWParam: WPARAM; aLParam: LPARAM): LRESULT stdcall; static;
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.FormCreate(Sender: TObject);
begin
  FHook := SetWindowsHookEx(WH_JOURNALRECORD, JournalRecordProc, HInstance, 0);
  if FHook = 0 then
    RaiseLastOSError();
end;

procedure TForm3.FormDestroy(Sender: TObject);
begin
  if not UnhookWindowsHookEx(FHook) then
    RaiseLastOSError();
end;

class function TForm3.JournalRecordProc(aCode: Integer; aWParam: WPARAM; aLParam: LPARAM): LRESULT;
begin
  Result := CallNextHookEx(FHook, aCode, aWParam, aLParam);
  if aCode <> HC_ACTION then
    Exit;

  var EventMsg := PEventMsg(aLParam)^;
  if (EventMsg.message = WM_LBUTTONUP) or
     (EventMsg.message = WM_LBUTTONDOWN) or
     (EventMsg.message = WM_RBUTTONDOWN) or
     (EventMsg.message = WM_RBUTTONUP) or
     (EventMsg.message = WM_MOUSEWHEEL) or
     (EventMsg.message = WM_MOUSEMOVE) then
    Form3.Memo1.Lines.Add(EventMsg.message.ToString());
end;

...
Рейтинг: 0 / 0
Не работает хук на мышь.
    #39886966
Фотография Tech N9ne
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
X-Cite
У меня работает...
Код: 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.
type
  TForm3 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    class var
      FHook: HHOOK;
  public
    class function JournalRecordProc(aCode: Integer; aWParam: WPARAM; aLParam: LPARAM): LRESULT stdcall; static;
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.FormCreate(Sender: TObject);
begin
  FHook := SetWindowsHookEx(WH_JOURNALRECORD, JournalRecordProc, HInstance, 0);
  if FHook = 0 then
    RaiseLastOSError();
end;

procedure TForm3.FormDestroy(Sender: TObject);
begin
  if not UnhookWindowsHookEx(FHook) then
    RaiseLastOSError();
end;

class function TForm3.JournalRecordProc(aCode: Integer; aWParam: WPARAM; aLParam: LPARAM): LRESULT;
begin
  Result := CallNextHookEx(FHook, aCode, aWParam, aLParam);
  if aCode <> HC_ACTION then
    Exit;

  var EventMsg := PEventMsg(aLParam)^;
  if (EventMsg.message = WM_LBUTTONUP) or
     (EventMsg.message = WM_LBUTTONDOWN) or
     (EventMsg.message = WM_RBUTTONDOWN) or
     (EventMsg.message = WM_RBUTTONUP) or
     (EventMsg.message = WM_MOUSEWHEEL) or
     (EventMsg.message = WM_MOUSEMOVE) then
    Form3.Memo1.Lines.Add(EventMsg.message.ToString());
end;


Попробовал Ваш код, выдает ошибку при запуске,
System error code 5
Отказано в доступе
,
при закрытии
System error code 1404, неверный дескриптор обработчика
...
Рейтинг: 0 / 0
Не работает хук на мышь.
    #39886974
Фотография X-Cite
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Tech N9ne
X-Cite
У меня работает...
Код: 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.
type
  TForm3 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    class var
      FHook: HHOOK;
  public
    class function JournalRecordProc(aCode: Integer; aWParam: WPARAM; aLParam: LPARAM): LRESULT stdcall; static;
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.FormCreate(Sender: TObject);
begin
  FHook := SetWindowsHookEx(WH_JOURNALRECORD, JournalRecordProc, HInstance, 0);
  if FHook = 0 then
    RaiseLastOSError();
end;

procedure TForm3.FormDestroy(Sender: TObject);
begin
  if not UnhookWindowsHookEx(FHook) then
    RaiseLastOSError();
end;

class function TForm3.JournalRecordProc(aCode: Integer; aWParam: WPARAM; aLParam: LPARAM): LRESULT;
begin
  Result := CallNextHookEx(FHook, aCode, aWParam, aLParam);
  if aCode <> HC_ACTION then
    Exit;

  var EventMsg := PEventMsg(aLParam)^;
  if (EventMsg.message = WM_LBUTTONUP) or
     (EventMsg.message = WM_LBUTTONDOWN) or
     (EventMsg.message = WM_RBUTTONDOWN) or
     (EventMsg.message = WM_RBUTTONUP) or
     (EventMsg.message = WM_MOUSEWHEEL) or
     (EventMsg.message = WM_MOUSEMOVE) then
    Form3.Memo1.Lines.Add(EventMsg.message.ToString());
end;


Попробовал Ваш код, выдает ошибку при запуске,
System error code 5
Отказано в доступе
,
при закрытии
System error code 1404, неверный дескриптор обработчика


Права администратора? У меня UAC отключен и по дефолту все приложения из под администратора
...
Рейтинг: 0 / 0
6 сообщений из 6, страница 1 из 1
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Не работает хук на мышь.
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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