Не работает хук на мышь.

Tech N9ne
Дата: 08.11.2019 16:46:06
Добрый день, ребята, подскажите пожалуйста, почему не работает пример из delphi world ?
По идее в Listbox должен появляться соответствующий текст. Но нет никакой реакции..
Раньше работало.. Но это было на D7 и win7 x86. Может в этом проблема?
сейчас Windows 7 x64, delphi rio.
Заранее спасибо.
+
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.
_Vasilisk_
Дата: 08.11.2019 17:16:55
Tech N9ne
Раньше работало
А не должно было.

Глобальные хуки должны быть реализованы в dll. Это как минимум. Далее
MSDN
SetWindowsHookEx 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.
garun
Дата: 08.11.2019 17:32:43
Tech N9ne,

У меня тоже хук на мышь не работает в Rio
X-Cite
Дата: 08.11.2019 18:41:36
У меня работает...
+
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;
Tech N9ne
Дата: 08.11.2019 22:23:15
X-Cite
У меня работает...
+
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, неверный дескриптор обработчика
X-Cite
Дата: 08.11.2019 23:42:17
Tech N9ne
X-Cite
У меня работает...
+
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 отключен и по дефолту все приложения из под администратора