Class module callback method crashing in VBAx64

[fafalone]

I'm using the following method to have a callback for TaskDialogIndirect... it works in VBA7 32bit, VB6 (32bit), twinBASIC 32bit, and twinBASIC 64bit, but crashes in VBA7 64bit (In all scenarios I'm testing the VBA7 method of calling it; I use a workaround that copies it into a UDT consisting of a byte array, to avoid the automatic padding that will break it otherwise. If I disable the callback, the API works, so it's definitely that).

uTDC.pfCallback = tdFARPROC(AddressOf TaskDialogCallbackProc)
uTDC.lpCallbackData = ObjPtr(Me)

Then in a standard module,

Public Function TaskDialogCallbackProc(ByVal hWnd As LongPtr, ByVal uNotification As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr, ByVal lpRefData As cTaskDialog) As Long: TaskDialogCallbackProc = lpRefData.zz_ProcessCallback(hWnd, uNotification, wParam, lParam): End Function

I put a MsgBox in the first line of the callback; it never enters it. cTaskDialog is the name of the class.

I'm at a loss to explain why this works in all scenarios except 64bit VBA.

Attaching the full .cls/.bas I'm currently using.

If anybody has a clue what might be going on... or an alternative method for class module callbacks that does work in x64, I could really use some help here.

(Edit: Removed non-working debug version not intended for other use now that a solution has been found (see below) and implemented; grab latest version here)

[fafalone]

Ok instead of resolving this specifically, does anyone have a class callback method that *does* work in VBA7 x64?

[wqweto]

Timers seem work in x64 VBA7

'--- Module1
Option Explicit

Public Sub TimerProc(ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal idEvent As LongPtr, ByVal dwTime As Long)
    Debug.Print Timer
End Sub

'--- UserForm1
Option Explicit

Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    
Private m_TimerID As LongPtr

Private Sub CommandButton1_Click()
    If m_TimerID <> 0 Then
        Call KillTimer(0, m_TimerID)
        m_TimerID = 0
    End If
    m_TimerID = SetTimer(0, 0, 1000, AddressOf TimerProc)
    Debug.Print "m_TimerID=" & m_TimerID
End Sub

Private Sub CommandButton2_Click()
    If m_TimerID <> 0 Then
        Call KillTimer(0, m_TimerID)
        m_TimerID = 0
    End If
End Sub

cheers,
</wqw>

[Dan_W]

The Trick's Timer (in the Codebase) works with 64bit Office, and has the added (underappreciated) benefit of not crashing the host application.

[fafalone]

Unfortunately I don't know nearly enough about assembly to turn that into a general method to get the address of a class member... I was able to turn the thunk back into asm, but that's as far as I can get

0:  48 83 ec 38             sub    rsp,0x38
4:  48 89 4c 24 40          mov    QWORD PTR [rsp+0x40],rcx
9:  48 89 54 24 48          mov    QWORD PTR [rsp+0x48],rdx
e:  4c 89 44 24 50          mov    QWORD PTR [rsp+0x50],r8
13: 4c 89 4c 24 58          mov    QWORD PTR [rsp+0x58],r9
18: 48 b8 00 00 00 00 00    movabs rax,0x0
1f: 00 00 00
22: ff d0                   call   rax
24: 48 85 c0                test   rax,rax
27: 74 06                   je     0x2f
29: 3c 01                   cmp    al,0x1
2b: 74 23                   je     0x50
2d: eb 66                   jmp    0x95
2f: ff 0d c7 ff ff ff       dec    DWORD PTR [rip+0xffffffffffffffc7]        # 0xfffffffffffffffc
35: 48 31 c9                xor    rcx,rcx
38: 48 ba 00 00 00 00 00    movabs rdx,0x0
3f: 00 00 00
42: 48 b8 00 00 00 00 00    movabs rax,0x0
49: 00 00 00
4c: ff d0                   call   rax
4e: eb 45                   jmp    0x95
50: 48 b9 00 00 00 00 00    movabs rcx,0x0
57: 00 00 00
5a: 48 8b 54 24 40          mov    rdx,QWORD PTR [rsp+0x40]
5f: 4c 8b 44 24 48          mov    r8,QWORD PTR [rsp+0x48]
64: 4c 8b 4c 24 50          mov    r9,QWORD PTR [rsp+0x50]
69: 48 8b 44 24 58          mov    rax,QWORD PTR [rsp+0x58]
6e: 48 89 44 24 20          mov    QWORD PTR [rsp+0x20],rax
73: 48 8d 44 24 30          lea    rax,[rsp+0x30]
78: 48 c7 00 00 00 00 00    mov    QWORD PTR [rax],0x0
7f: 48 89 44 24 28          mov    QWORD PTR [rsp+0x28],rax
84: 48 b8 00 00 00 00 00    movabs rax,0x0
8b: 00 00 00
8e: ff d0                   call   rax
90: 48 8b 44 24 30          mov    rax,QWORD PTR [rsp+0x30]
95: 48 83 c4 38             add    rsp,0x38
99: c3                      ret

