TdhGetEventInformation

[vbwins]

I am doing some ewt work using the ndis packet capture provider. Has anyone had any luck calling TdhGetEventInformation from vb6? I have spent hours both myself and with Claude and chat gpt and all i get is stack corruption after the call

[baka]

did u ask for a c++ example and after that ask AI to translate it into VB6 code?

[VanGoghGaming]

Have you tried to use fafalone's API definitions? Chances are he's got the correct structures with all the unions and stuff.

[fafalone]

Instead of AI try GitHub code search in c/cpp files for actual working examples.

Hard to know what's wrong without code. How you handle the trace info struct is my guess, with the unions and variable c-style array. In my defs I assumed a maximum of 128 descriptors but for production use you may want a dynamic allocation.

[vbwins]

Instead of AI try GitHub code search in c/cpp files for actual working examples.

Hard to know what's wrong without code. How you handle the trace info struct is my guess, with the unions and variable c-style array. In my defs I assumed a maximum of 128 descriptors but for production use you may want a dynamic allocation.

Thanks all. Will take a look at the suggestions. @Faf. Is there an example in codebank where you use it?

[fafalone]

No but I did cover all the tdh definitions, https://github.com/fafalone/WinDevLi...ETW.twin#L2309

[fafalone]

I've got it working using the defs from WinDevLib, so compare your defs to that.

Private Sub dbgTestTDH(pRec As EVENT_RECORD)
    
    
    Dim hr As Long
    Dim tInfo As TRACE_EVENT_INFO_sa
    Dim cb As Long
     
    hr = TdhGetEventInformation(pRec, 0, ByVal vbNullPtr, ByVal vbNullPtr, cb)
    If hr = ERROR_INSUFFICIENT_BUFFER Then
        Dim pInfo As LongPtr = LocalAlloc(LPTR, cb)
        hr = TdhGetEventInformation(pRec, 0, ByVal vbNullPtr, ByVal pInfo, cb)
    Else
        PostLog "TdhGetEventInformation initial call failed, ret=" & hr
        Exit Sub
    End If
    PostLog "TdhGetEventInformation ret=" & hr & ", cb=" & cb
    If hr = ERROR_SUCCESS Then
        CopyMemory tInfo, ByVal pInfo, 112 'Copy everything before the variable c-style array
        PostLog "TdhGetEventInformation provider=" & dbg_GUIDToString(tInfo.ProviderGuid) & "; opcodeoffset=" & tInfo.OpcodeNameOffset & "; propcount=" & tInfo.TopLevelPropertyCount
        If tInfo.ProviderNameOffset Then
            Dim provName As String
            provName = LPWSTRtoStr(pInfo + tInfo.ProviderNameOffset, False)
            PostLog "TdhGetEventInformation provider name=" & provName
        Else
            PostLog "TdhGetEventInformation no provider offset"
        End If
        If tInfo.TopLevelPropertyCount Then
            ReDim tInfo.EventPropertyInfoArray(tInfo.TopLevelPropertyCount - 1)
            CopyMemory tInfo.EventPropertyInfoArray(0), ByVal pInfo + &H70, LenB(Of EVENT_PROPERTY_INFO) * tInfo.TopLevelPropertyCount
            For i As Long = 0 To tInfo.TopLevelPropertyCount - 1
                If tInfo.EventPropertyInfoArray(i).NameOffset Then
                    Dim propName As String
                    propName = LPWSTRtoStr(pInfo + tInfo.EventPropertyInfoArray(i).NameOffset, False)
                    PostLog "TdhGetEventInformation propName[" & i & "]=" & propName
                Else
                    PostLog "no name offset"
                End If
            Next
        End If
    End If
    If pInfo Then LocalFree pInfo
End Sub

Successfully returns the provider guid/name and property names, so looks like everything is being filled in correctly. I'll try to port a more thorough property dump tomorrow.

I'll leave all the copy/pasting and minor adjustments to you to back-port to vb6. Once you get used to just straight coding and not needing to constantly interrupt it to find/copy/paste or port from C all the win32 API defs you'll never want to go back. And etw is particularly bad for the language substitutions and alignment edge cases that are easy to mess up... like my original event tracing project you can't just blindly substitute Currency for ULONGLONG or use a 2xLong LARGE_INTEGER without accounting for it not being a true 8-byte alignment -- watch out for that with WinDevLib defs because it uses LongLong which is a true 8-byte type so there's no manual padding. Doesn't seem to impact the code above but if you go deeper into things it might come up. Plus WOW64 issues. Really should move to tB, it's very strong on supporting these API-based projects; my original ETW project was the first thing I tried in tB, it went great, and that was years ago with major improvements since-- and event tracers I expect will significantly benefit from LLVM optimization which is coming very very soon now, possibly this week.

[fafalone]

