Question

This question arised from this one.

The problem is: create non visual component which can hold many callbacks commands from system.
User can define unlimited number of callbacks in the IDE. Callbacks will be defined in TCollection as TCollectionItem.


This is a pattern which work pretty good, but has some disadvantages. (described later)
Therefore I wonder, if it could be done better 😉


This is a main component, user can define in the IDE unlimited number of callback function through CommandsTable collection

TMainComp = class(TComponent)  
private
   CallbacksArray: array [0..x] of pointer;
   procedure BuildCallbacksArray;    
public 
   procedure Start;
published
   property CommandsTable: TCommandCollection read FCommandsTable write SetCommandsTable;
end;

Every collection item looks like this, InternalCommandFunction is callback, which is called from system. (Stdcall Calling Convention)

TCommandCollectionItem = class(TCollectionItem)
public
   function InternalCommandFunction(ASomeNotUsefullPointer:pointer; ASomeInteger: integer): Word; stdcall;
published
   property OnEventCommand: TComandFunc read FOnEventCommand write FOnEventCommand;
end; 

TComandFunc = function(AParam1: integer; AParam2: integer): Word of Object;

And here is a implementation. The whole process could be started with “Start” procedure

procedure TMainComp.Start;
begin  
  // fill CallBackPointers array with pointers to CallbackFunction
  BuildCallbacksArray;

  // function AddThread is from EXTERNAL dll. This function creates a new thread, 
  // and parameter is a pointer to an array of pointers (callback functions).
  // New created thread in system should call our defined callbacks (commands) 
  AddThread(@CallbacksArray);
end;   

And this is the problematic code. I think the only way how to get pointer to “InternalEventFunction” function
is to use MethodToProcedure() function.

procedure TMainComp.BuildCallbacksArray;
begin
   for i := 0 to FCommandsTable.Count - 1 do begin
      // it will not compile
      //CallbacksArray[i] := @FCommandsTable.Items[i].InternalEventFunctionWork;

      // compiles, but not work
      //CallbacksArray[i] := @TCommandCollectionItem.InternalCommandFunction;

      // works pretty good
      CallbacksArray[i] := MethodToProcedure(FCommandsTable.Items[i], @TCommandCollectionItem.InternalCommandFunction);

   end;         
end;

function TEventCollectionItem.InternalEventFunction(ASomeNotUsefullPointer:pointer; ASomeInteger: integer): Word; stdcall;
begin
  // some important preprocessing stuff
  // ...


  if Assigned(FOnEventCommand) then begin
     FOnEventCommand(Param1, Param2);
  end;
end;

As I described before, it works ok, but function MethodToProcedure() uses Thunk technique.
I like to avoid this because, program will not work on systems, where the Data Execution Prevention (DEP) is enabled
and also on 64-bit architectures, will be probably brand new MethodToProcedure() function required.


Do you know some better pattern for that?

---

just for completion, here is a MethodToProcedure(). (I don’t know who is the original author).

TMethodToProc = packed record
    popEax: Byte;
    pushSelf: record
      opcode: Byte;
      Self: Pointer;
    end;
    pushEax: Byte;
    jump: record
      opcode: Byte;
      modRm: Byte;
      pTarget: ^Pointer;
      target: Pointer;
    end;
  end;    

function MethodToProcedure(self: TObject; methodAddr: Pointer): Pointer;
var
  mtp: ^TMethodToProc absolute Result;
begin
  New(mtp);
  with mtp^ do
  begin
    popEax := $58;
    pushSelf.opcode := $68;
    pushSelf.Self := Self;
    pushEax := $50;
    jump.opcode := $FF;
    jump.modRm := $25;
    jump.pTarget := @jump.target;
    jump.target := methodAddr;
  end;
end;    

Answer 1

If you can change the DLL to accept an array of records instead of an array of pointers, then you can define the record to contain both a callback pointer and an object pointer, and give the callback signature an extra pointer parameter. Then define a simple proxy function that the DLL can call with the object pointer as a parameter, and the proxy can call the real object method through that pointer. No thunking or lower-level assembly needed, and it will work in both 32-bit and 64-bit without special coding. Something like the following:

type
  TCallback = function(AUserData: Pointer; AParam1, AParam2: Integer): Word; stdcall;

  TCallbackRec = packed record
    Callback: TCallback;
    UserData: Pointer; 
  end;

  TCommandFunc = function(AParam1, AParam2: integer): Word of object; 

  TCommandCollectionItem = class(TCollectionItem) 
  private
    FOnEventCommand: TCommandFunc;
    function InternalCommandFunction(APara1, AParam2: Integer): Word; 
  published 
    property OnEventCommand: TCommandFunc read FOnEventCommand write FOnEventCommand; 
  end;  

  TMainComp = class(TComponent)  
  private
    CallbacksArray: array of TCallbackRec;
  public 
    procedure Start;
  published
    property CommandsTable: TCommandCollection read FCommandsTable write SetCommandsTable;
  end;

.

function CallbackProxy(AUSerData: Pointer; AParam1, AParam2: Integer): Word; stdcall;
begin
  Result := TEventCollectionItem(AUserData).InternalEventFunction(AParam1, AParam2);
end;

procedure TMainComp.Start; 
var
  i: Integer;
begin 
  SetLength(CallbacksArray, FCommandsTable.Count);
  for i := 0 to FCommandsTable.Count - 1 do begin 
    CallbacksArray[i].Callback := @CallbackProxy; 
    CallbacksArray[i].UserData := FCommandsTable.Items[i]; 
  end;          
  AddThread(@CallbacksArray[0]);
end;    

function TEventCollectionItem.InternalEventFunction(AParam1, AParam2: Integer): Word;
begin 
  // ... 
  if Assigned(FOnEventCommand) then begin 
    Result := FOnEventCommand(Param1, Param2); 
  end; 
end; 

If that is not an option, then using thunks is the only solution given the design you have shown, and you would need separate 32-bit and 64-bit thunks. Don’t worry about DEP, though. Simply use VirtualAlloc() and VirtualProtect() instead of New() so you can mark the allocated memory as containing executable code. That is how the VCL’s own thunks (used by TWinControl and TTimer, for instance) avoid DEP interference.