Ошибка при работе с хуками (WH_CALLWNDPROCRET)

[Sibedir]

Периодически (несколько раз (раза 3 пока)) при работе с хуками вылазила фатальная ошибка. При этом 'вылетают' работающее приложение, сама делфя, и перезапускается Explorer. И вот, только сейчас заметил, антивирусник тоже 'вылетел' и не запустился (как Opera и Winamp).

Вот сообщения, которые при этом вылезли:

Сообщение от explorer.exe - Ошибка приложения

Инструкция по адресу "0x03877642" обратилась к памяти по адресу "0x043b8508". Память не может быть "read".
"ОК" -- завершение приложения
"Отмена" -- отладка приложения

Сообщение от Error

Runtime error 216 at 03877642

Сообщение от explorer.exe - Ошибка приложения

Исключение неисвестное программное исключение (0xc0000409) в приложении по адресу 0x7e37e374

В отладчик я не полез, ибо понятия не имею чего там искать.

------------------------------------------------

Антивирус запустил. Убрал из проекта всё лишнее. Запуслил

Сообщение от explorer.exe - Ошибка приложения

Инструкция по адресу "0x00000000" обратилась к памяти по адресу "0x00000000". Память не может быть "read"."ОК" -- завершение приложения
"Отмена" -- отладка приложения

Опять всё повылетало.
Теперь это стало уже постоянно. Вспомнить с какого момента началось так и не смог.

------------------------------------------------

Перезагрузился. Запустил через EXE

Сообщение от explorer.exe - Ошибка приложения

Инструкция по адресу "0x00000000" обратилась к памяти по адресу "0x00000000". Память не может быть "read"."ОК" -- завершение приложения
"Отмена" -- отладка приложения

Опять всё повылетало. Explorer не перезапустился.

------------------------------------------------

Вышел из системы, зашел снова (без перезагрузки). "HookLibrary.dll" (моя библиотека) не удаляется.

Сообщение от Ошибка при удалении файла или папки

Не удается удалить HookLibrary. Нет доступа.

Диск может быть переполнен или защищен от записи,
либо файл занят другим приложением.

Через ProcessExplorer узнал, что "HookLibrary.dll" занят антивирусником :O

------------------------------------------------

Перезагрузился. Отключил антивирус. Запустил через EXE. Опять ... бла-бла-бла

------------------------------------------------

Включил антивирус. Залез в исходники. Добавил в библиотеку и приложение System.ShareMem. Опять ... бла-бла-бла.
Отключил антивирус. ... бла-бла-бла.
И главное ОНО с exe-шника работает. Ошибка есть. Всё вылетает, а ОНО работает.

------------------------------------------------

Короче, сами всё видите. Я багажник открыл, колёса попинал, фары протёр. Чё дальше делать?

------------------------------------------------

Delphi XE5
Windows XP SP3
ESET Smart Security 8
Исходник во вложении

[Sibedir]

Общий модуль для DLL и EXE

unit HookUnit;

interface

uses
  Winapi.Windows;

type
  PCallWndRetProc_Proc = ^TCallWndRetProc_Proc;
  TCallWndRetProc_Proc = procedure (Msg: PCWPRetStruct; var Handled: Boolean);

implementation

end.

DLL

library HookLibrary;

uses
  System.ShareMem,
  System.SysUtils,
  Winapi.Windows,
  HookUnit in 'HookUnit.pas';

var
  CallWndRetProc_Hook: HHook = 0;
  CallWndRetProc_Proc: TCallWndRetProc_Proc = nil;

{$R *.res}