[wqweto]

The thunk is further patched with these

CopyMemory ByVal pCode + &H1A, m_pEbMode, Len(m_pEbMode)
CopyMemory ByVal pCode + &H44, pfnKillTimer, Len(pfnKillTimer)
CopyMemory ByVal pCode + &H52, ObjPtr(Me), 8
CopyMemory ByVal pCode + &H86, pfnTimerProc, Len(pfnTimerProc)

. . . and finally this

CopyMemory ByVal m_pAsmThunk + &H3A, lIdEvent, Len(lIdEvent)

It’s pfnTimerProc which is the method pfn obtained like this

CopyMemory pVtbl, ByVal ObjPtr(Me), Len(pVtbl)
CopyMemory pfnTimerProc, ByVal pVtbl + (TIMERPROC_INDEX + 7) * Len(pfnTimerProc), Len(pfnTimerProc)

So TIMERPROC_INDEX is 5 for 6-th method of the class (which is private none the less) plus 7 more methods from IDispatch

[fafalone]

right but isn't the code working with EbMode and KillTimer going to interfere with that?

I don't understand this at all... I mean I understand that the timer proc is a vtable entry in the class module vtable, but I don't understand what the asm code is doing at all, how it even winds up getting executed when it looks to me like it's just sitting in memory, and what it would take to generalize it to utilize a callback in other API calls like TaskDialogIndirect.

I've wanted to learn asm but there's just so many interesting things and so little time

[The trick]

That's strange but seems it's a VBA bug (?). I can't make work any code where i use AddressOf operator. It writes the wrong proc descriptor into the dynamic chunk (0x1111111111111111). The simple code with SetTimer causes the same crash on my Word VBA 64 bit. I'll see more details.

[xiaoyao]

I feel like, well, for 64-bit assembly code calls or multi-threaded initialization.Some of the less stable parts can be directly made into a DLL.
com dll,Or a standard DLL with an output function
All we're asking for is stable operation.Running all of this code in the VB6 IDE can produce a lot of unpredictable errors or crashes.
For example, the API hook cannot run in the IDE, and it is stable and normal when compiled into exe.

[xiaoyao]

That's strange but seems it's a VBA bug (?). I can't make work any code where i use AddressOf operator. It writes the wrong proc descriptor into the dynamic chunk (0x1111111111111111). The simple code with SetTimer causes the same crash on my Word VBA 64 bit. I'll see more details.

SetTimer, you can take a look at my code, I have a perfect 64-bit timer in the library, that module.
Supports adding multiple timers to a form.
Do not use any assembly or other methods.

[The trick]

I see it doesn't compile it properly. If you run code and set breakpoint in ShowDialog, then press stop and run again - it works. I find the way to force to make it run properly.

[The trick]

Okay i found the way to make it worked. Just add an empty sub (for example Unused) to mTDHelper and call it from Class_Initialize.

[fafalone]

WOW! That does work! Thanks, have been stuck on that forever! The function will be:

