Microsoft KB Archive/296526

{|
 * width="100%"|

INFO: Collecting Performance Data Using PDH APIs from Visual Basic

 * }

Q296526

-

The information in this article applies to:


 * Microsoft Win32 Application Programming Interface (API), used with:
 * the operating system: Microsoft Windows 2000
 * the operating system: Microsoft Windows NT 4.0

-

SUMMARY
Performance Data Helper (PDH) APIs can be used to collect performance data from various performance counters or instances that are available on the system. This article demonstrates the PDH API calls needed to collect performance data of a given performance object, counter, and instance name from Microsoft Visual Basic.

MORE INFORMATION
The following sample code has a function called ConstructCounterPath which constructs the counter path as required by the PdhAddCounter API for the specified performance object, counter, and instance names. Command1_Click below constructs an array of counter paths that an application is interested in collecting the performance data from and then calls the CollectAndDisplayPerformanceData Visual Basic helper procedure.

CollectAndDisplayPerformanceData interfaces with PDH APIs to collect/display performance data values.

The hex error codes returned by PDH APIs are defined in the Pdhmsg.h header file.

Option Explicit

' PDH API Success Status Private Const ERROR_SUCCESS = 0

Const PERF_SIZE_LARGE = &H100

Const PDH_FMT_LONG = &H100

Private Type PDH_COUNTER_INFO dwLength As Long dwType As Long CVersion As Long CStatus As Long lScale As Long lDefaultScale As Long dwUserData As Long dwQueryUserData As Long szFullPath As Long szMachineName As Long szObjectName As Long szInstanceName As Long szParentInstance As Long dwInstanceIndex As Long szCounterName As Long szExplainText As Long DataBuffer As Long End Type

Private Type PDH_FMT_COUNTERVALUE CStatus As Long unionPadding As Long longValue As Long extraBytes As Long End Type

Private Declare Function PdhOpenQuery Lib &quot;pdh&quot; Alias &quot;PdhVbOpenQuery&quot; _ (ByRef hQuery As Long) As Long Private Declare Function PdhCloseQuery Lib &quot;pdh&quot; _ (ByVal hQuery As Long) As Long Private Declare Function PdhCollectQueryData Lib &quot;pdh&quot; _ (ByVal hQuery As Long) As Long Private Declare Function PdhAddCounter Lib &quot;pdh&quot; Alias &quot;PdhVbAddCounter&quot; _ (ByVal hQuery As Long, _           ByVal counterPath As String, _            ByRef hCounter As Long) As Long Private Declare Function PdhRemoveCounter Lib &quot;pdh&quot; _ (ByVal hCounter As Long) As Long Private Declare Function PdhVbGetDoubleCounterValue Lib &quot;pdh&quot; _ (ByVal hCounter As Long, _       ByRef CounterStatus As Long) As Double Private Declare Function PdhVbIsGoodStatus Lib &quot;pdh&quot; _ (ByVal StatusValue As Long) As Long Private Declare Function PdhGetFormattedCounterValue Lib &quot;pdh&quot; _ (ByVal hCounter As Long, _       ByVal dwFormat As Long, _        lpdwType As Long, _        pValue As PDH_FMT_COUNTERVALUE) As Long Private Declare Function PdhGetCounterInfo Lib &quot;pdh&quot; Alias &quot;PdhGetCounterInfoA&quot; _ (ByVal hCounter As Long, _       ByVal bRetrieveExplainText As Long, _        pdwBufferSize As Long, _        lpBuffer As Any) As Long

Private Declare Sub CopyMemory Lib &quot;kernel32&quot; Alias &quot;RtlMoveMemory&quot; _ (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long) Private Declare Sub Sleep Lib &quot;kernel32&quot; (ByVal dwMillseconds As Long)

Private Sub CollectAndDisplayPerformanceData(ByRef counterPath As String)

Dim ret As Long Dim hQuery As Long Dim index As Long Dim maxIndex As Long Dim value As Double Dim counterValue As PDH_FMT_COUNTERVALUE Dim bufferSize As Long Dim counterInfo As PDH_COUNTER_INFO Dim dwType As Long

hQuery = 0

maxIndex = UBound(counterPath) ReDim hCounters(0 To maxIndex) ReDim counterTypes(0 To maxIndex)

' Create a PDH Query ret = PdhOpenQuery(hQuery) If ret <> ERROR_SUCCESS Then Debug.Print &quot;PdhOpenQuery failed with error code : &quot; & Hex(ret) Exit Sub End If

