[Delphi] Как сделать метод класса callback функцией

Corrector

Есть некоторый класс. Один из его методов содержит процедуру, в которой есть параметр - callback функция.
В принципе, эту callback функцию можно сделать отдельно от класса, но это нехорошо, если создаются несколько экземпляров класса.
У меня не получилось сделать callback функцию методом класса. Это вообще возможно?

maggi14

сделай ее членом класса, а не методом

vijrel7878

можно
 

type
 TMyCallBackFunc = function : boolean;
// либо
 TMyCallBackFunc = function : boolean of object; // указатель на метод класса
 
  TMyClass = class(TObject)
    MyCallBachFunc: TMyCallBackFunc;
  end;
 

 
ну и передавать ее можно куда угодно, если нужно.
Я тебя правильно понял?

gopnik1994

есть еще грязные хаки с указателями

Corrector

в одном из методов класса есть API-функция SetWindowsHookEx, одним из параметров которой является callback функция. Если эту функцию поместить внутрь класса,
procedure TCommonHook.HookProc(Code: integer; wParam: word; lParam: longword);
и написать
HookID := SetWindowsHookEx( HookType, @HookProc , 0, GetCurrentThreadID );
то компилятор ругается:
Error: Variable requied
фумля, целый день над этим парился..
в итоге получилось, если кому поможет:
unit untHook;
interface
uses Windows, SysUtils, Classes, Messages, Dialogs;
type
THookProc = function(Code: integer; wParam: word; lParam: longword): longword of object; stdcall;
type
{ TCommonHook }

TCommonHook = class (TPersistent)
private
HookInstalled: boolean;
HookType: Integer;
PRealHookProc: Pointer;
HookID: HHook;
procedure InstallHook;
procedure UnInstallHook;
function MakeProcInstance(H: THookProc): Pointer;
procedure FreeProcInstance(ProcInstance: Pointer);
function RealHookProc(Code: integer; wParam: word; lParam: longword): longword; stdcall;
public
constructor Create(AType: Integer = 0);
destructor Destroy;
procedure SetHookType(AType: Integer);
procedure Activate;
procedure Deactivate;
procedure HookProc(Code: integer; wParam: word; lParam: longword); virtual;
function Active: boolean;
end;
{ THook }
THook = class(TCommonHook)
public
constructor Create(AType: Integer = 0);
procedure Deactivate;
procedure HookProc(Code: integer; wParam: word; lParam: longword); override;
end;
implementation
Uses untSerialDevice, untScanKey;
{TLocalHook}
constructor TCommonHook.Create(AType: Integer = 0);
begin
inherited Create;
HookInstalled := false;
SetHookType(AType);
end;
destructor TCommonHook.Destroy;
begin
if HookInstalled then
UnInstallHook;
inherited Destroy;
end;
procedure TCommonHook.SetHookType(AType: Integer);
var
tmp: boolean;
begin
tmp := HookInstalled;
if HookInstalled then
UnInstallHook;
HookType := AType;
if tmp then
InstallHook;
end;
function TCommonHook.RealHookProc(Code: integer; wParam: word; lParam: longword): longword; stdcall;
begin
if code < HC_ACTION then
begin
Result := CallNextHookEx(HookID, Code, wParam, lParam);
Exit;
end;
HookProc(Code, wParam, lParam);
Result := CallNextHookEx(HookID, Code, wParam, lParam);
end;
procedure TCommonHook.HookProc(Code: integer; wParam: word; lParam: longword);
begin
end;
procedure TCommonHook.InstallHook;
begin
if HookType <= 0 then
Exit;
if HookInstalled then
UnInstallHook;
PRealHookProc := MakeProcInstance(RealHookProc);
HookID := SetWindowsHookEx( HookType, PRealHookProc, 0, GetCurrentThreadID );
HookInstalled := (HookID <> 0);
end;

procedure TCommonHook.UnInstallHook;
begin
if not HookInstalled then
Exit;
HookInstalled := not UnhookWindowsHookEx(HookID);
end;

function TCommonHook.Active: boolean;
begin
Result := HookInstalled;
end;

procedure TCommonHook.Activate;
begin
InstallHook;
end;
procedure TCommonHook.Deactivate;
begin
UnInstallHook;
FreeProcInstance(PRealHookProc);
end;