Public Sub MagicalTDInitFunction()
'The trick is a genius.
End Sub

How does this work??

ETA speculation... somehow the functions of the .bas aren't loaded into memory until one of them is called from within VBA? So when the outside DLL first tries to access it, invalid address?

[The trick]

WOW! That does work! Thanks, have been stuck on that forever! The function will be:

Public Sub MagicalTDInitFunction()
'The trick is a genius.
End Sub

How does this work??

ETA speculation... somehow the functions of the .bas aren't loaded into memory until one of them is called from within VBA? So when the outside DLL first tries to access it, invalid address?

There is some asm templates which setups the P-code handlers so when you use this code without initialization of BAS module it doesn't fix the templates in memory (it contains original 0x1111111111111111 template value in P-code proc descriptor). If you re-run it does. I think it's a bug of VBA64.

[wqweto]

I think it's a bug of VBA64.

Very unfortunate but still a great find!

cheers,
</wqw>

[AngelV]

Hi fafalone,

Excel File Demo:
fafalone_TaskDlg.xlsm

First of all, thanks for publishing this nice TakskDlg class which I am sure many vba users will find extremely useful and educational. And thanks The trick for the clever addition.


I have ported the zipped Taskdlg class module to excel\vba for testing and found the following issues:

1- I got run-time error 453 "Can't find entry point to TaskDialogIndirect in ComCtl32.dll.

Solution: I edited the excel.exe.manifest file to add the following dependency entry in order to use the new version of Comctl32 dll. I did this for both, Excel x32bit and Excel x64bit.

<dependency>
<dependentAssembly>
<assemblyIdentity
type="win32"
Name = "Microsoft.Windows.Common - Controls"
version="6.0.0.0"
processorArchitecture = " * "
publicKeyToken = "6595b64144ccf1df"
Language = " * "
/>
</dependentAssembly>
</dependency>

2- In x64, setting a button text crashes the application.

Solution: Added an extra padding entry to the TASKDIALOG_BUTTON UDT as follows:

Private Type TASKDIALOG_BUTTON
    #If Win64 Then
        Padding As Long
    #End If
    nButtonID As Long
    pszButtonText As LongPtr
End Type

3- This is not actually a major issue but more like a design thing. The 3 callback functions (zz_ProcessCallback,zz_ProcessEnumCallback, and zz_ProcessSubclass) shouldn't be exposed to the user of the class to prevent potential problems. In vba, we can't set a class member as hidden via the vbeditor.

Solution:
I added a new Interface class (ICallBacks) for holding the above 3 callbacks. That way, the 3 callbacks remain hidden from the UI and are only seen by the mTDHelper module.

Also, since I replaced tdFARPROC(AddressOf TaskDialogCallbackProc) with this new ProcAddr function located in the mTDHelper module, we no longer need to add the dummy SUB as figured out by The trick

Regards.

[wqweto]

Also, since I replaced tdFARPROC(AddressOf TaskDialogCallbackProc) with this new ProcAddr function located in the mTDHelper module, we no longer need to add the dummy SUB as figured out by The trick

The point of the dummy procedure is to recompile the module which contains the callback functions before using AddressOf on these callback functions so that they are compiled to bytecode in memory. Note that AddressOf operator should have done this in first place but obviously it's a bug in VBA64 as the same operator does not fail in p-code compiled VBA/VB6.

Your ProcAddr is *inside* the module with all the callback functions so serves the same purpose as the dummy procedure. This way all your callbacks are recompiled when you call ProcAddr so it returns correct address to compiled bytecode.

I "suffered" the same success story w/ my timer test above and it worked and circumvented the VBA64 bug by chance.

cheers,
</wqw>

[AngelV]

The point of the dummy procedure is to recompile the module which contains the callback functions before using AddressOf on these callback functions so that they are compiled to bytecode in memory. Note that AddressOf operator should have done this in first place but obviously it's a bug in VBA64 as the same operator does not fail in p-code compiled VBA/VB6.

