通過匿名函數將TCallbackThunk轉換爲64位

Question

我有一個將代碼移植到64位的問題。它的目的是爲WinAPI聲明一個方法函數作爲回調函數。有些人可能知道這是TCallbackThunk（見this SO answer for some further explanation）。

我認爲這段代碼比較老，但是使用了相同的方法。它也應該與TCallbackThunk一起工作。 讓我告訴你的代碼，因爲它適用於32位：

unit SubClassing; 

interface 

uses 
    Windows; 

type 
    TCallbackMode = (cbNoCallSuper, cbKeepResult, cbUseSuperResult); 

    TWndProc = procedure(Window: HWND; var Message: LongInt; 
    var WParam: Longint; var LParam: Longint; 
    var LResult: LongInt; var Mode: TCallbackMode) of object; 

type 
    PSubClassInfo = ^TSubClassInfo; 
    TSubClassInfo = record 
    OriginalWndProc: Pointer; 
    NewWndProc: TWndProc; 
    Handle: HWnd; 
    Stub: Pointer; 
    end; 

function SubClassWindow(Handle: HWnd; WndProc: TWndProc): PSubClassInfo; 
procedure UnSubClassWindow(var Info: PSubClassInfo); 

implementation 

uses 
    SysUtils; 

function MakeProcInstance(Data: Pointer; Code: Pointer): Pointer; 
begin 
{$IFDEF WIN64} 
    Assert(False); // lacks implementation for 64-bit 
{$ELSE} 
    // A simple GetMem will _not_ do the trick. 
    // To avoid conflicting with DEP it is essential that the page will 
    // be marked as being executable. 
    Result := VirtualAlloc(nil, 15, $3000, $40); 
    asm 
    MOV BYTE PTR [EAX], $B9 
    MOV ECX, Data 
    MOV DWORD PTR [EAX+$1], ECX 
    MOV BYTE PTR [EAX+$5], $5A 
    MOV BYTE PTR [EAX+$6], $51 
    MOV BYTE PTR [EAX+$7], $52 
    MOV BYTE PTR [EAX+$8], $B9 
    MOV ECX, Code 
    MOV DWORD PTR [EAX+$9], ECX 
    MOV BYTE PTR [EAX+$D], $FF 
    MOV BYTE PTR [EAX+$E], $E1 
    end; 
{$ENDIF} 
end; 

procedure FreeProcInstance(ProcInstance: Pointer); 
begin 
    VirtualFree(ProcInstance, 15, $8000); 
end; 

function MultiCaster(SubClassInfo: PSubClassInfo; Window: HWND; Message, 
    WParam: Longint; LParam: Longint): LongInt; stdcall; 
var 
    Mode: TCallbackMode; 
    Res: LongInt; 
begin 
    SubClassInfo.NewWndProc(Window, Message, WParam, LParam, Result, Mode); 

    if Mode <> cbNoCallSuper then 
    begin 
    Res := CallWindowProc(SubClassInfo^.OriginalWndProc, Window, Message, wParam, lParam); 
    if Mode = cbUseSuperResult then 
     Result := Res; 
    end; 
end; 

function SubClassWindow(Handle: HWnd; WndProc: TWndProc): PSubClassInfo; 
begin 
    Result := new(PSubClassInfo); 

    ZeroMemory(Result, SizeOf(TSubClassInfo)); 
    Result^.NewWndProc := WndProc; 
    Result^.Handle := Handle; 
    Result^.Stub := MakeProcInstance(Result, @MultiCaster); 
    Result^.OriginalWndProc := Pointer(SetWindowLong(Handle, GWL_WNDPROC, Integer(Result^.Stub))); 
end; 

procedure UnSubClassWindow(var Info: PSubClassInfo); 
begin 
    if Assigned(Info) then 
    begin 
    if Assigned(Info^.OriginalWndProc) then 
    begin 
     SetWindowLong(Info^.Handle, GWL_WNDPROC, Integer(Info^.OriginalWndProc)); 
     FreeProcInstance(Info^.Stub); 
    end; 

    Dispose(Info); 
    end; 
    Info := nil; 
end; 

end. 

之前移植的MakeProcInstance彙編代碼爲64位，我想先嚐試與匿名功能的解決方案。這會在彙編代碼變得過時時提供更好的可維護性。因此，我宣佈

