dcsimg
Results 1 to 1 of 1
  1. #1

    Thread Starter
    Addicted Member
    Join Date
    Aug 2011
    Posts
    164

    Get system information with Windows Management Instrumentation (WMI) and SWbemLocator

    Windows Management Instrumentation (WMI) is the Microsoft implementation of Web-Based Enterprise Management (WBEM), which is an industry initiative to develop a standard technology for accessing management information in an enterprise environment. WMI uses the Common Information Model (CIM) industry standard to represent systems, applications, networks, devices, and other managed components.

    It uses objects such as SWbemLocator, SWbemObjectSet, SWbemObject, SWbemProperty to connect to available WMI services and retrieve data. I had to learn about these for a project I was working on so I thought to include some code in here which may save someone else some get-up-to-speed time. Here is an instructive module which uses WMI and the SWbemLocator object to retrieve raw performance data.

    Place the following code in a module and set a Project reference to the "Microsoft WMI Scripting Library":

    Code:
    Option Explicit
    
    Private Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long
    
    Sub Main()
        Dim lngCurrentProcessID As Long
        lngCurrentProcessID = GetCurrentProcessId
    
        Dim lngErrCode  As Long
        Call GetProcessRawPerformanceData(lngCurrentProcessID, lngErrCode)
    
    End Sub
    
    Private Sub GetProcessRawPerformanceData(ByVal plngProcessID As Long, ByRef plngErrCode As Long)
        On Error GoTo PROC_ERROR
        
        '// Purpose: Get Process Raw Performance data for given process
        '// using Windows Management Instrumentation (WMI)
    
        
        '//These declarations require a reference be set to Microsoft WMI Scripting Library (c:\windows\syswow64\wbemdisp.tlp)
        Dim objLocator      As WbemScripting.SWbemLocator   'Wbem = Web-Based Enterprise Management
        Dim objService      As WbemScripting.SWbemServices
        Dim objProcesses    As WbemScripting.SWbemObjectSet
        Dim objProcess      As WbemScripting.SWbemObject
        Dim objProp         As WbemScripting.SWbemProperty
    
    ''    '//This version of the declarations requires no reference to be set (but is slower than above)
    ''    Dim objLocator      As Object
    ''    Dim objService      As Object
    ''    Dim objProcesses    As Object
    ''    Dim objProcess      As Object
    ''    Dim objProp         As Object
        
        '--Retrieve a locator object
        Dim strObjectName   As String
        strObjectName = "WbemScripting.SWbemLocator"
        
        Set objLocator = CreateObject(strObjectName)
        If objLocator Is Nothing Then
            plngErrCode = vbObjectError
            GoTo PROC_EXIT
        End If
        
        '--Log on to the namespace
        'If you do not specify a computer in the call to ConnectServer,
        'then WMI connects to the local computer. If you do not specify a namespace,
        'then WMI connects to the namespace specified in the registry key.
        Dim strServer       As String
        Dim strNamespace    As String
        
        strServer = "."
        strNamespace = "root\cimv2"
        
        Set objService = objLocator.ConnectServer(strServer, strNamespace)
        If objService Is Nothing Then
            plngErrCode = vbObjectError
            GoTo PROC_EXIT
        End If
        
        '-- query for the desired data
        Dim strProcessID    As String
        Dim strQuery        As String
        
        strProcessID = CStr(plngProcessID)
        strQuery = "Select * from Win32_PerfRawData_PerfProc_Process Where IDProcess = " & strProcessID
        
        Set objProcesses = objService.ExecQuery(strQuery)
        If objProcesses Is Nothing Then
            plngErrCode = vbObjectError
            GoTo PROC_EXIT
        End If
        
        '-- validate results (should be only one process matching the given process ID)
        If objProcesses.Count <> 1 Then
            GoTo PROC_EXIT
        End If
        
        '-- get a reference to the process
        Set objProcess = objProcesses.ItemIndex(0)  '0-based collection
        If objProcess Is Nothing Then
            plngErrCode = vbObjectError
            GoTo PROC_EXIT
        End If
        
        '-- iterate through the process info, getting each Property Name and Value
        Const COLON_SPACE       As String = ": "
        
        Dim strPropName         As String
        Dim strPropValue        As String
        Dim strPropNameAndValue As String
    
        With objProcess
            For Each objProp In .Properties_
                With objProp
                    '...property name
                    strPropName = .Name
                    
                    '...property value
                    If .CIMType = wbemCimtypeString Then
                    
                        'handle Null value case
                        If IsNull(.Value) Then
                            strPropValue = .Value & ""
                        Else
                            strPropValue = .Value
                        End If
                    Else
                        strPropValue = CStr(.Value)
                    End If
                    
                End With
                strPropNameAndValue = strPropName & COLON_SPACE & strPropValue
                
                Debug.Print strPropNameAndValue
            Next
        End With
            
    PROC_EXIT:
        If Not (objProp Is Nothing) Then Set objProp = Nothing
        If Not (objProcess Is Nothing) Then Set objProcess = Nothing
        If Not (objProcesses Is Nothing) Then Set objProcesses = Nothing
        If Not (objService Is Nothing) Then Set objService = Nothing
        If Not (objLocator Is Nothing) Then Set objLocator = Nothing
        
        Exit Sub
        
    PROC_ERROR:
        plngErrCode = Err.Number
        
        Resume PROC_EXIT
        Resume
    End Sub

    Which produces this output in the Immediate window:


    Caption:
    CreatingProcessID: 18148
    Description:
    ElapsedTime: 131716427650480103
    Frequency_Object: 10000000
    Frequency_PerfTime: 2539025
    Frequency_Sys100NS: 10000000
    HandleCount: 584
    IDProcess: 22304
    IODataBytesPersec: 209762
    IODataOperationsPersec: 384
    IOOtherBytesPersec: 48018
    IOOtherOperationsPersec: 3018
    IOReadBytesPersec: 200751
    IOReadOperationsPersec: 372
    IOWriteBytesPersec: 9011
    IOWriteOperationsPersec: 12
    Name: VB6
    PageFaultsPersec: 44630
    PageFileBytes: 84942848
    PageFileBytesPeak: 146866176
    PercentPrivilegedTime: 206250000
    PercentProcessorTime: 249218750
    PercentUserTime: 42968750
    PoolNonpagedBytes: 56880
    PoolPagedBytes: 647552
    PriorityBase: 8
    PrivateBytes: 84942848
    ThreadCount: 14
    Timestamp_Object: 131716434306142289
    Timestamp_PerfTime: 198274349621
    Timestamp_Sys100NS: 131716434306142289
    VirtualBytes: 480518144
    VirtualBytesPeak: 499048448
    WorkingSet: 122535936
    WorkingSetPeak: 143794176
    WorkingSetPrivate: 72695808
    Last edited by AAraya; May 24th, 2018 at 09:04 AM.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width


×
We have made updates to our Privacy Policy to reflect the implementation of the General Data Protection Regulation.