Your ProcAddr is *inside* the module with all the callback functions so serves the same purpose as the dummy procedure. This way all your callbacks are recompiled when you call ProcAddr so it returns correct address to compiled bytecode.

I "suffered" the same success story w/ my timer test above and it worked and circumvented the VBA64 bug by chance.
</wqw>

That's exactly what I meant to say here:

Also, since I replaced tdFARPROC(AddressOf TaskDialogCallbackProc) with this new ProcAddr function located in the mTDHelper module, we no longer need to add the dummy SUB as figured out by The trick

[fafalone]

I'll look into 2 but that definition is incorrect and will break tB x64. In fact you just inserted padding that already exists in VBA 64 because it doesn't support [ PackingAlignment(1) ], so your StrPtr offset is at the same spot.

It looks like I didn't get around to implementing TASKDIALOG_BUTTON_VBA7.

Update - fixed

I've implemented the VBA64 alternates for TASKDIALOG_BUTTON and checked that the basic custom buttons test was working. All files updated in repository.

https://github.com/fafalone/cTaskDialog64

Thanks for letting me know!

3 is purely stylistic, so I'm going to leave those as-is so as not require further changes for others, but of course you're welcome to modify the class however you like.

1, I'm very surprised to see that happen, as comctl6 has always been enabled for me in recent Office versions without having to modify the manifest myself. I'm wondering how that might have happened, but haven't received any other reports of it-- and everyone would def. be getting that error without comctl6. What OS/Office version?

[AngelV]

@fafalone,

2, Thanks for the new update which now works in both, vba7x64 and TiwnBasic although I personally don't use the latter.

1,

What OS/Office version?

I use Win10 x64bit (excel 2016 x64bit and Excel 2013 x32bit) ... It seems that the excel manifets don't have comctl6 enabled by default... I recall having similar problem before when I tried using the tooltips_class32 in excel 2010 and had to create an activation context for the project @runtime with CreateActCtx

Also, have you considered further updating your taskdlg project to avoid potential GPF errors in the event of a compile error or unhandled runtime error occurring inside any of the TaskDialog events? Don't know about TwinBasic, but in vba, as you probably already know, this is due to subclassing in general and is not specifically due to this particular TaskDlg project.

Private WithEvents TaskDialog1 As cTaskDialog

Private Sub TaskDialog1_ButtonClick(ByVal ButtonID As Long)
    'This crashes the entire host application hence loosing any unsaved work !
    Err.Raise 1
End Sub

It would be amazing if this project could be further improved so that this nice TaskDlg would be more robust and *safer* to use in vba/office applications.

Regards.

[fafalone]

Were you able to figure out a way to use CreateActCtx to enable comctl6 without relying on an included binary w/ resource? The only option I've found for that would be to borrow shell32's, but that would also force dpi awareness on.

I'm not sure how to make it much safer... SetWindowSubclass is already considerably safer than SetWindowLong for that; and for callbacks too... it would be quite painful to implement 3 different subclassing and callback methods, since safer ones for VBx rely on asm thunks manipulating internals. Not sure one even exists for VBA64. If there's somewhere inside my class that's not handling errors that are coming up, I can put in handlers, but outside of it like in user event handlers, not much to be done from my end, though I'm open to suggestions.

[AngelV]

@fafalone,

Were you able to figure out a way to use CreateActCtx to enable comctl6 without relying on an included binary w/ resource? The only option I've found for that would be to borrow shell32's, but that would also force dpi awareness on.

Obviously, I didn't use a resource because it is uncompiled vba. Nor did I borrow the resource from the shell32 or shipped the separate mainfest file along with the xlsm . I simply extracted the dependency xml file bytes and store the bytes into a byte array, then created the temp manifest file on the fly from the byte array and passed the pointer to the temp file path to the ACTCTX.lpSource UDT member... tacky workaround but works and makes the vbaproject more compact and portable.

it would be quite painful to implement 3 different subclassing and callback methods, since safer ones for VBx rely on asm thunks manipulating internals. Not sure one even exists for VBA64

