Где ошибка при завершении Hook и как занести данные в TPoint?

← →
Dr. Andrew (2003-06-07 13:30) [0]

В данном примере если отпустить левую кнопку мыши вне формы и попытаться закрыть форму "виснет" даже сама Делфи 7.
Задача такова - перемещая левую кнопку мыши по экрану, даже за пределы формы (левая кнопка мыши в нажатом состоянии, экранные координаты зафиксировать при отпускании левой кнопки мыши в некой глобальной переменной APoint типа TPoint (эти значения затем будут обрабатываться другими процедурами моей программы) и остановить процесс, т.е. корректно ликвидировать как можно быстрее Hook и все что с ним связано!
Вопрос - где ошибка в алгоритме при завершении Hook и как изменить приведенный алгоритм к решению задачи с применением глобальной переменной APoint типа TPoint, как привязать влючение/выключение Hook (и всех связанных с ним процессов!), например к кнопке ToolButton(Down:= true; Down:= false)?

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ExtCtrls;

type
TForm1 = class(TForm)
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
APoint: TPoint;

implementation

{$R *.dfm}

var
HookHandle: hHook;

function HookProc(Code: integer; WParam: word; LParam: Longint): Longint; stdcall;
var
msg: PEVENTMSG;
key: integer;
begin
if Code >= 0 then begin
result := 0;
msg := Pointer(LParam);
with Form1 do
case msg.message of
WM_MOUSEMOVE: Caption := IntToStr(msg.ParamL) + #32 + IntToStr(msg.ParamH);
WM_LBUTTONDOWN: CheckBox1.Checked := true;
WM_LBUTTONUP: CheckBox1.Checked := false;
WM_RBUTTONDOWN: CheckBox2.Checked := true;
WM_RBUTTONUP: CheckBox2.Checked := false;
WM_KEYUP: CheckBox3.Checked := false;
WM_KEYDOWN: begin
CheckBox3.Checked := true;
key := msg.paramL and 255;
if key in [48..57, 65..90]
then Edit1.Text := Edit1.Text + chr(key);
end;
end;
end else
result := CallNextHookEx(HookHandle, code, WParam, LParam);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.FormStyle := fsStayOnTop;
CheckBox1.Enabled := false;
CheckBox1.Caption := "left button";
CheckBox2.Enabled := false;
CheckBox2.Caption := "right button";
CheckBox3.Enabled := false;
CheckBox3.Caption := "keyboard";
HookHandle := SetWindowsHookEx(WH_JOURNALRECORD, @HookProc, HInstance, 0);
Edit1.Text := "";
Edit1.Enabled := false;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if HookHandle > 0 then
UnhookWindowsHookEx(HookHandle);
end;

← →
Song (2003-06-07 14:21) [1]

Общесистемный хук должен быть в dll.

← →
Dr. Andrew (2003-06-07 14:52) [2]

А как практически это реализовать? Можете выложить пример?

← →
Song (2003-06-07 15:00) [3]

Вверху есть раздел "Статьи". Там есть статья "Хуки. Аспекты реализации". Вот её прочитай, к ней есть примеры.

← →
Dr. Andrew (2003-06-07 16:28) [4]

Song
Примеры приведенной статьи в Делфи 7 не работают. Все время выпадает ошибка "Ошибка загрузки DLL"!

Мастерам-профессионалам!
Может все таки найдется мастер, который сможет мне помочь без ссылок в конкретной задаче и конкретным алгоритмом!!!

← →
Song (2003-06-07 16:58) [5]

А ты ничего не менял? Всё так как в статье?
Проверь на какой строчке ошибка выдаётся.
К слову говоря хука нас###ть какая у тебя Дельфи.

← →
Yanis (2003-06-07 17:15) [6]

To Dr. Andrew © (07.06.03 13:30)
До боли знакомый код, где то я его видел!!!

← →
Юрий Зотов (2003-06-07 17:26) [7]

> Dr. Andrew © (07.06.03 16:28)

> Примеры приведенной статьи в Делфи 7 не работают. Все время
> выпадает ошибка "Ошибка загрузки DLL"!

Эти примеры проверялись уже очень многими и до сих пор работали. Вероятно, дело все же не в них.

Ладно, вот пример решения Вашей задачи (DLL и приложение). Если и он не заработает - увы, тогда помочь Вам смогут только книги.

============== DLL ===================

library MouseHookDLL;

uses
Windows, Messages;

const
MapID = "Global Mouse 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 MouseHookProc(Code: Integer; Msg: WPARAM; PInfo: LPARAM): LRESULT; stdcall;
begin
if Msg = WM_LBUTTONUP then
with PMouseHookStruct(PInfo)^ do
SendMessage(Data^.AppWnd, WM_USER + 100, Pt.X, Pt.Y);
Result := CallNextHookEx(Data^.OldHook, Code, Msg, PInfo)
end;

function SetMouseHook(Wnd: HWND): BOOL; stdcall;
begin
if Data <> nil then
begin
Data^.AppWnd := Wnd;
Data^.OldHook := SetWindowsHookEx(WH_MOUSE, @MouseHookProc, HInstance, 0);
Result := Data^.OldHook <> 0
end
else Result := False
end;

function RemoveMouseHook: BOOL; stdcall;
begin
Result := UnhookWindowsHookEx(Data^.OldHook)
end;

exports
SetMouseHook,
RemoveMouseHook;

begin
if DLLProc = nil then DLLProc := @DLLEntryPoint;
DLLEntryPoint(DLL_PROCESS_ATTACH)
end.

=========== Приложение (DPR стандартный) ===============

unit MouseHookAppUnit;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, Forms;

type
TAppMainForm = class(TForm)
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
procedure WMUser100(var Message: TMessage); message WM_USER + 100;
protected
procedure CreateWnd; override;
end;

var
AppMainForm: TAppMainForm;

implementation

{$R *.DFM}

const
DLLName = "MouseHookDLL.dll";

function SetMouseHook(Wnd: HWND): BOOL; stdcall; external DLLName name "SetMouseHook";
function RemoveMouseHook: BOOL; stdcall; external DLLName name "RemoveMouseHook";

{ TAppMainForm }

procedure TAppMainForm.WMUser100(var Message: TMessage);
begin
with Message do Caption := Format("X = %d, Y = %d", [WParam, LParam])
end;

procedure TAppMainForm.CreateWnd;
begin
inherited;
if not SetMouseHook(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 RemoveMouseHook then
MessageBox(Handle, "Unable to remove hook", PChar(Application.Title), MB_OK or MB_ICONHAND)
end;

end.

← →
Dr. Andrew (2003-06-07 18:27) [8]

Юрий Зотов
На строке:
if DLLProc = nil then DLLProc := @DLLEntryPoint;
при выполнении команды Project | Build выпадает сообщение об ошибке:
[Error] MouseHookDLL.dpr(75): Not enough actual parameters

Что я делаю не так? Или ошибка в коде?
А как соотнести координаты с глобальной переменной TPoint в главном проекте.

← →
Palladin (2003-06-07 18:49) [9]

if @DLLProc = nil then DLLProc := @DLLEntryPoint;

← →
Dr. Andrew (2003-06-07 19:16) [10]

Юрий Зотов. Palladin.
Спасибо за помощь!!!
Все примеры в основе привязаны к форме, а Вы могли бы привести пример привязки отключения\включения Hook от, например кнопочного компонента?
Пример заработал, но вот эта проблема мне не дает возможности сдвинуться с мертвой точки.
И еще вопрос - сейчас считывание координат присходит при MouseUp, а как прописать, чтобы при включении Hook происходило считывание экранных координат при MouseMove, а при отпускании кнопки мыши данные фиксировались в переменной TPoint?

← →
Dr. Andrew (2003-06-07 19:28) [11]

Как можно изменить процедуру:

function MouseHookProc(Code: Integer; Msg: WPARAM; PInfo: LPARAM): LRESULT; stdcall;
begin
if Msg = WM_LBUTTONUP then
with PMouseHookStruct(PInfo)^ do
SendMessage(Data^.AppWnd, WM_USER + 100, Pt.X, Pt.Y);
Result := CallNextHookEx(Data^.OldHook, Code, Msg, PInfo)
end;

чтобы при включении Hook происходило постоянное считывание экранных координат при MouseMove, а при отпускании кнопки мыши считывание прерывалось, Hook уничтожался и данные фиксировались в переменной TPoint?

Где ошибка при завершении Hook и как занести данные в TPoint? Найти похожие ветки