Code:
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.
Reply With Quote