Fair enough. I too have never seen any asm thunks for x64

[fafalone]

I've seen exactly one.. The trick's Timer class. But I don't know asm well enough to generalize it to apply to callbacks alone without timer APIs.

With tB now though there's a much lower barrier to making DLLs or COM objects to extend VBA, since you can do it in the same language.


---
Thanks for the tip on manifest, I'm going to see how widespread the issue is, might be a feature worth incorporating into the class.

[AngelV]

@fafalone,

With tB now though there's a much lower barrier to making DLLs or COM objects to extend VBA, since you can do it in the same language.

I haven't tried twinbasic. Perhaps I am just being too lazy
Can we make *standard* dlls with tB ?

Also, would placing callbback functions inside a compiled dll (the dll being loaded in the vba host process) remedy the notorious GPFs in case of unhandled errors occurring in the client vba ?

Regards.

[fafalone]

Yes tB supports standard DLLs natively; it's a project type you can select from the new project dialog, then you just mark the functions you want to export with [ DllExport ], e.g.

[ DllExport ]
Public Function MyDLLExport(ByVal a As Long) As Long
Return a
End Function

(Return syntax is optional, you can stick to the VB way of assigning the result to the function name). The name will be as-is, not mangled.


--
I was thinking more along the lines of wrapping the functionality, rather than try to put the callback alone in the DLL, which seems like it would be more complicated. But it might be worth experimenting.

For cTaskDialog an ActiveX DLL exposing it as a COM object would be better, but a lot of other things a standard DLL would be.

[loquat]

Okay i found the way to make it worked. Just add an empty sub (for example Unused) to mTDHelper and call it from Class_Initialize.

when i call EbSetMode in VBE7 x64 by using DispCallFunc the vba64 IDE crash too
can you help to check why?

'mDispCallFunc
#If Win64 Then
    Public Declare PtrSafe Function DispCallFunc Lib "oleaut32" (pvInstance As Any, ByVal oVft As LongPtr, ByVal cc As CALLINGCONVENTION_ENUM, ByVal vtReturn As Long, ByVal cActuals As Long, prgvt As Any, prgpvarg As Any, pvargResult As Any) As Long
#Else
    Public Declare Function DispCallFunc Lib "oleaut32" (pvInstance As Any, ByVal oVft As Long, ByVal cc As Long, ByVal vtReturn As Long, ByVal cActuals As Long, prgvt As Any, prgpvarg As Any, pvargResult As Any) As Long
#End If

Public Enum CALLINGCONVENTION_ENUM
  ' http://msdn.microsoft.com/en-us/library/system.runtime.interopservices.comtypes.callconv%28v=vs.110%29.aspx
  CC_FASTCALL = 0&
  CC_CDECL
  CC_PASCAL
  CC_MACPASCAL
  CC_STDCALL                        ' typical windows APIs
  CC_FPFASTCALL
  CC_SYSCALL
  CC_MPWCDECL
  CC_MPWPASCAL
End Enum
Public Enum CALLRETURNTUYPE_ENUM
    CR_None = vbEmpty
    CR_LONG = vbLong
    CR_BYTE = vbByte
    CR_INTEGER = vbInteger
    CR_SINGLE = vbSingle
    CR_DOUBLE = vbDouble
    CR_CURRENCY = vbCurrency
    ' if the value you need isn't in above list, you can pass the value manually to the
    ' CallFunction_DLL method below. For additional values, see:
    ' http://msdn.microsoft.com/en-us/library/cc237865.aspx
End Enum

