asm

asm.cpp

#include <windows.h>

LRESULT CALLBACK MainWndProc(
    HWND hwnd,        // handle to window
    UINT uMsg,        // message identifier
    WPARAM wParam,    // first message parameter
    LPARAM lParam)    // second message parameter
{

#ifdef _M_AMD64
	auto pCallWindowProcW = reinterpret_cast<decltype (CallWindowProcW)*>(0x1111111111111111);
	auto VBA_PROC = reinterpret_cast<decltype (CallWindowProcW)*>(0x1111111111111111);

	UINT volatile OrgMsg = (UINT)0x11111111;
	WNDPROC volatile pOrgProc = (WNDPROC)0x1111111111111111;
#else
	auto pCallWindowProcW = reinterpret_cast<decltype (CallWindowProcW)*>(0x11111111);
	auto VBA_PROC = reinterpret_cast<decltype (CallWindowProcW)*>(0x11111111);

	UINT volatile OrgMsg = (UINT)0x11111111;
	WNDPROC volatile pOrgProc = (WNDPROC)0x11111111;
#endif

	if(uMsg == OrgMsg)
	{
		VBA_PROC(pOrgProc, hwnd, uMsg, wParam, lParam); 
	}
	return pCallWindowProcW(pOrgProc, hwnd, uMsg, wParam, lParam); 
}

Module1.bas

Option Explicit
Function CallFunc(ByVal p As LongPtr, ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPtr
    Debug.Print Hex$(hWnd)
End Function

UserForm1.frm

Option Explicit


Private Declare Function GetModuleHandle Lib "kernel32" _
        Alias "GetModuleHandleA" _
        (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" _
        (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function GetWindowLong Lib "user32" _
        Alias "GetWindowLongW" _
        (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" _
        Alias "SetWindowLongW" _
        (ByVal hWnd As Long, ByVal nIndex As Long, _
        ByVal dwNewLong As Long) As Long
Const GWL_WNDPROC = -4
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function VirtualAlloc Lib "kernel32" _
        (ByVal lpAddress As Long, ByVal dwSize As Long, _
        ByVal flAllocationType As Long, _
        ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32" _
        (ByVal lpAddress As Long, ByVal dwSize As Long, _
        ByVal dwFreeType As Long) As Long
Const PAGE_EXECUTE_READWRITE = &H40
Const MEM_COMMIT = &H1000
Const MEM_RESERVE = &H2000
Const MEM_RELEASE = &H8000&
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function FlushInstructionCache Lib "kernel32" _
        (ByVal hProcess As Long, lpBaseAddress As Any, _
        ByVal dwSize As Long) As Long
Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc" _
        (ByVal pacc As IAccessible, phwnd As Long) As Long
Private Declare PtrSafe Function GetTopWindow Lib "user32" (ByVal hWnd As LongPtr) As LongPtr

Private m_hwnd  As LongPtr
Private m_pProc As LongPtr

' サブクラス化開始
Private Sub UserForm_Initialize()

    Const cstrCode = "83EC8B5545C710EC111111F0F445C7111111111111F845C7C71111111111FC45458B11110C4539F84D8B1775558B5114458B52104D8B500C558B510855FF52FC14458BF4104D8B500C558B5108458B52FC4D8B50F055FF51C25DE58B90900010"
    Dim Code() As Long
    Dim lngCodeLen As Long
    Dim i As Long
    Dim VBA_PROC As LongPtr
    Dim PROC As LongPtr

    WindowFromAccessibleObject Me, m_hwnd
    m_hwnd = GetTopWindow(m_hwnd)


    ReDim Code(0 To (Len(cstrCode) - 1) \ 8)
    For i = 0 To UBound(Code)
        Code(i) = "&H" & Mid$(cstrCode, 1 + i * 8, 8)
    Next

    lngCodeLen = (UBound(Code) + 1) * 4
    m_pProc = VirtualAlloc(0, lngCodeLen, MEM_RESERVE Or MEM_COMMIT, PAGE_EXECUTE_READWRITE)

    MoveMemory ByVal m_pProc, Code(0), lngCodeLen

    PROC = GetProcAddress(GetModuleHandle("user32.dll"), "CallWindowProcW")
    MoveMemory ByVal m_pProc + 9, PROC, 4
'    VBA_PROC = VBA.Int(AddressOf CallFunc)
	MoveMemory ByVal m_pProc + 16, AddressOf CallFunc, 4
    MoveMemory ByVal m_pProc + 23, &H20A, 4
    MoveMemory ByVal m_pProc + 30, GetWindowLong(m_hwnd, GWL_WNDPROC), 4

    FlushInstructionCache GetCurrentProcess(), ByVal m_pProc, lngCodeLen
    SetWindowLong m_hwnd, GWL_WNDPROC, m_pProc

End Sub

' サブクラス化終了
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Dim pOrgProc As Long
    If m_pProc = 0 Then Exit Sub
    MoveMemory pOrgProc, ByVal m_pProc + 30, 4
    SetWindowLong m_hwnd, GWL_WNDPROC, pOrgProc
    VirtualFree m_pProc, 0, MEM_RELEASE
    m_pProc = 0
End Sub