' Add a counter to the query for the counterPath specified. ' If there are multiple counters to be monitored add them to ' created PDH query For index = 0 To maxIndex ret = PdhAddCounter(hQuery, counterPath(index), hCounters(index)) If ret <> ERROR_SUCCESS Then Debug.Print &quot;PdhAddCounter failed with error code : &quot; & Hex(ret) GoTo Cleanup End If   'Get the counter type information for the counter created bufferSize = 0 ret = PdhGetCounterInfo(hCounters(index), 0, bufferSize, ByVal 0) ReDim lpBuffer(bufferSize) ret = PdhGetCounterInfo(hCounters(index), 0, bufferSize, lpBuffer(0)) If ret <> ERROR_SUCCESS Then Debug.Print &quot;PdhGetCounterInfo failed with error code : &quot; & Hex(ret) GoTo Cleanup End If   CopyMemory counterInfo, lpBuffer(0), Len(counterInfo) counterTypes(index) = counterInfo.dwType Next

' Collect the first snapshot of performance data for all counters. ' We ignore the first snapshot as most performance counters require two ' snapshots to get a calculated value ret = PdhCollectQueryData(hQuery) If ret <> ERROR_SUCCESS Then Debug.Print &quot;PdhCollectQueryData failed with error code : &quot; & Hex(ret) GoTo Cleanup End If

Dim nMaxCollections As Long Dim nCollection As Long

nCollection = 0 nMaxCollections = 10 For nCollection = 1 To nMaxCollections 'Sleep for a while between each collection Sleep (1000) ' Collect the next snapshot of performance data. ret = PdhCollectQueryData(hQuery) If ret <> ERROR_SUCCESS Then Debug.Print &quot;PdhCollectQueryData failed with error code : &quot; & Hex(ret) GoTo Cleanup End If   ' Get Calculated performance data values for each counter and display them For index = 0 To maxIndex ' Check if it is a LARGE counter type. If counterTypes(index) And PERF_SIZE_LARGE Then value = PdhVbGetDoubleCounterValue(hCounters(index), ret) If PdhVbIsGoodStatus(ret) = 0 Then Debug.Print &quot;PdhVbGetDoubleCounterValue &quot; & counterPath(index) & &quot; failed with error code : &quot; & Hex(ret) Else Debug.Print counterPath(index) & &quot; [&quot; & value & &quot;]&quot; End If       Else ret = PdhGetFormattedCounterValue(hCounters(index), _                       PDH_FMT_LONG, dwType, counterValue) If ret <> ERROR_SUCCESS Then Debug.Print &quot;PdhGetFormattedCounterValue &quot; & counterPath(index) & &quot; failed with error code : &quot; & Hex(ret) Else Debug.Print counterPath(index) & &quot; [&quot; & counterValue.longValue & &quot;]&quot; End If       End If    Next

Next

Cleanup:

' If hQuery has been created If hQuery <> 0 Then For index = 0 To maxIndex ' Remove all the counters that have been added successfully, from the query If (hCounters(index) <> 0) Then ret = PdhRemoveCounter(hCounters(index)) If ret <> ERROR_SUCCESS Then Debug.Print &quot;PdhRemoveCounter failed with error code : &quot; & Hex(ret) End If       End If    Next ret = PdhCloseQuery(hQuery) If (ret <> ERROR_SUCCESS) Then Debug.Print &quot;PdhCloseQuery failed with error code : &quot; & Hex(ret) End If End If

End Sub

Private Function ConstructCounterPath(ByVal szMachineName As String, _       ByVal szObjectName As String, ByVal szCounterName As String, ByVal szInstanceName As String) As String Dim counterPath As String counterPath = &quot;&quot;

' If szMachineName is specified If Len(szMachineName) Then counterPath = &quot;\\&quot; + szMachineName End If

counterPath = counterPath + &quot;\&quot; + szObjectName

' If szInstanceName is specified If Len(szInstanceName) Then counterPath = counterPath + &quot;(&quot; + szInstanceName + &quot;)&quot; End If

counterPath = counterPath + &quot;\&quot; + szCounterName

ConstructCounterPath = counterPath

End Function

Private Sub Command1_Click

Dim counterPath(0 To 5) As String

'Performance Counters that have instance names counterPath(0) = ConstructCounterPath(&quot;PRABAGAR4&quot;, &quot;Processor&quot;, &quot;% Processor Time&quot;, &quot;0&quot;) counterPath(1) = ConstructCounterPath(&quot;PRABAGAR4&quot;, &quot;Process&quot;, &quot;% Processor Time&quot;, &quot;csrss&quot;)

'Performance Counters that DOES NOT have instance names counterPath(2) = ConstructCounterPath(&quot;SERVERNAME&quot;, &quot;System&quot;, &quot;Processes&quot;, vbNullString) counterPath(3) = ConstructCounterPath(&quot;SERVERNAME&quot;, &quot;System&quot;, &quot;Threads&quot;, vbNullString) counterPath(4) = ConstructCounterPath(&quot;SERVERNAME&quot;, &quot;Objects&quot;, &quot;Events&quot;, vbNullString) counterPath(5) = ConstructCounterPath(&quot;SERVERNAME&quot;, &quot;Objects&quot;, &quot;Mutexes&quot;, vbNullString)

CollectAndDisplayPerformanceData counterPath

End Sub