Public Function CallByPointer( _
                 ByVal pFunc As LongPtr, _
                 ByVal lRetType As VbVarType, _
                 ParamArray vParams() As Variant) As Variant
    Dim iTypes()    As Integer: Dim lList()     As Long
    Dim vParam()    As Variant: Dim lIndex      As Long
    Dim pList       As Long:    Dim pTypes      As Long
    Dim resultCall  As Long
    Dim Convention  As Long
    
    #If Win64 Then
        Convention = CC_FASTCALL
    #Else
        Convention = CC_STDCALL
    #End If

    If LBound(vParams) <= UBound(vParams) Then
        ReDim lList(LBound(vParams) To UBound(vParams))
        ReDim iTypes(LBound(vParams) To UBound(vParams))
        ReDim vParam(LBound(vParams) To UBound(vParams))
        For lIndex = LBound(vParams) To UBound(vParams)
            vParam(lIndex) = vParams(lIndex)
            lList(lIndex) = VarPtr(vParam(lIndex))
            iTypes(lIndex) = VarType(vParam(lIndex))
        Next
        pList = VarPtr(lList(LBound(lList)))
        pTypes = VarPtr(iTypes(LBound(iTypes)))
    End If
    resultCall = DispCallFunc(ByVal 0&, _
                              pFunc, _
                              Convention, _
                              lRetType, _
                              UBound(vParams) - LBound(vParams) + 1, _
                              ByVal pTypes, _
                              ByVal pList, _
                              CallByPointer)
    If resultCall Then Err.Raise 5: Exit Function
End Function




'mSearchFunction
Option Explicit
Option Base 0

Private Const FADF_AUTO As Long = 1

Private Type SAFEARRAYBOUND
    cElements As Long
    lLbound As Long
End Type

Private Type SAFEARRAY
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As LongPtr
    Bounds As SAFEARRAYBOUND
End Type

#If Win64 Then
    Private Declare PtrSafe Sub DupArray Lib "kernel32" _
            Alias "RtlMoveMemory" ( _
            ByRef Destination() As Any, _
            ByRef pSA As Any, _
            Optional ByVal Length As LongPtr = 8)
#Else    'Win64
    Private Declare PtrSafe Sub DupArray Lib "kernel32" _
            Alias "RtlMoveMemory" ( _
            ByRef Destination() As Any, _
            ByRef pSA As Any, _
            Optional ByVal Length As LongPtr = 4)
#End If

Public Function SearchFunction(ByVal pStartScan As LongPtr, ByVal pEndScan As LongPtr, ByVal strHex As String, Optional ByVal offset As Long = 0) As LongPtr
    Dim bData() As Byte
    Dim tSAMap As SAFEARRAY
    Dim lIndex As Long

    tSAMap.cbElements = 1
    tSAMap.cDims = 1
    tSAMap.fFeatures = FADF_AUTO
    tSAMap.Bounds.cElements = CLng(pEndScan - pStartScan) + 1
    tSAMap.pvData = pStartScan
    DupArray bData, VarPtr(tSAMap)
    
    'WriteBinary "c:\1.bin", bData
    
    Dim bTemplate() As Byte
    Dim bMask() As Byte

    Dim arrTemp() As String
    Dim i As Long
    mySplit strHex, arrTemp

    ReDim bTemplate(UBound(arrTemp) - LBound(arrTemp)) As Byte
    ReDim bMask(UBound(arrTemp) - LBound(arrTemp)) As Byte

    For i = LBound(arrTemp) To UBound(arrTemp)
        If arrTemp(i) <> "XX" Then
            bMask(i) = 1
            bTemplate(i) = Val("&H" & arrTemp(i))
        End If
    Next i

    lIndex = FindSignature(bData(), bTemplate(), bMask())
    DupArray bData, 0@
    If lIndex = -1 Then Exit Function
    'CopyMemory SearchFunction, ByVal (pStartScan + lIndex + offset), Len(SearchFunction)
    SearchFunction = pStartScan + lIndex + offset
End Function