function TCommonHook.MakeProcInstance(H: THookProc): Pointer;
var
M: TMethod;
begin
M := TMethod(H);
// allocate memory
GetMem(Result, 15);
asm
// MOV ECX,
MOV BYTE PTR [EAX], $B9
MOV ECX, M.Data
MOV DWORD PTR [EAX+$1], ECX
// POP EDX
MOV BYTE PTR [EAX+$5], $5A
// PUSH ECX
MOV BYTE PTR [EAX+$6], $51
// PUSH EDX
MOV BYTE PTR [EAX+$7], $52
// MOV ECX,
MOV BYTE PTR [EAX+$8], $B9
MOV ECX, M.Code
MOV DWORD PTR [EAX+$9], ECX
// JMP ECX
MOV BYTE PTR [EAX+$D], $FF
MOV BYTE PTR [EAX+$E], $E1
end;{asm}
end;
procedure TCommonHook.FreeProcInstance(ProcInstance: Pointer);
begin
FreeMem(ProcInstance, 15);
end;
{ THook implementation }
constructor THook.Create(AType: Integer = 0);
begin
inherited Create(AType);
end;
procedure THook.HookProc(Code: integer; wParam: word; lParam: longword);
begin
{тут обработчик}
end;
end.

vijrel7878

а это че за злобный хак?


function TCommonHook.MakeProcInstance(H: THookProc): Pointer;
var
M: TMethod;
begin
M := TMethod(H);
// allocate memory
GetMem(Result, 15);
asm
// MOV ECX,
MOV BYTE PTR [EAX], $B9
MOV ECX, M.Data
MOV DWORD PTR [EAX+$1], ECX
// POP EDX
MOV BYTE PTR [EAX+$5], $5A
// PUSH ECX
MOV BYTE PTR [EAX+$6], $51
// PUSH EDX
MOV BYTE PTR [EAX+$7], $52
// MOV ECX,
MOV BYTE PTR [EAX+$8], $B9
MOV ECX, M.Code
MOV DWORD PTR [EAX+$9], ECX
// JMP ECX
MOV BYTE PTR [EAX+$D], $FF
MOV BYTE PTR [EAX+$E], $E1
end;{asm}
end;
так
 @RealHookProc 
не прокатывало что ли?

Marinavo_0507

трамплин обычный
в камментах всё ж написано
gcc такие умеет делать, но на стеке

vijrel7878

да, невнимателно прочитал.

vijrel7878

а так


HookID := SetWindowsHookEx( HookType, HookProc , 0, GetCurrentThreadID );


пробовал?

gopnik1994

короче, ты пойми одно, что:
ЛИБО callback функция у тебя является методом класса и тогда передается как function of object и может управлять и имеет доступ к методам и свойствам своего класса,
ЛИБО она у тебя не является методом (т.е. либо функция класса, либо просто внешняя функция) и тогда передается как простой указатель на функцию и тогда она не может манипулировать никакими методами и свойствами, не имея глобальной ссылки на объект. И никакими извратами и хаками с указателями и asm'ом ты это не изменишь.
Как я понял при беглом взгляде, ты просто асмом пытаешься обойти хотелку метода (переданного как указатель на функцию без параметров) прочитать первый параметр - указатель на на self (this написав целый класс-обертку. Это дикий изврат и кривость несусветная. Если не хочешь делать свою ф-ю внешней, сделай ее просто class function (static).
А твоя реализация всего лишь - обход ошибки компиляции, но не решение проблемы.

gopnik1994

если тебе надо из этой ф-й иметь доступ к самому объкту, которому он принадлежит, то придется твою асмовскую вставку несколько усложнить, дописав туда еще PUSH @self...
А вообще, я так подозреваю, что некоторым виндам пожет не понравиться выполнение кода из кучи.. Или я не прав?

Corrector

HookID := SetWindowsHookEx( HookType, HookProc , 0, GetCurrentThreadID );
> [Error] Incompatible types: 'Calling conventions differ'
HookID := SetWindowsHookEx( HookType, @HookProc , 0, GetCurrentThreadID );
> [Error] Variable required
[/quote]
HookID := SetWindowsHookEx( HookType, @RealHookProc , 0, GetCurrentThreadID );
> [Error] Variable required

Corrector

если тебе надо из этой ф-й иметь доступ к самому объкту, которому он принадлежит, то придется твою асмовскую вставку несколько усложнить, дописав туда еще PUSH @self...
Да, доступ к объекту иметь очень надо.
Я решил проблему так:
TCommonHook = class (TPersistent)
Parent: TObject
...
end;

При создании хука:

MyHook := TMyHook.Create;
MyHook.Parent := self;

код, который я привел, на практике оказался работоспособным
Оставить комментарий
Имя или ник:
Комментарий: