Question

这个问题来自于one 问题是：创建非可视组件，可以从系统中保存许多回调命令。用户可以在IDE中定义无限数量的回调。回调将在TCollection中定义为TCollectionItem。

这是一种非常好的模式，但有一些缺点。（稍后描述）因此，我想知道，如果可以做得更好;-)

这是一个主要组件，用户可以通过CommandsTable集合在IDE中定义无限数量的回调函数

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

每个集合项都如下所示，InternalCommandFunction是回调函数，它是从系统调用的。（Stdcall呼叫公约）

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;

这是一个实现。整个过程可以通过“开始”程序开始

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;

这是有问题的代码。我认为如何获得指向“InternalEventFunction”函数的唯一方法是使用MethodToProcedure（）函数。

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;

正如我之前描述的，它可以正常工作，但函数MethodToProcedure（）使用 Thunk 技术。我想避免这种情况，因为程序不适用于启用了数据执行保护（DEP）的系统而且在64位架构上，可能需要全新的MethodToProcedure（）函数。
你知道一些更好的模式吗？

只是为了完成，这里是一个MethodToProcedure（）。（我不知道原作者是谁。）

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

如果您可以更改DLL以接受记录数组而不是指针数组，那么您可以定义记录以包含回调指针和对象指针，并为回调签名提供额外的指针参数。然后定义一个简单的代理函数，DLL可以将对象指针作为参数调用，代理可以通过该指针调用真实对象方法。不需要thunking或更低级别的程序集，它可以在32位和64位工作，无需特殊编码。如下所示：

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;

如果这不是一个选项，那么使用thunks是你给出的设计的唯一解决方案，你需要单独的32位和64位thunk。不过不要担心DEP。只需使用VirtualAlloc()和VirtualProtect()代替New()，这样就可以将分配的内存标记为包含可执行代码。这就是VCL自己的thunk（例如TWinControl和TTimer使用）避免DEP干扰的方式。

Answer 2

由于您无法修改DLL代码，因此您别无选择，只能在问题代码的样式中使用thunk。没有其他方法可以将实例信息提供给回调函数。

组件的模式与回调系统与stdcall调用约定

2 个答案: