2

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

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

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

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 是回调，从系统调用。（标准调用约定）

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;
4

2 回答 2

5

如果您可以将 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;

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

于 2012-05-16T10:45:32.880 回答
0

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

于 2012-05-16T13:13:17.067 回答