[reqyz]

Добрый день уважаемые форумчане и форумчанки.
Пишу безоконную апи программу, которая должна запоминать выкрутасы мышки(движения в основном) сохранять их в файл, что бы потом другая программа могла их воспроизводить. если интересно зачем нужно, расскажу, но не в этом суть.

События мышки ловлю довольно просто, обычным хуком "WH_Mouse_LL", тут всё понятно. позже могу привести код.
В оконном не апи приложении всё было легко и для примера все выкрутасы записывались в мемо. проблема оказалась в следующем...

если программа делает ещё что либо кроме хуков, то каждый раз она ожидает все остальные задачи, а только потом работает с мышью, в итоге пока она выполняет остальные задачи, мышь не шевелится,

решением я считал создание дополнительного потока, но был не прав

дополнительный поток включает хук и завершается, а после завершения потока хук естественно не пашет. если в конце потока поставить бесконечный слип, то хук ждет окончания слипа и до тех пор держит мышь застывшей, ну то есть то же самое что и в предыдущий раз,

вывод: я дурак, понятное дело что нужен второй поток, но не понятно как сделать так же как делает это оконное приложение, чтобы программа или поток не завершался выполнив все, а просто ждал с моря погоды,

помогите с этим или подскажите другое решение, но естественно хук должен быть

[NumLock]

завершай вызов LowLevelMouseProc callback function как можно быстрее

[Alegun]

Сообщение от reqyz

...если программа делает ещё что либо кроме хуков, то каждый раз она ожидает все остальные задачи, а только потом работает с мышью, в итоге пока она выполняет остальные задачи, мышь не шевелится...

Как не пытался засадить "обычного" мышиного перехватчика, в смысле типа

Код:

var
MouseHook: HHOOK;

function LowLevelMouseProc(nCode: Integer;
     WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
var
 s: string;
begin
 Result:= CallNextHookEx(MouseHook, nCode, WParam, LParam);
 case WParam of
   WM_LBUTTONDOWN:   s:= 'LBUTTONDOWN';
   WM_LBUTTONUP:     s:= 'LBUTTONUP';
   WM_LBUTTONDBLCLK: s:= 'LBUTTONDBLCLK';
   WM_RBUTTONDOWN:   s:= 'RBUTTONDOWN';
   WM_RBUTTONUP:     s:='RBUTTONUP';
   WM_RBUTTONDBLCLK: s:= 'RBUTTONDBLCLK';
   WM_MBUTTONDOWN:   s:= 'MBUTTONDOWN';
   WM_MBUTTONUP:     s:= 'MBUTTONUP';
   WM_MBUTTONDBLCLK: s:= 'MBUTTONDBLCLK';
   WM_MOUSEMOVE:     s:= 'MOUSEMOVE';
   WM_MOUSEWHEEL:    s:= 'MOUSEWHEEL';
 end;
 Form1.Memo1.Lines.Add(s + ': ' +
 IntToStr(Mouse.CursorPos.X) + 'X' +
 IntToStr(Mouse.CursorPos.Y));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
MouseHook:= SetWindowsHookEx(WH_MOUSE_LL {14}, @LowLevelMouseProc, HInstance, 0);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin
UnhookWindowsHookEx(MouseHook);
end;

всякой разной программной ерундой, но так этого и не удалось сделать, работает как швецарские ходики, без нареканий

[NumLock]

Сообщение от Alegun

но так этого и не удалось сделать

добавь

Код:

Sleep(250);

после вывода в Memo и будет эффект ТС

[Alegun]

Действительно, появились пропуски, не успевает "выхлоп" ловушки отработать, но возник вопрос - а зачем в этой процедуре что-то тяжёлое выполнять, она ведь для этого не предназначена, чисто вывод, в крайнем случае флажок какойнить изменить или метку подправить, в смысле кесарю кесарево

[poli-smen]

Сообщение от Alegun

Действительно, появились пропуски, не успевает "выхлоп" ловушки отработать, но возник вопрос - а зачем в этой процедуре что-то тяжёлое выполнять, она ведь для этого не предназначена, чисто вывод, в крайнем случае флажок какойнить изменить или метку подправить, в смысле кесарю кесарево

Возможно у ТС идёт вывод на медлительное устройство (например на сетевой диск) или слишком много подготовительных операций. Чтобы побыстрее выйти из низкоуровнего callback лучше в нём реализовать например через PostMessage, а в оконной процедуре уже можно обработать результаты в более спокойной обстановке.

[reqyz]

В итоге что мне делать? без окон не обойтись получается?

[NumLock]

создай очередь обработки, куда бы LowLevelMouseProc добавляла, а дочерний поток из нее обрабатывал. хотя трудно представить что должна быть за обработка действий мыши, чтобы занимала столь длительное время.
можно и без окна. только как программу закрывать будешь?)

[reqyz]

Код:

program HookApi;

USES
  WINDOWS;
  
type
  WPARAM = Longint;
  LPARAM = Longint;
  LRESULT = Longint;  
  DWORD = LongWord; 
  PDWORD = ^DWORD;     
  HHOOK = type LongWord; 
  HWND = type LongWord;   
  UINT = LongWord;    
  BOOL = LongBool;

  TPoint = packed record
    X: Longint;
    Y: Longint;
  end;

  PMouseHookStruct = ^tagMOUSEHOOKSTRUCT;
  tagMOUSEHOOKSTRUCT = packed record
    pt: TPoint;
    hwnd: HWND;
    wHitTestCode: UINT;
    dwExtraInfo: DWORD;
  end;

  PSecurityAttributes = ^_SECURITY_ATTRIBUTES;
  _SECURITY_ATTRIBUTES = record
    nLength: DWORD;
    lpSecurityDescriptor: Pointer;
    bInheritHandle: BOOL;
  end;

  TFNHookProc = function (code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT stdcall;

const         
  HC_ACTION = 0;  
  user32    = 'user32.dll';
  kernel32  = 'kernel32.dll';
  GENERIC_WRITE            = $40000000; 
  OPEN_ALWAYS = 4;


function CallNextHookEx(hhk: HHOOK; nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
  stdcall; external user32 name 'CallNextHookEx';
function SetWindowsHookEx(idHook: Integer; lpfn: TFNHookProc; hmod: HINST; dwThreadId: DWORD): HHOOK;
  stdcall; external user32 name 'SetWindowsHookExA';
function UnhookWindowsHookEx(hhk: HHOOK): BOOL;
  stdcall; external user32 name 'UnhookWindowsHookEx';
function GetModuleFileName(hModule: HINST; lpFilename: PChar; nSize: DWORD): DWORD;
  stdcall; external kernel32 name 'GetModuleFileNameA';
function CreateFile(lpFileName: PChar; dwDesiredAccess, dwShareMode: DWORD; lpSecurityAttributes: PSecurityAttributes;
  dwCreationDisposition, dwFlagsAndAttributes: DWORD; hTemplateFile: THandle): THandle;
  stdcall; external kernel32 name 'CreateFileA';
function CreateThread(lpThreadAttributes: Pointer;
  dwStackSize: DWORD; lpStartAddress: Pointer; lpParameter: Pointer;
  dwCreationFlags: DWORD; var lpThreadId: DWORD): THandle;
  stdcall; external kernel32 name 'CreateThread';
procedure Sleep(milliseconds: Cardinal);
  stdcall; external kernel32 name 'Sleep';

function IntToStr(const Value: Int64): String;overload;
begin
  Str(Value, Result);
end;

var
  hHookMouse:THandle;


function LowLevelMouseProc(nCode: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT stdcall;
var
  Mouse:PMouseHookStruct;
begin
  if nCode = HC_ACTION then
    Result := CallNextHookEx(hHookMouse, nCode, WParam, LParam);
  Mouse:=PMouseHookStruct(LParam);
  if(Wparam=512)then
  begin
    //записываем
  end;
end;


var
  LogFileName: array[0..264]of Char;
  HFile:THandle;
  id:THandle;
  s:integer;
const
  WH_Mouse_LL = 14;
begin
  hHookMouse := SetWindowsHookEx(WH_Mouse_LL, LowLevelMouseProc, hInstance, 0);
  sleep(cardinal(-1));
end.

если поможите решить эту праблу, то с остальным разберусь. если ставить слип, как я и говорил, ждет окончания слипа и мышь застыла, если ничего не ставить, то выходит из программы,
вопрос: что делать?

оконные приложения же умеют не выходить из программы ничего не делая и при этом они точно не используют слип, а может как то иначе можно?

задача была решена следующим образом: после регистрации хука добавлена строчка

Код:

  while GetMessage (Msg, 0, 0, 0) do
  begin
  endl;

в итоге зависания нет, из потока так тоже не выйдет и всё записывается быстро и чётко) всем спасибо, но если знаете другое решение, отпишитесь)

новая не смертельная, но неприятная прабла, на компе моём Авира стоит, и ругается когда компилю приложение с доп потоком. Кто нибудь сталкивался? знает как обойти? делаю так..

Код:

program HookApi;

USES
  windows...
  
function LowLevelMouseProc(nCode: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT stdcall;
var
  Mouse:PMouseHookStruct;
begin
  if nCode = HC_ACTION then
    Result := CallNextHookEx(hHookMouse, nCode, WParam, LParam);
  Mouse:=PMouseHookStruct(LParam);
  if(Wparam=512)then
  begin
    ...

    ...
  end;
end;

procedure GoHook({Param:Pointer}); stdcall;
const
  WH_Mouse_LL = 14;
var
  Msg: TagMsg;
begin
  hHookMouse := SetWindowsHookEx(WH_Mouse_LL, LowLevelMouseProc, hInstance, 0);
  while GetMessage(Msg, 0, 0, 0) do
  begin
  end;
end;

begin
  CreateThread(nil,0,@GoHook,nil,0,id);
  ...
  //делает свои остальные дела
  ...
end.

авира матюгаться начинает, а если поток один, то молчит. Что ей не нравится? и как обойти?

[NumLock]

Сообщение от reqyz

после регистрации хука добавлена строчка

до этого у тебя message loop вообще небыло что-ли? не рано ли на non-VCL перешел тогда?

вот классика:

Код:

var
  AMsg: TMsg;

  while GetMessage(AMsg, 0, 0, 0) do
  begin
    TranslateMessage(AMsg);
    DispatchMessage(AMsg);
  end;

и как все-таки программу закрывать будешь?

[reqyz]

Сообщение от NumLock

до этого у тебя message loop вообще небыло что-ли? не рано ли на non-VCL перешел тогда?

вот классика:

Код:

var
  AMsg: TMsg;

  while GetMessage(AMsg, 0, 0, 0) do
  begin
    TranslateMessage(AMsg);
    DispatchMessage(AMsg);
  end;

и как все-таки программу закрывать будешь?

в

Код:

    TranslateMessage(AMsg);
    DispatchMessage(AMsg);

нет пока смысла, так как нет пока окон)
месадж луп не было, так как без окон нет и сообщений, над завершением программы пока не думал, но придумаю. горячие клавиши например, или хук определенной клавиши "Esc" например, тут ничего сложного не будет в принципе, сейчас с авирой праблы, но попытаюсь поменять функционал основного потока и хукного, может не будет тогда ворчать)
а GetMessage в данном случае, как удачная альтернатива слипу, которая и из потока выйти не даст и работать потоку не мешает)

[NumLock]

Сообщение от reqyz

без окон нет и сообщений

отсутствие окон не означает отсутствие сообщений потоку:

Код:

program Project1;

uses
  Windows, Messages, SysUtils;

var
  hMouseHook: HHOOK;
  AMsg: TMsg;

const
  WH_MOUSE_LL = 14;

function LowLevelMouseProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  Result:=CallNextHookEx(hMouseHook, nCode, wParam, lParam);
  if (PMouseHookStruct(lParam)^.pt.X<5) and (PMouseHookStruct(lParam)^.pt.Y<5) then
    PostQuitMessage(0);  
end;

begin
  hMouseHook:=SetWindowsHookEx(WH_MOUSE_LL, @LowLevelMouseProc, HInstance, 0);
  while GetMessage(AMsg, 0, 0, 0) do
  begin
    TranslateMessage(AMsg);
    DispatchMessage(AMsg);
  end;
  UnhookWindowsHookEx(hMouseHook);
  Windows.Beep(1000, 500);
end.

программа корректно завершается при перемещении курсора в верхний левый угол экрана.

[reqyz]

Да, запустил ваш пример, вы правы, видимо я немного неверно интерпретировал работу функции GetMessage

c авирой разобрался, тему можно закрывать)