具有stdcall調用約定的回調系統組件的模式

Question

此問題源於此one。
問題是：創建非可視組件，它可以容納來自系統的許多回調命令。 用戶可以在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是從系統調用的回調函數。 （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（）使用咚技術。 我喜歡避免這種情況，因爲程序無法在啓用數據執行保護（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; 

如果這不是一種選擇，然後使用的thunk是給定已示出的設計的唯一解決方案，並且你將需要單獨的32位和64位的thunk。不過，不要擔心DEP。只需使用VirtualAlloc()和VirtualProtect()而不是New()，這樣您就可以將分配的內存標記爲包含可執行代碼。這就是VCL自己的thunk（例如TWinControl和TTimer所使用的）避免DEP干擾的方式。

Answer 2

由於您無法修改DLL代碼，因此您別無選擇，只能在問題中使用代碼風格的thunk。沒有其他方法可以將實例信息傳遞給回調函數。