WH_SHELL Hook
От: Restlin  
Дата: 11.07.04 20:00
Оценка:
Здравствуйте, уважаемые коллеги.
Нижеприведенный код я использую для "отлова" запуска определенного приложения. Раньше (код скомпиленный на Delphi 5) все работало. Теперь компилю на Delphi 7 и при запуске любого приложения получаю "Access Violation Error. Память по адресу НЕКИЙ_АДРЕС (например 00ffea5648) обратилась по адресу ТОТ_ЖЕ_АДРЕС (00ffea5648). Память не может быть read. Может кто-нибудь растолкует мне в чем дело?
Спасибо.

Код следующий (извините что много):


library mydll;


uses
  SysUtils, Windows, Messages, Classes, Forms;

{$R *.RES}
const
  WM_HOOK   = WM_USER+123;
  MMFName   : PChar = 'MyMMF';

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

var
  GlobalData  : PGlobalDLLData;
  MMFHandle   : THandle;
  Wnd : HWND;

function  GetShellHook(HookCode,WndHandle,IsWndFullScrn : integer) : integer; stdcall;
begin
  if HookCode=HSHELL_WINDOWCREATED then begin
    Wnd:=FindWindow(nil,'frmMain');
    PostMessage(Wnd,WM_HOOK,WndHandle,IsWndFullScrn);
  end;
  Result := CallNextHookEx(GlobalData^.SysHook, HookCode, WndHandle, IsWndFullScrn);
end;

function SetHook: boolean; stdcall;
begin
  GlobalData^.SysHook := SetWindowsHookEx(WH_SHELL, @GetShellHook,HInstance, 0);
  Result := (GlobalData^.SysHook<>0);
end;

function RemoveHook: boolean; stdcall;
begin
  Result := UnhookWindowsHookEx(GlobalData^.SysHook);
end;


procedure OpenGlobalData();
begin
  MMFHandle:= CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(TGlobalDLLData), MMFName);
  if MMFHandle = 0 then
    MessageBox(0, 'Can''t create FileMapping', 'Message from Exampel2/Process1', 0);
  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 Exampel2/Process1', 0);
    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;

exports
  SetHook,
  RemoveHook;

begin
  DLLProc:= @DLLEntryPoint;
  DLLEntryPoint(DLL_PROCESS_ATTACH);
end.
Re: WH_SHELL Hook
От: Slicer [Mirkwood] Россия https://ru.linkedin.com/in/maksim-gumerov-039a701b
Дата: 11.07.04 21:41
Оценка:
Впредь, пожалуйста, пользуйтесь тегами оформления кода (см. "Коды форматирования" в нижней части окна ввода сообщения). Иначе читать неудобно.
Что до сути — индицируйте как-нибудь конец OpenGlobalData (меседжбоксом, например?). Показывается?
Если показывается, то закомментируйте в GetShellHook все, кроме result:=CallNextHookEx(...). По-прежнему валится?

Slicer
Специалист — это варвар, невежество которого не всесторонне :)
Re[2]: WH_SHELL Hook
От: Restlin  
Дата: 12.07.04 11:53
Оценка:
Здравствуйте, Slicer [Mirkwood], Вы писали:

SM>Впредь, пожалуйста, пользуйтесь тегами оформления кода (см. "Коды форматирования" в нижней части окна ввода сообщения). Иначе читать неудобно.

SM>Что до сути — индицируйте как-нибудь конец OpenGlobalData (меседжбоксом, например?). Показывается?
SM>Если показывается, то закомментируйте в GetShellHook все, кроме result:=CallNextHookEx(...). По-прежнему валится?

SM>Slicer


MessageBox поставил — показывается.
Закомментировал GetShellHook как Вы сказали.
Результат прежний
Re: WH_SHELL Hook
От: Restlin  
Дата: 12.07.04 17:02
Оценка:
Небольшое дополнение.
Ставлю аналогичным образом хуки на клавиатуру и мышь — все работает.
Проблема именно с WH_SHELL. Может быть есть какие-нибудь особенности использования?

Спасибо.
Re: WH_SHELL Hook Delphi 5 vs. Delphi 7
От: Restlin  
Дата: 12.07.04 18:51
Оценка:
Народ!
Не заморачивайтесь.
Откопал я Delphi 5 перекомпилил и все заработало.
Кстати размер dll стал 283К, а на Delphi 7 было 358К.
Может быть у кого-нибудь есть соображения по поводу того почему 7-ая Делфа так себя ведет?
Кстати Delphi 7 — лицензионный.
Удачи всем!
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.