Public Sub mySplit(expression$, ResultSplit$(), Optional Delimiter$ = " ")
' By Chris Lucas, cdl1051@earthlink.net, 20011208
    Dim c&, SLen&, DelLen&, Tmp&, Results&()
    SLen = LenB(expression) \ 2
    DelLen = LenB(Delimiter) \ 2
    ' Bail if we were passed an empty delimiter or an empty expression
    If SLen = 0 Or DelLen = 0 Then
        ReDim Preserve ResultSplit(0 To 0)
        ResultSplit(0) = expression
        Exit Sub
    End If
    ReDim Preserve Results(0 To SLen) ' Count delimiters and remember their positions
    Tmp = InStr(expression, Delimiter)
    Do While Tmp
        Results(c) = Tmp
        c = c + 1
        Tmp = InStr(Results(c - 1) + 1, expression, Delimiter)
    Loop
    ReDim Preserve ResultSplit(0 To c) ' Size our return array
    ' Populate the array
    If c = 0 Then
        ResultSplit(0) = expression ' lazy man's call
    Else
        ResultSplit(0) = Left$(expression, Results(0) - 1) ' typical call
        For c = 0 To c - 2
            ResultSplit(c + 1) = Mid$(expression, _
                                      Results(c) + DelLen, _
                                      Results(c + 1) - Results(c) - DelLen)
        Next c
        ResultSplit(c + 1) = Right$(expression, SLen - Results(c) - DelLen + 1)
    End If
End Sub

Public Function FindSignature(ByRef bData() As Byte, ByRef bSignature() As Byte, ByRef bMask() As Byte) As Long
    Dim lDataIndex As Long
    Dim lSignIndex As Long
    lDataIndex = 0: lSignIndex = 0
    Do While lDataIndex <= UBound(bData)
        If bData(lDataIndex) = bSignature(lSignIndex) Or bMask(lSignIndex) = 0 Then
            lSignIndex = lSignIndex + 1
            If lSignIndex > UBound(bSignature) Then               '
                FindSignature = lDataIndex - UBound(bSignature)
                Exit Function
            End If
        Else
            If lSignIndex Then
                lDataIndex = lDataIndex - lSignIndex + 1
                lSignIndex = 0
            End If
        End If
        lDataIndex = lDataIndex + 1
    Loop
    FindSignature = -1
End Function

Public Sub WriteBinary(ByVal strFile As String, arr() As Byte)
    Dim lFile As Integer
    lFile = FreeFile()
    Open strFile For Binary As #lFile
        Put #lFile, , arr
    Close #lFile
End Sub



'mTest
Option Explicit
Option Base 0

Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleW" (ByVal lpModuleName As LongPtr) As LongPtr
Private Declare PtrSafe Sub memcpy Lib "kernel32" Alias "RtlMoveMemory" (dst As Any, src As Any, ByVal Length As Long)

Public Function CallEbSetMode() As String
    Dim hEbSetMode As LongPtr
    Dim hVbe            As LongPtr
    Dim pSection        As LongPtr
    Dim pStartScan      As LongPtr
    Dim pEndScan        As LongPtr
    Dim e_lfanew        As Long
    Dim iNumOfSec       As Integer
    Dim iOptSize        As Integer
    Dim lIndex          As Long
    Dim cName           As Currency
#If VBA7 Then
    hVbe = GetModuleHandle(StrPtr("VBE7"))
#ElseIf VBA6 Then
    hVbe = GetModuleHandle(StrPtr("VBE6"))
#End If
    If hVbe = 0 Then Exit Function
#If VBA6 Or VBA7 Then
    memcpy e_lfanew, ByVal hVbe + &H3C, 4
    memcpy iNumOfSec, ByVal hVbe + e_lfanew + 6, 2
    memcpy iOptSize, ByVal hVbe + e_lfanew + &H14, 2
    pSection = hVbe + e_lfanew + &H18 + iOptSize
    For lIndex = 0 To iNumOfSec - 1
        memcpy cName, ByVal pSection, 8
        If cName = 50023612.1134@ Then
            memcpy pStartScan, ByVal pSection + &HC, 4
            memcpy pEndScan, ByVal pSection + &H8, 4
            pStartScan = pStartScan + hVbe
            pEndScan = pEndScan + pStartScan - 1
            Exit For
        End If
        pSection = pSection + &H28
    Next
    If pStartScan = 0 Or pEndScan = 0 Then Exit Function