TMultiCasterFunc = reference to function(Window: HWND; Message, 
    WParam: Longint; LParam: Longint): LongInt stdcall; 

，並重新聲明TSubClassInfo作爲

TSubClassInfo = record 
    OriginalWndProc: Pointer; 
    NewWndProc: TWndProc; 
    Handle: HWnd; 
    Stub: TMultiCasterFunc; 
end; 

然後，我實現了一個功能

function GetMultiCasterFunction(const ASubClassInfo: PSubClassInfo): TMultiCasterFunc; 
begin 
    Result := function(Window: HWND; Message, WParam: Longint; LParam: Longint): LongInt stdcall 
      begin 
       Result := MultiCaster(ASubClassInfo, Window, Message, WParam, LParam); 
      end; 
end; 

功能SubClassWindow和UnSubClassWindow進行編輯，以這樣的：

function SubClassWindow(Handle: HWnd; WndProc: TWndProc): PSubClassInfo; 
begin 
    Result := new(PSubClassInfo); 

    ZeroMemory(Result, SizeOf(TSubClassInfo)); 
    Result^.NewWndProc := WndProc; 
    Result^.Handle := Handle; 
    Result^.Stub := GetMultiCasterFunction(Result); 
    Result^.OriginalWndProc := Pointer(SetWindowLong(Handle, GWL_WNDPROC, NativeInt(@(Result^.Stub)))); 
end; 

procedure UnSubClassWindow(var Info: PSubClassInfo); 
begin 
    if Assigned(Info) then 
    begin 
    if Assigned(Info^.OriginalWndProc) then 
    begin 
     SetWindowLong(Info^.Handle, GWL_WNDPROC, Integer(Info^.OriginalWndProc)); 
     FreeProcInstance(@(Info^.Stub)); 
    end; 

    Dispose(Info); 
    end; 
    Info := nil; 
end; 

我很高興看到代碼真的編譯。我並不期待這一點。 不幸的是，當代碼被執行時，我得到了各種異常。例如，撥打GetMultiCasterFunction時，我在System._IntfCopy中收到AV at address 0000000000419A32 reading address FFFFFFFFFFFFFFFF。

我如何使用匿名函數有什麼不對嗎？僅供參考，我正在用Delphi XE4做這件事。我應該嘗試什麼？

我在ASM有一些經驗。所以我可以爲64位做一個單獨的解決方案。但那應該是最後的手段。

Answer 1

我如何使用匿名函數有什麼不對嗎？

是的。當您使用SetWindowLong傳遞GWL_WNDPROC時，您需要提供一個窗口過程。這是以下類型的函數指針：

LRESULT CALLBACK WindowProc(
    _In_ HWND hwnd, 
    _In_ UINT uMsg, 
    _In_ WPARAM wParam, 
    _In_ LPARAM lParam 
); 

我把這個從documentation。

在Delphi的語法，這將是：

function WindowProc(
    hwnd: HWND; 
    uMsg: UINT; 
    wParam: WPARAM; 
    lParam: LPARAM 
): LRESULT; stdcall; 

一開始，請注意使用的類型。與你非常不同。在64位版本中，WPARAM，LPARAM和LRESULT都是64位類型。你應該解決這個問題。

但是，最大的問題是這與匿名方法不兼容。 Delphi中的一個匿名方法被實現爲一個接口。 Win32窗口過程絕對不是接口。

所以，如果你想繼續在這個方面，你將需要堅持VirtualAlloc和彙編類型thunking方法。如果你想使用匿名方法，那麼你需要使用不同的asm來調用接口方法。

要學會如何去適應你的彙編調用的方法轉換成代碼調用一個匿名方法，我建議你閱讀以下內容：

• http://blog.barrkel.com/2010/01/using-anonymous-methods-in-method.html
• http://delphisorcery.blogspot.co.uk/2015/06/anonymous-method-overloading.html
• https://sergworks.wordpress.com/2010/01/27/anonimous-methods-in-delphi-the-internals/

如果您準備使用of object方法，那麼Delphi VCL代碼將告訴您如何去做。該技術在TWinControl的窗口過程處理中被舉例說明。自然，當Embarcadero推出64位Windows編譯器和64位VCL時，他們必須更新其thunk代碼才能支持64位。