Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

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


SPeller ©   (2005-04-24 18:15:00) 

Написал прожку, которая ставит глобальный хук на действия мыши. Всё работает, но периодически выскакивает ошибка от имени разных программ - "инструкция по адресу ХХХ обратилась к памяти по адресу 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;


SPeller   (2005-04-25 11:53:00) [1]

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


VMcL   (2005-04-25 11:19:00) [2]

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

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


SPeller   (2005-04-25 08:15:00) [3]

VMcL ©   (25.04.05 8:09) [5]
Ага.

Списабо, помогло. Кстати, этот stdcall взялся из статьи "Как правильно юзать хуки" с этого сайта...


VMcL   (2005-04-25 08:09:00) [4]

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

Ага.


SPeller   (2005-04-25 07:27:00) [5]

Не нужен stdcall?


VMcL   (2005-04-24 18:58:00) [6]

> procedure DLLEntryPoint(dwReason: DWord); stdcall;

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


SPeller   (2005-04-24 18:47:00) [7]

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


Eraser   (2005-04-24 18:42:00) [8]

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


Наверх

Титульная страница Поиск, карта сайта Написать письмо