如何在64位Delphi XE2中将方法转换为回调过程？

MustangPeak Common Library(http://code.google.com/p/mustangpeakcommonlib/)包含以下代码,用于将方法转换为可在回调中使用的过程：

const
  AsmPopEDX = $5A;
  AsmMovEAX = $B8;
  AsmPushEAX = $50;
  AsmPushEDX = $52;
  AsmJmpShort = $E9;

type
  TStub = packed record
    PopEDX: Byte;
    MovEAX: Byte;
    SelfPointer: Pointer;
    PushEAX: Byte;
    PushEDX: Byte;
    JmpShort: Byte;
    Displacement: Integer;
  end;

{ ----------------------------------------------------------------------------- }
function CreateStub(ObjectPtr: Pointer; MethodPtr: Pointer): Pointer;
var
  Stub: ^TStub;
begin
  // Allocate memory for the stub
  // 1/10/04 Support for 64 bit,executable code must be in virtual space
  Stub := VirtualAlloc(nil,SizeOf(TStub),MEM_COMMIT,PAGE_EXECUTE_READWRITE);

  // Pop the return address off the stack
  Stub^.PopEDX := AsmPopEDX;

  // Push the object pointer on the stack
  Stub^.MovEAX := AsmMovEAX;
  Stub^.SelfPointer := ObjectPtr;
  Stub^.PushEAX := AsmPushEAX;

  // Push the return address back on the stack
  Stub^.PushEDX := AsmPushEDX;

  // Jump to the 'real' procedure,the method.
  Stub^.JmpShort := AsmJmpShort;
  Stub^.Displacement := (Integer(MethodPtr) - Integer(@(Stub^.JmpShort))) -
    (SizeOf(Stub^.JmpShort) + SizeOf(Stub^.Displacement));

  // Return a pointer to the stub
  Result := Stub;
end;
{ ----------------------------------------------------------------------------- }

{ ----------------------------------------------------------------------------- }
procedure DisposeStub(Stub: Pointer);
begin
  // 1/10/04 Support for 64 bit,executable code must be in virtual space
  VirtualFree(Stub,MEM_DECOMMIT);
end;

我很感激将它转换为64位的任何帮助.我知道Win64中的调用约定是不同的,并且最多四个参数被传递到寄存器中.因此可能必须修改CreateStub以包含参数的数量.它实际上不使用四个以上的参数,即整数或指针(没有浮点参数).

解决方法

这是64位版本的CreateStub.感谢Andrey Gruzdev提供的代码.

type
  ICallbackStub = interface(IInterface)
    function GetStubPointer: Pointer;
    property StubPointer : Pointer read GetStubPointer;
  end;

  TCallbackStub = class(TInterfacedObject,ICallbackStub)
  private
    fStubPointer : Pointer;
    fCodeSize : integer;
    function GetStubPointer: Pointer; 
  public
    constructor Create(Obj : TObject; MethodPtr: Pointer; NumArgs : integer);
    destructor Destroy; override;
  end;



constructor TCallBackStub.Create(Obj: TObject; MethodPtr: Pointer;
  NumArgs: integer);
{$IFNDEF cpuX64}
// as before
{$ELSE cpuX64}
const
RegParamCount = 4;
ShadowParamCount = 4;

Size32Bit = 4;
Size64Bit = 8;

ShadowStack   = ShadowParamCount * Size64Bit;
SkipParamCount = RegParamCount - ShadowParamCount;

StackSrsOffset = 3;
c64stack: array[0..14] of byte = (
$48,$81,$ec,00,//     sub rsp,$0
$4c,$89,$8c,$24,ShadowStack,00//     mov [rsp+$20],r9
);

CopySrcOffset=4;
CopyDstOffset=4;
c64copy: array[0..15] of byte = (
$4c,$8b,//     mov r9,[rsp+0]
$4c,00//     mov [rsp+0],r9
);

RegMethodOffset = 10;
RegSelfOffset = 11;
c64regs: array[0..28] of byte = (
$4d,$c1,//   mov r9,r8
$49,$d0,//   mov r8,rdx
$48,$ca,//   mov rdx,rcx
$48,$b9,// mov rcx,Obj
$48,$b8,00 // mov rax,MethodPtr
);

c64jump: array[0..2] of byte = (
$48,$ff,$e0  // jump rax
);

CallOffset = 6;
c64call: array[0..10] of byte = (
$48,//    call rax
$48,$c4,//     add rsp,$0
$c3// ret
);
var
  i: Integer;
  P,PP,Q: PByte;
  lCount : integer;
  lSize : integer;
  lOffset : integer;
begin
    lCount := SizeOf(c64regs);
    if NumArgs>=RegParamCount then
       Inc(lCount,sizeof(c64stack)+(NumArgs-RegParamCount)*sizeof(c64copy)+sizeof(c64call))
    else
       Inc(lCount,sizeof(c64jump));

    Q := VirtualAlloc(nil,lCount,PAGE_EXECUTE_READWRITE);
    P := Q;

    lSize := 0;
    if NumArgs>=RegParamCount then
    begin
        lSize := ( 1+ ((NumArgs + 1 - SkipParamCount) div 2) * 2 )* Size64Bit;   // 16 byte stack align

        pp := p;
        move(c64stack,P^,SizeOf(c64stack));
        Inc(P,StackSrsOffset);
        move(lSize,Size32Bit);
        p := pp;
        Inc(P,SizeOf(c64stack));
        for I := 0 to NumArgs - RegParamCount -1 do
        begin
            pp := p;
            move(c64copy,SizeOf(c64copy));
            Inc(P,CopySrcOffset);
            lOffset := lSize + (i+ShadowParamCount+1)*Size64Bit;
            move(lOffset,Size32Bit);
            Inc(P,CopyDstOffset+Size32Bit);
            lOffset := (i+ShadowParamCount+1)*Size64Bit;
            move(lOffset,Size32Bit);
            p := pp;
            Inc(P,SizeOf(c64copy));
        end;
    end;

    pp := p;
    move(c64regs,SizeOf(c64regs));
    Inc(P,RegSelfOffset);
    move(Obj,SizeOf(Obj));
    Inc(P,RegMethodOffset);
    move(MethodPtr,SizeOf(MethodPtr));
    p := pp;
    Inc(P,SizeOf(c64regs));

    if NumArgs<RegParamCount then
      move(c64jump,SizeOf(c64jump))
    else
    begin
      move(c64call,SizeOf(c64call));
      Inc(P,CallOffset);
      move(lSize,Size32Bit);
    end;
    fCodeSize := lcount;
   fStubPointer := Q;
{$ENDIF cpuX64}
end;

destructor TCallBackStub.Destroy;
begin
  VirtualFree(fStubPointer,fCodeSize,MEM_DECOMMIT);
  inherited;
end;

function TCallBackStub.GetStubPointer: Pointer;
begin
  Result := fStubPointer;
end;

原文链接：https://www.f2er.com/delphi/101889.html

如何在64位Delphi XE2中将方法转换为回调过程？

解决方法

猜你在找的Delphi相关文章