Posted this on a few different forums, but Access is my home so figured I should post it here, too.
I've been working on a project called VBAStack, which was initially a project that used Microsoft's published symbols for VBE7.dll to call internal functions and read the callstack. Recently however, I found a way to do it entirely without that, and from there, then realised I could actually do it within VBA itself!
I did this by following some internal structures within VBE7.dll / VBA6.dll. The structures themselves are undocumented but a few communities online have figured out most of the fields within the structures. Figured out the rest myself, though.
The general flow goes like this (offsets are for x86, but the code works for both x86/x64);
VBA.Err --> Offset 0x18 of VBAErr, global EbThread address --> global EbThread address + 0xC, global "ExFrameTOS" address (top of the callstack) --> Offset 0x0 of each ExFrame = pointer to next ExFrame in the stack
For each ExFrame;
ExFrame --> Offset 0xC of ExFrame, pointer to "RTMI" (runtime method information) structure --> Offset 0x0 of RTMI, pointer to "ObjectInfo" structure (information about the "Object" the method belongs to - module, class, whatever)
ObjectInfo then leads to a couple of things. Offset 0x24 is a pointer to an array of pointers to more RTMI structs. 0x18 is a pointer to the "Public Object Descriptor", which itself has 2 more interesting pointers - at 0x18 it has a pointer to an ANSI null-terminated string, which is the object name (the name of your class or module). At 0x1C it has a pointer to an array of ANSI null term strings which are the names of the methods.
So for the method name, you find your RTMI pointer in the array of RTMI's on ObjectInfo 0x24 - once you find that, make a note of which element of the array it was. The array of method names on the "Public Object Descriptor" is in the same order, so you can find the name pretty easily. For example if your RTMI was the 2nd element in ObjectInfo's array of RTMIs, your methods name will be the 2nd element in the the "Public Object Descriptor"'s array of names.
99% of the credit for the structure reverse engineering goes to docs I found at the amazing SandSprite.com website - particularly the document there from Alex Ionescu.
See working code below (it assumes it's in a module called "VBAStack").
Note that this code is incredibly rough in all honesty - it could do with adding some more Win32 API calls to check that the addresses it reads with RtlMoveMemory are actually readable, otherwise if something goes wrong it will cause CTD's.
Example usage;
I've been working on a project called VBAStack, which was initially a project that used Microsoft's published symbols for VBE7.dll to call internal functions and read the callstack. Recently however, I found a way to do it entirely without that, and from there, then realised I could actually do it within VBA itself!
I did this by following some internal structures within VBE7.dll / VBA6.dll. The structures themselves are undocumented but a few communities online have figured out most of the fields within the structures. Figured out the rest myself, though.
The general flow goes like this (offsets are for x86, but the code works for both x86/x64);
VBA.Err --> Offset 0x18 of VBAErr, global EbThread address --> global EbThread address + 0xC, global "ExFrameTOS" address (top of the callstack) --> Offset 0x0 of each ExFrame = pointer to next ExFrame in the stack
For each ExFrame;
ExFrame --> Offset 0xC of ExFrame, pointer to "RTMI" (runtime method information) structure --> Offset 0x0 of RTMI, pointer to "ObjectInfo" structure (information about the "Object" the method belongs to - module, class, whatever)
ObjectInfo then leads to a couple of things. Offset 0x24 is a pointer to an array of pointers to more RTMI structs. 0x18 is a pointer to the "Public Object Descriptor", which itself has 2 more interesting pointers - at 0x18 it has a pointer to an ANSI null-terminated string, which is the object name (the name of your class or module). At 0x1C it has a pointer to an array of ANSI null term strings which are the names of the methods.
So for the method name, you find your RTMI pointer in the array of RTMI's on ObjectInfo 0x24 - once you find that, make a note of which element of the array it was. The array of method names on the "Public Object Descriptor" is in the same order, so you can find the name pretty easily. For example if your RTMI was the 2nd element in ObjectInfo's array of RTMIs, your methods name will be the 2nd element in the the "Public Object Descriptor"'s array of names.
99% of the credit for the structure reverse engineering goes to docs I found at the amazing SandSprite.com website - particularly the document there from Alex Ionescu.
See working code below (it assumes it's in a module called "VBAStack").
Note that this code is incredibly rough in all honesty - it could do with adding some more Win32 API calls to check that the addresses it reads with RtlMoveMemory are actually readable, otherwise if something goes wrong it will cause CTD's.
Example usage;
Code:
Private Sub Example()
Dim Frames() As VBAStack.StackFrame
Frames = VBAStack.GetCallstack()
Dim str As String
Dim i As Integer
For i = 0 To UBound(Frames)
str = str & Frames(i).ProjectName & "." & Frames(i).ObjectName & "." & Frames(i).ProcedureName & vbCrLf
Next
MsgBox (str)
' MyMod.Example
' MyMod.Sub2
' Form_Form1.Command0_Click
End Sub
Code:
Option Explicit
'Tested on x86 Access 2003, x86 Access 2013, x86 Access 365, x64 Access 2013, and x64 Access 365.
#If VBA7 = False Then
Private Enum LongPtr
[_]
End Enum
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef lpDest As Any, ByVal lpSource As LongPtr, ByVal cbCopy As Long)
#Else
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef lpDest As Any, ByVal lpSource As LongPtr, ByVal cbCopy As Long)
#End If
#If Win64 Then
Const PtrSize As Integer = 8
#Else
Const PtrSize As Integer = 4
#End If
Public Type StackFrame
ProjectName As String
ObjectName As String
ProcedureName As String
realFrameNumber As Integer
FrameNumber As Integer
Errored As Boolean
End Type
Public Function FrameCount() As Integer
On Error GoTo ErrorOccurred
FrameCount = -1
'Get VBA.Err ptr
Dim errObj As LongPtr
errObj = ObjPtr(VBA.Err)
'Get g_ebThread
Dim g_ebThread As LongPtr
CopyMemory g_ebThread, (errObj + PtrSize * 6), PtrSize
If g_ebThread = 0 Then GoTo ErrorOccurred
'Get g_ExFrameTOS
Dim g_ExFrameTOS As LongPtr
#If Win64 Then
g_ExFrameTOS = g_ebThread + (&H10)
#Else
g_ExFrameTOS = g_ebThread + (&HC)
#End If
If g_ExFrameTOS = 0 Then GoTo ErrorOccurred
'Get top ExFrame
Dim pTopExFrame As LongPtr
CopyMemory pTopExFrame, g_ExFrameTOS, PtrSize
If pTopExFrame = 0 Then GoTo ErrorOccurred
'Loop over frames to count
Dim pExFrame As LongPtr: pExFrame = pTopExFrame
Do
CopyMemory pExFrame, pExFrame, PtrSize
FrameCount = FrameCount + 1
If pExFrame = 0 Then Exit Do
Loop
Exit Function
ErrorOccurred:
End Function
Public Function GetCurrentProcedure() As StackFrame
GetCurrentProcedure = VBAStack.GetStackFrame(2)
End Function
Public Function GetCallstack() As StackFrame()
Dim stackCount As Integer: stackCount = VBAStack.FrameCount
Dim index As Integer: index = 1
Dim FrameArray() As StackFrame
ReDim FrameArray(stackCount - 2)
Do Until index = stackCount
FrameArray(index - 1) = VBAStack.GetStackFrame(index + 1)
index = index + 1
Loop
GetCallstack = FrameArray
End Function
Public Function GetStackFrame(Optional ByVal FrameNumber As Integer = 1) As StackFrame
On Error GoTo ErrorOccurred
If FrameNumber < 1 Then GoTo ErrorOccurred
Dim retVal As StackFrame
retVal.realFrameNumber = FrameNumber
retVal.FrameNumber = FrameNumber - 1
'Get ptr to VBA.Err
Dim errObj As LongPtr
errObj = ObjPtr(VBA.Err)
'Get g_ebThread
Dim g_ebThread As LongPtr
CopyMemory g_ebThread, (errObj + PtrSize * 6), PtrSize
If g_ebThread = 0 Then GoTo ErrorOccurred
'Get g_ExFrameTOS
Dim g_ExFrameTOS As LongPtr
#If Win64 Then
g_ExFrameTOS = g_ebThread + (&H10)
#Else
g_ExFrameTOS = g_ebThread + (&HC)
#End If
If g_ExFrameTOS = 0 Then GoTo ErrorOccurred
'Get top ExFrame
Dim pTopExFrame As LongPtr
CopyMemory pTopExFrame, g_ExFrameTOS, PtrSize
If pTopExFrame = 0 Then GoTo ErrorOccurred
'Get next ExFrame (minimum once as top frame is this procedure)
Dim pExFrame As LongPtr: pExFrame = pTopExFrame
Do
CopyMemory pExFrame, pExFrame, PtrSize
If pExFrame = 0 Then GoTo ErrorOccurred
FrameNumber = FrameNumber - 1
Loop Until FrameNumber = 0
'Get RTMI
Dim pRTMI As LongPtr
CopyMemory pRTMI, (pExFrame + PtrSize * 3), PtrSize
If pRTMI = 0 Then GoTo ErrorOccurred
'Get ObjectInfo
Dim pObjectInfo As LongPtr
CopyMemory pObjectInfo, pRTMI, PtrSize
If pObjectInfo = 0 Then GoTo ErrorOccurred
'Get Public Object Descriptor
Dim pPublicObject As LongPtr
CopyMemory pPublicObject, (pObjectInfo + PtrSize * 6), PtrSize
If pPublicObject = 0 Then GoTo ErrorOccurred
'Get module name pointer from Public Object Descriptor
Dim pObjectName As LongPtr
CopyMemory pObjectName, (pPublicObject + PtrSize * 6), PtrSize
If pObjectName = 0 Then GoTo ErrorOccurred
'Read object name
Dim objName As String
Dim readByteObjName As Byte
Do
CopyMemory readByteObjName, pObjectName, 1
pObjectName = pObjectName + 1
If readByteObjName = 0 Then Exit Do
objName = objName & Chr(readByteObjName)
Loop
retVal.ObjectName = objName
'Get method array from ObjectInfo
Dim pMethodsArr As LongPtr
CopyMemory pMethodsArr, (pObjectInfo + PtrSize * 9), PtrSize
If pMethodsArr = 0 Then GoTo ErrorOccurred
'Get method count from Public Object Descriptor
Dim methodCount As Long
CopyMemory methodCount, (pPublicObject + PtrSize * 7), 4
If methodCount = 0 Then GoTo ErrorOccurred
'Search method array to find our RTMI
Dim methodIndex As Integer: methodIndex = -1
Dim i As Integer
Dim pMethodRTMI As LongPtr
For i = methodCount - 1 To 0 Step -1
CopyMemory pMethodRTMI, (pMethodsArr + PtrSize * i), PtrSize
If pMethodRTMI = 0 Then GoTo ErrorOccurred
If pMethodRTMI = pRTMI Then
methodIndex = i
Exit For
End If
Next
If methodIndex = -1 Then GoTo ErrorOccurred
'Get proc name array from Public Object Descriptor
Dim pMethodNamesArr As LongPtr
CopyMemory pMethodNamesArr, (pPublicObject + PtrSize * 8), PtrSize
If pMethodNamesArr = 0 Then GoTo ErrorOccurred
'Get pointer to proc name
Dim pMethodName As LongPtr
CopyMemory pMethodName, (pMethodNamesArr + PtrSize * methodIndex), PtrSize
If pMethodName = 0 Then GoTo ErrorOccurred
'Read proc name
Dim procName As String
Dim readByteProcName As Byte
Do
CopyMemory readByteProcName, pMethodName, 1
pMethodName = pMethodName + 1
If readByteProcName = 0 Then Exit Do
procName = procName & Chr(readByteProcName)
Loop
retVal.ProcedureName = procName
'Get ObjectTable
Dim pObjectTable As LongPtr
CopyMemory pObjectTable, (pObjectInfo + PtrSize * 1), PtrSize
If pObjectTable = 0 Then GoTo ErrorOccurred
'Get proj name from ObjectTable
Dim pProjName As LongPtr
#If Win64 Then
CopyMemory pProjName, (pObjectTable + &H68), PtrSize
#Else
CopyMemory pProjName, (pObjectTable + &H40), PtrSize
#End If
If pProjName = 0 Then GoTo ErrorOccurred
'Read project name
Dim projName As String
Dim readByteProjName As Byte
Do
CopyMemory readByteProjName, pProjName, 1
pProjName = pProjName + 1
If readByteProjName = 0 Then Exit Do
projName = projName & Chr(readByteProjName)
Loop
retVal.ProjectName = projName
GetStackFrame = retVal
Exit Function
ErrorOccurred:
retVal.Errored = True
GetStackFrame = retVal
End Function
Last edited:
) so I cannot test in that environment.