function FilterFunc_CallWndRetProc (code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT; stdcall;
var
  msg: PCWPRetStruct;
  Handled: Boolean;
begin
  if Code <> HC_ACTION then begin
    Result := CallNextHookEx (CallWndRetProc_Hook, Code, wParam, lparam);
  end
  else begin
    Result := 0;
    msg := PCWPRetStruct(lParam);
    Handled := False;
    try
      CallWndRetProc_Proc (msg, Handled);
    finally
      if not Handled then
        Result := CallNextHookEx (CallWndRetProc_Hook, Code, wParam, lparam);
    end;
  end;
end;

function SetHook_CallWndRetProc (AHandler: TCallWndRetProc_Proc): DWORD;
begin
  if Assigned(AHandler) then begin
    CallWndRetProc_Proc := AHandler;
    if CallWndRetProc_Hook = 0 then begin
      CallWndRetProc_Hook := SetWindowsHookEx (WH_CALLWNDPROCRET, @FilterFunc_CallWndRetProc, HInstance, 0);
      if CallWndRetProc_Hook <> 0 then
        Exit(GetLastError);
    end;
  end
  else begin
    if CallWndRetProc_Hook <> 0 then begin
      if not UnhookWindowsHookEx (CallWndRetProc_Hook) then
        Exit(GetLastError);
      CallWndRetProc_Hook := 0;
      CallWndRetProc_Proc := nil;
    end;
  end;
  Result := 0;
end;

function UnHook_CallWndRetProc: DWORD;
begin
  Result := SetHook_CallWndRetProc(nil);
end;

exports SetHook_CallWndRetProc;
exports  UnHook_CallWndRetProc;

begin

end.

Главное окно

unit MainForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.StdCtrls,
  HookUnit;

type
  TfrmMain = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

function SetHook_CallWndRetProc (AHandler: TCallWndRetProc_Proc): DWORD; external 'HookLibrary.dll' name 'SetHook_CallWndRetProc';
function UnHook_CallWndRetProc: DWORD; external 'HookLibrary.dll' name 'UnHook_CallWndRetProc';

procedure CallWndRetProc_Proc (Msg: PCWPRetStruct; var Handled: Boolean);

var
  frmMain: TfrmMain;

implementation

uses
  Unit1;

procedure CallWndRetProc_Proc (Msg: PCWPRetStruct; var Handled: Boolean);
//var
//  WC: TWinControl;
begin
//  WC := FindControl (Msg.hwnd);
//  if WC is TForm then
//    with (WC as TForm) do begin
//      if Msg.message = WM_CREATE then begin
//        Color := clRed;
//      end;
//    end;
end;

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  SetHook_CallWndRetProc (CallWndRetProc_Proc);
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  UnHook_CallWndRetProc;
end;

procedure TfrmMain.Button1Click(Sender: TObject);
begin
  Application.CreateForm(TForm1, Form1);
  Form1.ShowModal;
  FreeAndNil (Form1);
end;

end.

Ну, а остальное во вложении #1.

[Sibedir]

Ну вот теперь я точно в полном ступоре.
Windows 7
Delphi XE8

DLL

library HookLibrary;

uses
  System.ShareMem,
  System.SysUtils,
  Winapi.Windows;

var
  CallWndRetProc_Hook: HHook = 0;

{$R *.res}

function FilterFunc_CallWndRetProc (code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT; stdcall;
begin
  Result := CallNextHookEx (CallWndRetProc_Hook, Code, wParam, lparam);
end;

function SetHook_CallWndRetProc: DWORD;
begin
  if CallWndRetProc_Hook = 0 then begin
    CallWndRetProc_Hook := SetWindowsHookEx (WH_CALLWNDPROCRET, @FilterFunc_CallWndRetProc, HInstance, 0);
    if CallWndRetProc_Hook <> 0 then
      Exit(GetLastError);
  end;
  Result := 0;
end;

function UnHook_CallWndRetProc: DWORD;
begin
  if CallWndRetProc_Hook <> 0 then begin
    if not UnhookWindowsHookEx (CallWndRetProc_Hook) then
      Exit(GetLastError);
    CallWndRetProc_Hook := 0;
  end;
  Result := 0;
end;

exports SetHook_CallWndRetProc;
exports  UnHook_CallWndRetProc;

begin

end.

Главное окно
(остальное вырезал)

unit MainForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.StdCtrls;

type
  TfrmMain = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

function SetHook_CallWndRetProc: DWORD; external 'HookLibrary.dll' name 'SetHook_CallWndRetProc';
function UnHook_CallWndRetProc: DWORD; external 'HookLibrary.dll' name 'UnHook_CallWndRetProc';

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  SetHook_CallWndRetProc;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  UnHook_CallWndRetProc;
end;

end.

При закрытии формы
Безымянный.jpg
Хвала небесам, еще делфя и антивирусником (Eset SS 9) не вылетают. Тока explorer перезапускается. Но этож не дело.

[Человек_Борща]

В фильтре вы не обрабатываете должным образом то, что вам приходит.
Читайте про return value на MSDN.

Result:=0;
if code = HC_ACTION then
begin
 //Обработываем то, что поймали....
 Resylt := 0;
end else
 result := CallNextHook ...

И это, менеджер памяти то за каким лешим в dll включен? Это только delphi-специфичная вещь для строковых типов. В остальнвх дров наломает. А вы тут хуков напихали...

[Sibedir]

Сообщение от Человек_Борща

В фильтре вы не обрабатываете должным образом то, что вам приходит.
Читайте про return value на MSDN.

Я это читал. И очень внимательно:

Если nCode больше или равен нулю, то настоятельно рекомендуется вызвать CallNextHookEx и вернуть его значение; в противном случае, другие приложения, которые установили хук WH_CALLWNDPROCRET, не будете получать уведомления и в результате могут работать неправильно.

Вот

  if Code <> HC_ACTION then begin
    Result := CallNextHookEx (CallWndRetProc_Hook, Code, wParam, lparam);
  end
  else begin
    Result := 0;
    msg := PCWPRetStruct(lParam);
    Handled := False;
    try
      //Тут я как раз и хотел обработать то, что поймали,
      CallWndRetProc_Proc (msg, Handled);
    finally
      if not Handled then // и если Handled=False,
        Result := CallNextHookEx (CallWndRetProc_Hook, Code, wParam, lparam); // вернуть CallNextHookEx. Иначе Result останется равен 0.
    end;
  end;

-------------------------------------------------------------------------------

И это, менеджер памяти то за каким лешим в dll включен? Это только delphi-специфичная вещь для строковых типов. В остальнвх дров наломает. А вы тут хуков напихали...

ShareMem я уже после добавил. Без него тоже ошибки вылазили. Я и сам думал, что это лишнее, и, как настоящая блондинка, решил попробовать. Но теперь, когда ты сказал, я его убираю.
-------------------------------------------------------------------------------
Пробую дальше. Еще лобовуху протереть нужно, запаску подкачать и аптечку проверить...

[Filka]

begin
  if Code < 0 then
  begin
    Result := CallNextHookEx(CallWndRetProc_Hook, Code, wParam, lparam);
    Exit;
  end;
 
  if Code = HC_ACTION then
  begin
    //...
  end;

  Result := CallNextHookEx(CallWndRetProc_Hook, Code, wParam, lparam);
end;

https://msdn.microsoft.com/ru-ru/lib...(v=vs.85).aspx
?

[Sibedir]

Всё никак руки не доходили отписаться. Короче:

Основная ошибка была в том, что я устанавливал глобальный хук,

SetWindowsHookEx (WH_CALLWNDPROCRET, @FilterFunc_CallWndRetProc, HInstance, 0);

а при обработке обращался к локальным данным

library HookLibrary;
uses
...
  HookUnit in 'HookUnit.pas';
...
var
  CallWndRetProc_Hook: HHook = 0;
  CallWndRetProc_Proc: TCallWndRetProc_Proc = nil;
...
function FilterFunc_CallWndRetProc (code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT; stdcall;
...
begin
...
      CallWndRetProc_Proc (msg, Handled);
...
        ...CallNextHookEx (CallWndRetProc_Hook, Code, wParam, lparam);
...
end;

Нужно или локальный хук использовать или усложнять обработку через проецируемые в память файлы/данные.

[Человек_Борща]

Что значит "локальным данным"? Просто много экемпляров этой либы и каждый пишет в свои локальные переменные. Локальный хук ровным счетом ничего не изменит.

Пишите некое observer-приложение, которое будет слушать все ваши хуки.

[Sibedir]

Сообщение от Человек_Борща

Что значит "локальным данным"? Просто много экемпляров этой либы и каждый пишет в свои локальные переменные.

Ну да, я терминологией не очень владею. Имел в виду обращение к не инициализированным данным из глобального обработчика хука.
Опять, наверное, какую-то фигню сморозил

Пишите некое observer-приложение, которое будет слушать все ваши хуки.

Но мне нужен локальный хук. Конкретно, нужно отследить создание окна типа TForm потоком моего приложения.

Локальный хук ровным счетом ничего не изменит

Не пойму, разве локальный хук

CT := GetCurrentThreadId;
SetWindowsHookEx (WH, @FilterFunc, 0, CT);

не локальный. Мне то нужно, чтобы он цеплялся к окнам, созданным моим CT потоком.

[Человек_Борща]

Но мне нужен локальный хук. Конкретно, нужно отследить создание окна типа TForm потоком моего приложения.

Грандиозное решение однако придумали. Т.е. вы сами создаете окно и вы же никак н можете узнает что оно создалось?

Если так, то посылайте от него своё сообщение через Broadcast, и ловите его же где надо (самое простое на мой взгляд).