RtlCaptureStackBackTrace

Module2.bas

Option Explicit

Private Declare PtrSafe _
Function SymInitialize Lib "imagehlp.dll" ( _
    ByVal FramesToSkip As LongPtr, _
    ByVal UserSearchPath As String, _
    ByVal fInvadeProcess As Long _
) As Long

Private Declare PtrSafe _
Function RtlCaptureStackBackTrace Lib "ntdll.dll" ( _
    ByVal hProcess As LongPtr, _
    ByVal FramesToCapture As LongPtr, _
    ByRef BackTrace As Any, _
    ByRef BackTraceHash As Any _
) As Integer

Declare PtrSafe Function GetCurrentProcess Lib "kernel32" () As LongPtr

Private Declare PtrSafe _
Function SymSetOptions Lib "imagehlp.dll" ( _
    ByVal SymOptions As Long _
) As Long

Const SYMOPT_DEFERRED_LOADS = 4
Const SYMOPT_LOAD_LINES = &H10
Const SYMOPT_UNDNAME = 2


Private Declare PtrSafe _
Function SymCleanup Lib "imagehlp.dll" ( _
    ByVal hProcess As LongPtr _
) As Long

Private Declare PtrSafe _
Function SymGetModuleInfo Lib "imagehlp.dll" ( _
    ByVal hProcess As LongPtr, _
    ByVal dwAddr As Long, _
    ByRef ModuleInfo As Any _
) As Long

Private Declare PtrSafe _
Function SymGetSymFromAddr Lib "imagehlp.dll" ( _
    ByVal hProcess As LongPtr, _
    ByVal Address As Long, _
    ByRef Displacement As Any, _
    ByRef Symbol As Any _
) As Long


Private Declare PtrSafe _
Function SymGetLineFromAddr Lib "imagehlp.dll" ( _
    ByVal hProcess As LongPtr, _
    ByVal dwAddr As Long, _
    ByRef pdwDisplacement As Any, _
    ByRef Line As Any _
) As Long

Private Declare Sub OutputDebugString Lib "kernel32" Alias "OutputDebugStringA" (ByVal lpOutputString As Long)

Private Type IMAGEHLP_MODULE
    arg&(1 To 7)
    ModuleName As String * 32
    ImageName As String * 256
    LoadedImageName As String * 256
End Type

Private Type IMAGEHLP_SYMBOL
    arg&(1 To 5)
    Name As String * 260
End Type

Private Type IMAGEHLP_LINE
    arg&(1 To 5)
End Type

Sub hgoe()

    Dim arr&(0 To 9)
    Dim ret%

    Dim hProcess&
    hProcess = GetCurrentProcess
    SymSetOptions (SYMOPT_DEFERRED_LOADS Or SYMOPT_LOAD_LINES Or SYMOPT_UNDNAME)
    
    Debug.Print SymInitialize(hProcess, 0, 1)

    ret = RtlCaptureStackBackTrace(0, 10, arr(0), ByVal 0&)


    Dim i&
    For i = 0 To ret - 1
    
        Dim ModuleInfo As IMAGEHLP_MODULE
        ModuleInfo.arg(1) = Len(ModuleInfo)
        Debug.Print SymGetModuleInfo(hProcess, arr(i), ModuleInfo)
        
        Dim dwTmp&
        dwTmp = 0&
        Dim Symbol As IMAGEHLP_SYMBOL
        Symbol.arg(1) = Len(Symbol)
        Symbol.arg(5) = 260
        Debug.Print SymGetSymFromAddr(hProcess, arr(i), VarPtr(dwTmp), Symbol)
        
        Debug.Print Symbol.Name
        
        Dim Line As IMAGEHLP_LINE
        Line.arg(1) = Len(Line)
        Debug.Print SymGetLineFromAddr(hProcess, arr(i), VarPtr(dwTmp), Line)
        
        Debug.Print Line.arg(3)
        OutputDebugString Line.arg(4)

    Next
    
    SymCleanup hProcess
    
End Sub

Sub func()


End Sub