#End If
#If Win64 Then
    #If VBA7 Then
        hEbSetMode = SearchFunction(pStartScan, pEndScan, "89 4C 24 08 55 48 8B EC 48 83 EC 50 E8 XX XX XX XX 89 44 24 24 C7 44 24 20 00 00 00 00 E8 XX XX XX XX 48 8B 40 08 48 89 44 24 38 83 7C 24 24 01 75 11 E8 XX XX XX XX 85 C0 74 08 C7", 0)
    #End If
    CallByPointer hEbSetMode, vbLongLong, 2  'it crash here
    CallByPointer hEbSetMode, vbLongLong, 1
#End If
End Function

[fafalone]

Check if hEbSetMode is valid? I don't think VBE7.dll exports it. Also don't think it would take a LongLong; it's not a pointer or handle so would have likely stayed as Long.

[loquat]

Check if hEbSetMode is valid? I don't think VBE7.dll exports it. Also don't think it would take a LongLong; it's not a pointer or handle so would have likely stayed as Long.

i m sure about hEbSetMode because i download one of the pdb file from microsoft

[loquat]

i have load pdb file in Cheat Engine, and the none-exported function EbSetMode seems right
but i just do not know why it crash when call it.

[fafalone]

I was going to file a bug report with MS over this... but I still don't understand it I guess.

.bas:

    Public Sub TimerProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal TimerID As LongPtr, ByVal Tick As Long)
        KillTimer hWnd, TimerID
        Debug.Print "Fired"
    End Sub
    Public Sub Dummy()
    'hi
    End Sub

.cls:

Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Sub RunTest()
SetTimer Application.hWnd, &H410, 10, AddressOf TimerProc
End Sub
Sub RunTest2()
Dummy
SetTimer Application.hWnd, &H410, 10, AddressOf TimerProc
End Sub

I would have expected RunTest2 to work. But it crashes. If I put the KillTimer API in the same bas (it's currently in another), *both* work where I'd expect 1 to still crash. wqweto's sample crashes after executing a couple times and popping up an automation error.

[xiaoyao]

@fafalone,

Obviously, I didn't use a resource because it is uncompiled vba. Nor did I borrow the resource from the shell32 or shipped the separate mainfest file along with the xlsm . I simply extracted the dependency xml file bytes and store the bytes into a byte array, then created the temp manifest file on the fly from the byte array and passed the pointer to the temp file path to the ACTCTX.lpSource UDT member... tacky workaround but works and makes the vbaproject more compact and portable.


Fair enough. I too have never seen any asm thunks for x64

ASM = Create a memory array and use this address as a callback function. The function of the assembly code inside is. Push multiple arguments and then call the procedure address class_callback in the class

sub class_callback(a,b,c,d)

like call in vb6 bas file

sub bas_callback(a,b,c,d)
call class1.class_callback(a,b,c,d)
end sub


sub bas_asm_callback(a,b,c,d)
DispCallFunc objptr(class1),vtable_offset,a,b,c,d
asm:
or asm call objptr(class1),a,b,c,d

[xiaoyao]

Private Function TimerProc( _
ByVal hwnd As LongPtr, _
ByVal uMsg As Long, _
ByVal idEvent As LongPtr, _
ByVal dwTime As Long) As Long

There are four parameters in it. You can use the API to call CallWindowProc Lib "user32" Alias, which becomes five parameters in Class1. There is no way to do this.

[Cristian Buse]

I would have expected RunTest2 to work. But it crashes. If I put the KillTimer API in the same bas (it's currently in another), *both* work where I'd expect 1 to still crash. wqweto's sample crashes after executing a couple times and popping up an automation error.

The problem is the stack argument cleanup on x64. All you have to do to fix the problem is to set the size to 0 to avoid double deallocation. For example:

 
    callbackPtr = VBA.Int(AddressOf TimerProc)
    #If Win64 Then
        Const asmRetOffset As Long = 89
        CopyMemory ByVal callbackPtr + asmRetOffset, 0, 1
    #End If