Форум: "WinAPI";
Текущий архив: 2005.06.14;
Скачать: [xml.tar.bz2];

Вниз

Глобальный мышиный хук. Помогите ошибку найти   Найти похожие ветки 

← →
SPeller ©   (2005-04-24 18:15) [0]

Написал прожку, которая ставит глобальный хук на действия мыши. Всё работает, но периодически выскакивает ошибка от имени разных программ - "инструкция по адресу ХХХ обратилась к памяти по адресу YYY. Память не может быть read". Закономерности я не нашел - ошибки случайны, но чаще происходят при завершении программы. Программы при этом продолжают работать нормально дальше. Помогите определить, в чем проблема. Вроде все делал по инструкции.

Код DLL:

library wndinfohk;

uses
 Windows,
 Messages;

const
 MMFName: PChar = "WndInfo_HookData";
 HM_HOOK = WM_USER + 1000;

type
 PGlobalDLLData = ^TGlobalDLLData;
 TGlobalDLLData = packed record
   SysHook: HHOOK;
   Callback: HWND;
 end;

 TFreeMem = function(P: Pointer): Integer;

var
 GlobalData: PGlobalDLLData = nil;
 MMFHandle: THandle = 0;

function SysMsgProc(code, wParam, lParam: LongInt): longint; stdcall;
var
 MH, Buf: PMouseHookStruct;
 Pt: TSmallPoint;
begin
 if (code >= 0) then begin
   MH := Pointer(lParam);
   if (wParam >= WM_MOUSEFIRST) and (wParam <= WM_MOUSELAST) then begin
     Pt.x := MH.pt.X;
     Pt.y := MH.pt.Y;
     PostMessage(GlobalData.Callback, HM_HOOK, wParam, Integer(Pt));
   end;
 end;
 Result := CallNextHookEx(GlobalData.SysHook, Code, wParam, lParam);
end;

procedure OpenGlobalData();
begin
 MMFHandle:= CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(TGlobalDLLData), MMFName);

 if MMFHandle = 0 then
   Exit;

 GlobalData := MapViewOfFile(MMFHandle, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TGlobalDLLData));
 if GlobalData = nil then begin
   CloseHandle(MMFHandle);
   MMFHandle := 0;
 end;
end;

procedure CloseGlobalData();
begin
 if (GlobalData <> nil) then
   UnmapViewOfFile(GlobalData);
 if (MMFHandle <> 0) then
   CloseHandle(MMFHandle);
end;

function hook(switch : Boolean; hWnd: HWND): Boolean; export; stdcall;
begin
 if (GlobalData = nil) or (MMFHandle = 0) then begin
   Result := False;
   Exit;
 end;
 if switch then begin
   GlobalData.Callback := hWnd;
   GlobalData^.SysHook := SetWindowsHookEx(WH_MOUSE, @SysMsgProc, HInstance, 0);
   Result := (GlobalData.SysHook <> 0);
 end
 else begin
   Result := UnhookWindowsHookEx(GlobalData.SysHook);
 end;
end;

procedure DLLEntryPoint(dwReason: DWord); stdcall;
begin
case dwReason of
  DLL_PROCESS_ATTACH: OpenGlobalData;
  DLL_PROCESS_DETACH: CloseGlobalData;
end;
end;

exports hook name "SwitchHook";

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


Использую так:
(так как использован KOL, откомментирую неизвестные участки)

function SwitchHook(State: Boolean; Callback: HWND): Boolean; stdcall; external "wndinfohk.dll";

procedure TForm1.KOLFormFormCreate(Sender: PObj);
begin
 ...
 SwitchHook(True, Form.Handle);
 Active := False;
 SetWindowPos(Form.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
end;

// Обработчик сообщений, приходящих форме. Rslt - результат обработки, Result=True для перехвата сообщения (не пускать его на дальнейшую обработку)
function TForm1.KOLFormMessage(var Msg: tagMSG; var Rslt: Integer): Boolean;
var
 HKMsg: Cardinal;
 Pt2: TSmallPoint;
 Pt: TPoint;
 Wnd: HWND;
 Buf: array[0..511] of Char;
begin
 Result := False;
 case Msg.message of
   HM_HOOK:
   if (Msg.wParam >= WM_MOUSEFIRST) and (Msg.wParam <= WM_MOUSELAST) then begin
     if (Msg.wParam = WM_MBUTTONUP) then
       Active := not Active;
     if Active then begin
       Integer(Pt2) := Msg.lParam;
       Pt.X := Pt2.x;
       Pt.Y := Pt2.y;
       Wnd := WindowFromPoint(Pt);
       edHandle.Text := Int2Str(Wnd) + " (0x" + Int2Hex(Wnd, 8) + ")";
       edHandle.Tag := Wnd;
       GetClassName(Wnd, @Buf[0], 512);
       edClass.Text := Buf;
       GetWindowText(Wnd, @Buf[0], 512);
       edCaption.Text := Buf;
     end;
   end;
 end;
end;

procedure TForm1.KOLFormDestroy(Sender: PObj);
begin
 SwitchHook(False, 0);
end;


---

← →
Eraser ©   (2005-04-24 18:42) [1]

В курсе, что означает stdcall?

---

← →
SPeller ©   (2005-04-24 18:47) [2]

Ты это к чему вообще?

---

← →
VMcL ©   (2005-04-24 18:58) [3]

>procedure DLLEntryPoint(dwReason: DWord); stdcall;

Это неправильно.

---

← →
SPeller ©   (2005-04-25 07:27) [4]

Не нужен stdcall?

---

← →
VMcL ©   (2005-04-25 08:09) [5]

>>SPeller ©   (25.04.05 07:27) [4]

Ага.

---

← →
SPeller ©   (2005-04-25 08:15) [6]

VMcL ©   (25.04.05 8:09) [5]
Ага.
Списабо, помогло. Кстати, этот stdcall взялся из статьи "Как правильно юзать хуки" с этого сайта...

---

← →
VMcL ©   (2005-04-25 11:19) [7]

>>SPeller ©   (25.04.05 08:15) [6]

Значит, там ошибка. Delphi Help рульнее.

---

← →
SPeller ©   (2005-04-25 11:53) [8]

Я просто этот DLLEntryPoint не использовал, вот и не знал что там ошибка, и справку по этому поводу не читал.

---

Страницы: 1 вся ветка

Форум: "WinAPI";
Текущий архив: 2005.06.14;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.03 c