Компонент с системой обратного вызова со стандартным вызовом stdcall

Question

Этот вопрос возник из-за этого one.
Проблема заключается в следующем: создать не визуальный компонент, который может содержать множество команд callbacks из системы. Пользователь может определить неограниченное количество обратных вызовов в среде 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 Calling конвенции)

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; 

А вот реализация. Весь процесс может быть запущен с «Start» Процедура

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; 

Если это не вариант, а затем с помощью санков является единственным решением, учитывая конструкцию вы проявили, и вы должны были бы отдельные 32-разрядные и 64-разрядные преобразователи. Однако не беспокойтесь о DEP. Просто используйте VirtualAlloc() и VirtualProtect() вместо New(), чтобы вы могли отметить выделенную память как содержащую исполняемый код. Таким образом, собственные шутки VCL (используемые, например, TWinControl и TTimer), исключают помехи DEP.

Answer 2

Поскольку вы не можете изменить код DLL, у вас нет альтернативы, кроме как использовать thunks в стиле кода в вашем вопросе. Другого пути для получения информации о экземпляре функции обратного вызова нет.