не понятная ошиба в работе wh_SHELL
написал программу на примерах из интернета, которая ставит ловушку на wh_shell и следит за активацией окон.
с горем пополам добился работоспособности
НО, при закрытии окон программ выскакивает ошибка Visual Studio Run-Time Debuger и сообщает, что требуется этот дебагер, а его в системе нет. после нажатия ОК пропадает рабочий стол и панелька с "ПУСК", затем все появляется обратно (через пару секунд) и работа продолжается.
Чаще появляется ошибка обращения к памяти, а память не может быть read.
Именно при закрытии приложений...
код библиотеки:
Код:
library waluhook;
uses
SysUtils,
windows,
Forms,
messages;
{$R *.res}
const
MMFName: PChar = 'WinActMMF'; // имя объекта файлового отображения
{структура, поля которой будут отображены в файл подкачки}
type
PGlobalDLLData = ^TGlobalDLLData;
TGlobalDLLData = packed record
SysHook: HWND; // дескриптор установленной ловушки
MyAppWnd: HWND; // дескриптор нашего приложения
end;
var
GlobalData: PGlobalDLLData;
MMFHandle: THandle;
WM_MYWINACTHOOK: Cardinal;
{Hook-функция}
function ShellProc(code : integer; wParam : word; lParam : longint) : LRESULT; stdcall;
var
AppWnd: HWND; // дескриптор приложения, в котором произошло нажатие клавишы
begin
try
if code < 0 then
begin
Result:= CallNextHookEx(GlobalData^.SysHook, Code, wParam, lParam);
Exit;
end;
if Code=HSHELL_WINDOWACTIVATED then
begin
AppWnd:= GetForegroundWindow(); //Узнаем дискриптор активного окна
SendMessage(GlobalData^.MyAppWnd, WM_MYWINACTHOOK, wParam, AppWnd); //Посылаем его в прогу
end;
CallNextHookEx(GlobalData^.SysHook, Code, wParam, lParam);
finally
Result:= 0;
end;
end;
{Процедура установки HOOK-а}
procedure hook(switch : Boolean; hMainProg: HWND) export; stdcall;
begin
if switch=true then
begin
{Устанавливаю HOOK, если он не установлен (switch=true). }
GlobalData^.SysHook := SetWindowsHookEx(WH_SHELL, @ShellProc, HInstance, 0);
GlobalData^.MyAppWnd:= hMainProg;
if GlobalData^.SysHook <> 0 then
MessageBox(0, 'WinAct HOOK установлен !', 'Message from waluhook.dll', 0)
else
MessageBox(0, 'HOOK установить не удалось !', 'Message from waluhook.dll', 0);
end else begin
{Удаляю функцию-фильтр, если она установлена (т.е. switch=false). }
if UnhookWindowsHookEx(GlobalData^.SysHook) then
MessageBox(0, 'HOOK снят !', 'Message from waluhook.dll', 0)
else
MessageBox(0, 'HOOK снять не удалось !', 'Message from walihook.dll', 0);
end;
end;
procedure OpenGlobalData();
begin
{регестрируем свой тип сообщения в системе}
WM_MYWINACTHOOK:= RegisterWindowMessage('WM_MYWINACTHOOK');
{получаем объект файлового отображения}
MMFHandle:= CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(TGlobalDLLData), MMFName);
if MMFHandle = 0 then
begin
MessageBox(0, 'Can''t create FileMapping', 'Message from waluhook.dll', 0);
Exit;
end;
{отображаем глобальные данные на АП вызывающего процесса и получаем указатель
на начало выделенного пространства}
GlobalData:= MapViewOfFile(MMFHandle, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TGlobalDLLData));
if GlobalData = nil then
begin
CloseHandle(MMFHandle);
MessageBox(0, 'Can''t make MapViewOfFile', 'Message from waluhook.dll', 0);
Exit;
end;
end;
procedure CloseGlobalData();
begin
UnmapViewOfFile(GlobalData);
CloseHandle(MMFHandle);
end;
procedure DLLEntryPoint(dwReason: DWord); stdcall;
begin
case dwReason of
DLL_PROCESS_ATTACH: OpenGlobalData;
DLL_PROCESS_DETACH: CloseGlobalData;
end;
end;
{ Экспорт процедур установки и удаления hook'a }
exports Hook;
begin
{назначим поцедуру переменной DLLProc}
DLLProc:= @DLLEntryPoint;
{вызываем назначенную процедуру для отражения факта присоединения данной
библиотеки к процессу}
DLLEntryPoint(DLL_PROCESS_ATTACH);
end.
Помогите устранить эти ошибки. Может я должен обрабатывать уничтожение окон?
|