type
TCallDispatcher =
packed record
POP_EAX: Byte;
PUSH_CONST: Byte;
Self: Pointer;
PUSH_EAX: Byte;
JMP_RELATIVE: Byte;
Offset: Integer;
end;
procedure InitDispatcher(
var Dispatcher: TCallDispatcher; Self, Method: Pointer);
begin
Dispatcher.POP_EAX := $58;
Dispatcher.PUSH_CONST := $68;
Dispatcher.Self := Self;
Dispatcher.PUSH_EAX := $50;
Dispatcher.JMP_RELATIVE := $E9;
Dispatcher.Offset := PChar(Method) - PChar(@Dispatcher) - SizeOf(Dispatcher);
end;
type
TMyObject =
class
FDispatcher: TCallDispatcher;
FHandle: hWnd;
function WndProc(Wnd: hWnd; Msg,wParam,lParam: Integer): Integer;
stdcall;
procedure CreateHandle;
end;
function TMyObject.WndProc(Wnd: hWnd; Msg,wParam,lParam: Integer): Integer;
stdcall;
begin
end;
procedure TMyObject.CreateHandle;
// zur ansatzweisen Demonstration
var
Params: TCreateParams;
begin
// TControl.CreateParams(Params);
InitDispatcher(FDispatcher, Self, @TMyObject.WndProc);
Params.WindowClass.lpfnWndProc := @FDispatcher;
// Windows.RegisterClass();
with Params
do
FHandle := CreateWindowEx(ExStyle, WinClassName, Caption, Style,
X, Y, Width, Height, WndParent, 0, WindowClass.hInstance, Param);
end;
{
Aufruf aus dem OS sieht so aus
PUSH lParam
PUSH wParam
PUSH Msg
PUSH Wnd
CALL WndProc -> PUSH ReturnAddress
JMP WndProc -> zeigt auf @FDispatcher
WndProc.FDispatcher code ist
POP EAX = ReturnAddress
PUSH Self
PUSH EAX
JMP TMyObject.WndProc
}
procedure Test_WindowProc;
var
TestWndProc:
function(Wnd: hWnd; Msg,wParam,lParam: Integer): Integer;
stdcall;
TestObject: TMyObject;
begin
TestObject := TMyObject.Create;
try
InitDispatcher(TestObject.FDispatcher, TestObject, @TMyObject.WndProc);
TestWndProc := @TestObject.FDispatcher;
TestWndProc(1, 2, 3, 4);
finally
TestObject.Free;
end;
end;
// Beispiel für einen anderen CallDispatcher
function TForm1.DoEnumWindows(Wnd: hWnd; Param: Integer): Bool;
stdcall;
begin
end;
procedure TForm1.Test_Enum;
var
Enum: TCallDispatcher;
begin
InitDispatcher(Enum, Self, @TForm1.DoEnumWindows);
EnumWindows(@Enum, 0);
end;