Here's a more extensive version, mostly based on this, that reads the full list of property names and values for some common property types.

Private Sub dbgTestTDH(pRec As EVENT_RECORD)
    
    
    Dim hr As Long
    Dim tInfo As TRACE_EVENT_INFO_sa
    Dim cb As Long
     
    hr = TdhGetEventInformation(pRec, 0, ByVal vbNullPtr, ByVal vbNullPtr, cb)
    If hr = ERROR_INSUFFICIENT_BUFFER Then
        Dim pInfo As LongPtr = LocalAlloc(LPTR, cb)
        hr = TdhGetEventInformation(pRec, 0, ByVal vbNullPtr, ByVal pInfo, cb)
    Else
        PostLog "TdhGetEventInformation initial call failed, ret=" & hr
        Exit Sub
    End If
    PostLog "TdhGetEventInformation ret=" & hr & ", cb=" & cb
    If hr = ERROR_SUCCESS Then
        CopyMemory tInfo, ByVal pInfo, 112
        DisplayEventInfo pInfo, tInfo, pRec
    End If
    LocalFree pInfo
End Sub

Private Sub DisplayEventInfo(ByVal pInfo As LongPtr, tInfo As TRACE_EVENT_INFO_sa, pRec As EVENT_RECORD)
    Dim sOut As String
    Dim cb As Long
    Dim hr As Long
    Dim provGuid As String, provName As String
    provGuid = dbg_GUIDToString(tInfo.ProviderGuid)
    If tInfo.ProviderNameOffset Then
        provName = LPWSTRtoStr(pInfo + tInfo.ProviderNameOffset, False)
        ' PostLog "TdhGetEventInformation provider name=" & provName
    Else
        provName = "(unknown)"
        ' PostLog "TdhGetEventInformation no provider offset"
    End If
    provName = provName & " - " & provGuid
    Dim sKW As String
    If tInfo.KeywordsNameOffset Then
        sKW = LPWSTRtoStr(pInfo + tInfo.KeywordsNameOffset, False)
    Else
        sKW = "(none)"
    End If
    Dim sOp As String
    If tInfo.OpcodeNameOffset Then
        sOp = LPWSTRtoStr(pInfo + tInfo.OpcodeNameOffset, False)
    Else
        sOp = "(unknown)"
    End If
    Dim sLvl As String
    If tInfo.LevelNameOffset Then
        sLvl = LPWSTRtoStr(pInfo + tInfo.LevelNameOffset, False)
    Else
        sLvl = "(none)"
    End If
    
    sOut = "Provider: " & provName & vbCrLf & _
            "Keywords: " & sKW & vbCrLf & _
            "OpCode: " & sOp & vbCrLf & _
            "Level: " & sLvl & vbCrLf & _
            "Property count: " & tInfo.TopLevelPropertyCount
    PostLog sOut
    sOut = ""
    Dim pointerSize As Long = If(pRec.EventHeader.Flags And EVENT_HEADER_FLAG_32_BIT_HEADER, 4&, 8&)
    
    Dim sPropCnt As String = tInfo.TopLevelPropertyCount
    Dim sPropNames() As String
    Dim sPropValues() As String
    ReDim sPropNames(tInfo.TopLevelPropertyCount - 1)
    ReDim sPropValues(tInfo.TopLevelPropertyCount - 1)
    Dim userlen = pRec.UserDataLength
    Dim data As LongPtr = pRec.UserData
    If tInfo.TopLevelPropertyCount Then
        ReDim tInfo.EventPropertyInfoArray(tInfo.TopLevelPropertyCount - 1)
        CopyMemory tInfo.EventPropertyInfoArray(0), ByVal pInfo + &H70, LenB(Of EVENT_PROPERTY_INFO) * tInfo.TopLevelPropertyCount
        For i As Long = 0 To tInfo.TopLevelPropertyCount - 1
            With tInfo.EventPropertyInfoArray(i)
                If .NameOffset Then
                    sPropNames(i) = LPWSTRtoStr(pInfo + .NameOffset, False)
                    ' PostLog "TdhGetEventInformation propName[" & i & "]=" & propName
                Else
                    sPropNames(i) = "(unknown)"
                End If
            
                If (.Flags And (PropertyStruct Or PropertyParamCount)) = 0 Then
                    Dim mapInfo As EVENT_MAP_INFO_sa
                    Dim mapBuffer As LongPtr
                    Dim mapName As String
                    Dim lRetMap As Long
                    If .OffsetOrPadding Then '.nonStructType.MapNameOffset
                        mapName = LPWSTRtoStr(pInfo + .OffsetOrPadding, False)
                        hr = TdhGetEventMapInformation(pRec, StrPtr(mapName), ByVal vbNullPtr, cb)
                        If hr = ERROR_INSUFFICIENT_BUFFER Then
                            mapBuffer = LocalAlloc(LPTR, cb)
                            hr = TdhGetEventMapInformation(pRec, StrPtr(mapName), ByVal mapBuffer, cb)
                            If hr = ERROR_SUCCESS Then lRetMap = 1
                        End If
                    End If
                    
                    Dim value(511) As Integer
                    Dim vsize As Long = 1024
                    Dim consumed As Integer = 0
                    Dim length As Long = 0
                    Erase value
                    If (.InTypeOrStartIndex = TDH_INTYPE_BINARY) And (.OutTypeOrNumMembers = TDH_OUTTYPE_IPV6) Then
                        length = LenB(Of IN6_ADDR)
                    End If
                    
                    If (.Flags And PropertyParamLength) Then
                        Dim index As Integer = .Length
                        Dim desc As PROPERTY_DATA_DESCRIPTOR
                        desc.ArrayIndex = ULONG_MAX
                        desc.PropertyName = StrPtr(sPropNames(i))
                        TdhGetPropertySize pRec, 0, ByVal vbNullPtr, 1, desc, length
                    End If
                    
                    Dim lRet As Long = TdhFormatProperty(ByVal pInfo, ByVal mapBuffer, pointerSize, _
                                    .InTypeOrStartIndex, .OutTypeOrNumMembers, CUIntToInt(length), _
                                    userlen, ByVal data, vsize, value(0), consumed)
                    ' PostLog "Prop[" & i & "] name=" & sPropNames(i) & " intype=" & .InTypeOrStartIndex & " length(in)=" & length & " consumed=" & consumed & " lRet=" & lRet
                    If lRet = ERROR_SUCCESS Then
                        sPropValues(i) = WCHARtoStr(value)
                        length = consumed
                    ElseIf mapBuffer Then
                        PostLog "ElseIf mapBuffer Then"
                        lRet = TdhFormatProperty(ByVal pInfo, ByVal vbNullPtr, pointerSize, _
                                .InTypeOrStartIndex, .OutTypeOrNumMembers, CUIntToInt(length), _
                                userlen, ByVal data, vsize, value(0), consumed)
                        If lRet = ERROR_SUCCESS Then
                            sPropValues(i) = WCHARtoStr(value)
                        Else
                            sPropValues(i) = "(Error " & lRet & ")"
                            length = FallbackPropertySize(.InTypeOrStartIndex, pointerSize)
                        End If
                    Else
                         sPropValues(i) = "Failed to get value"
                         length = FallbackPropertySize(.InTypeOrStartIndex, pointerSize)
                    End If
                Else
                    sPropValues(i) = "(Unhandled complex property)"
                End If
            
            End With
            Dim cbAdvance As Long = If(length = 0, consumed, length)
            userlen -= CInt(cbAdvance)
            data += cbAdvance
        Next
    End If
    
    If tInfo.TopLevelPropertyCount Then
        For j As Long = 0 To tInfo.TopLevelPropertyCount - 1
            sOut = sOut & "Property[" & j & "]: " & sPropNames(j) & " = " & sPropValues(j) & vbCrLf
        Next
        PostLog sOut
    End If
    If mapBuffer Then LocalFree mapBuffer
 
End Sub

Private Function FallbackPropertySize(ByVal inType As Integer, ByVal pointerSize As Long) As Long
    Select Case inType
        Case TDH_INTYPE_UNICODESTRING, TDH_INTYPE_ANSISTRING
            FallbackPropertySize = 0  ' can't safely skip, variable length
        Case TDH_INTYPE_INT8, TDH_INTYPE_UINT8
            FallbackPropertySize = 1
        Case TDH_INTYPE_INT16, TDH_INTYPE_UINT16
            FallbackPropertySize = 2
        Case TDH_INTYPE_INT32, TDH_INTYPE_UINT32, TDH_INTYPE_HEXINT32, TDH_INTYPE_FLOAT
            FallbackPropertySize = 4
        Case TDH_INTYPE_INT64, TDH_INTYPE_UINT64, TDH_INTYPE_HEXINT64, TDH_INTYPE_DOUBLE, TDH_INTYPE_FILETIME
            FallbackPropertySize = 8
        Case TDH_INTYPE_POINTER, TDH_INTYPE_SIZET
            FallbackPropertySize = pointerSize
        Case TDH_INTYPE_GUID
            FallbackPropertySize = 16
        Case TDH_INTYPE_SYSTEMTIME
            FallbackPropertySize = 16
        Case Else
            FallbackPropertySize = 0  ' unknown, can't skip safely
    End Select
End Function

The main problem it has is the legacy MOF types report handles as 4 bytes when the kernel logger emits 8.

Not sure what your NDIS provider is using but TDH doesn't seem ideal for MOF events.