Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

WMI (query) functions

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBWin/PBCC WMI (query) functions

    Here's a WMI query function w/ some helpers using inversion of control. Provides access to strings, numbers, and dates by names.

    Code:
    #INCLUDE ONCE "WIN32API.INC"
    #INCLUDE ONCE "WMI.INC"
    ' Use this pattern for all code pointers
    SUB WmiItem()
    END SUB
    %DISPATCH_METHOD         = 1
    %DISPATCH_PROPERTYGET    = 2
    %DISPATCH_PROPERTYPUT    = 4
    %DISPATCH_PROPERTYPUTREF = 8
    ' ********************************************************************************************
    ' EXCEPINFO structure
    ' ********************************************************************************************
    'TYPE EXCEPINFO
    '   wCode AS WORD               ' An error code describing the error.
    '   wReserved AS WORD           ' Reserved
    '   bstrSource AS DWORD         ' Source of the exception.
    '   bstrDescription AS DWORD    ' Textual description of the error.
    '   bstrHelpFile AS DWORD       ' Help file path.
    '   dwHelpContext AS DWORD      ' Help context ID.
    '   pvReserved AS DWORD         ' Reserved.
    '   pfnDeferredFillIn AS DWORD  ' Pointer to function that fills in Help and description info.
    '   scode AS DWORD              ' An error code describing the error.
    'END TYPE
    ' ********************************************************************************************
    ' ********************************************************************************************
    ' Helper function to calculate the VTable address.
    ' ********************************************************************************************
    FUNCTION TB_VTableAddress (BYVAL pthis AS DWORD, BYVAL dwOffset AS DWORD) AS DWORD
       LOCAL ppthis AS DWORD PTR
       LOCAL pvtbl AS DWORD PTR
       LOCAL ppmethod AS DWORD PTR
       ppthis = pthis
       pvtbl = @ppthis
       ppmethod = pvtbl + dwOffset
       FUNCTION = @ppmethod
    END FUNCTION
    ' ********************************************************************************************
    ' ********************************************************************************************
    ' Maps a single member to a corresponding DispID, which can be used on subsequent calls to
    ' IDispatch_Invoke.
    ' Parameters:
    ' riid
    '   Reserved for future use. Must be IID_NULL.
    ' strName
    '   Name to be mapped.
    ' rgDispId
    '   Retrieved DispID value.
    ' Return Value:
    '   The return value obtained from the returned HRESULT is one of the following:
    '   %S_OK                Success
    '   %E_OUTOFMEMORY       Out of memory
    '   %DISP_E_UNKNOWNNAME  One or more of the names were not known. The returned array of DISPIDs
    '                        contains DISPID_UNKNOWN for each entry that corresponds to an unknown name.
    '   %DISP_E_UNKNOWNLCID  The locale identifier (LCID) was not recognized.
    ' ********************************************************************************************
    DECLARE FUNCTION Proto_IDispatch_GetIDOfName (BYVAL pthis AS DWORD, BYREF riid AS GUID, BYref rgszNames AS string, BYVAL cNames AS DWORD, BYVAL lcid AS DWORD, BYref rgdispid AS long) AS DWORD
    FUNCTION IDispatch_GetIDOfName (BYVAL pthis AS DWORD, BYref strName AS string, BYref rgdispid AS long) AS DWORD
       LOCAL HRESULT AS DWORD
       LOCAL pmethod AS DWORD
       local riid as guid
       if pthis = 0 then exit function
       pmethod = TB_VTableAddress (pthis, 20)
       CALL DWORD pmethod USING Proto_IDispatch_GetIDOfName (pthis, riid, strName, 1, 0, rgdispid) TO HRESULT
       FUNCTION = HRESULT
    END FUNCTION
    ' ********************************************************************************************
    ' ********************************************************************************************
    ' Provides access to properties and methods exposed by an object. The dispatch function DispInvoke
    ' provides a standard implementation of IDispatch_Invoke.
    ' Parameters:
    ' dispIdMember
    '   Identifies the member. Use GetIDsOfNames or the object's documentation to obtain the dispatch identifier.
    ' riid
    '    Reserved for future use. Must be IID_NULL.
    ' lcid
    '   The locale context in which to interpret arguments. The lcid is used by the GetIDsOfNames
    '   function, and is also passed to IDispatch_Invoke to allow the object to interpret its
    '   arguments specific to a locale.
    '   Applications that do not support multiple national languages can ignore this parameter.
    ' wFlags
    '   Flags describing the context of the Invoke call, include:
    '     %DISPATCH_METHOD
    '       The member is invoked as a method. If a property has the same name, both this and the
    '       %DISPATCH_PROPERTYGET flag may be set.
    '     %DISPATCH_PROPERTYGET
    '       The member is retrieved as a property or data member.
    '     %DISPATCH_PROPERTYPUT
    '       The member is changed as a property or data member.
    '     %DISPATCH_PROPERTYPUTREF
    '       The member is changed by a reference assignment, rather than a value assignment. This
    '       flag is valid only when the property accepts a reference to an object.
    ' pDispParams
    '   Pointer to a structure containing an array of arguments, an array of argument DISPIDs for
    '   named arguments, and counts for the number of elements in the arrays.
    ' pVarResult
    '   Pointer to the location where the result is to be stored, or NULL if the caller expects no
    '   result. This argument is ignored if DISPATCH_PROPERTYPUT or DISPATCH_PROPERTYPUTREF is specified.
    ' pExcepInfo
    '   Pointer to a structure that contains exception information. This structure should be filled
    '   in if DISP_E_EXCEPTION is returned. Can be NULL.
    ' puArgErr
    '   The index within rgvarg of the first argument that has an error. Arguments are stored in
    '   pDispParams->rgvarg in reverse order, so the first argument is the one with the highest index
    '   in the array. This parameter is returned only when the resulting return value is
    '   %DISP_E_TYPEMISMATCH or %DISP_E_PARAMNOTFOUND. This argument can be set to null.
    ' Return Value:
    '   The return value obtained from the returned HRESULT is one of the following:
    '   %S_OK                     Success
    '   %DISP_E_BADPARAMCOUNT     The number of elements provided to DISPPARAMS is different from the
    '                             number of arguments accepted by the method or property.
    '   %DISP_E_BADVARTYPE        One of the arguments in rgvarg is not a valid variant type.
    '   %DISP_E_EXCEPTION         The application needs to raise an exception. In this case, the
    '                             structure passed in pExcepInfo should be filled in.
    '   %DISP_E_MEMBERNOTFOUND    The requested member does not exist, or the call to Invoke tried to
    '                             set the value of a read-only property.
    '   %DISP_E_NONAMEDARGS       This implementation of IDispatch does not support named arguments.
    '   %DISP_E_OVERFLOW          One of the arguments in rgvarg could not be coerced to the specified type.
    '   %DISP_E_PARAMNOTFOUND     One of the parameter DISPIDs does not correspond to a parameter on
    '                             the method. In this case, puArgErr should be set to the first
    '                             argument that contains the error.
    '   %DISP_E_TYPEMISMATCH      One or more of the arguments could not be coerced. The index within
    '                             rgvarg of the first parameter with the incorrect type is returned
    '                             in the puArgErr parameter.
    '   %DISP_E_UNKNOWNINTERFACE  The interface identifier passed in riid is not IID_NULL.
    '   %DISP_E_UNKNOWNLCID       The member being invoked interprets string arguments according to
    '                             the LCID, and the LCID is not recognized. If the LCID is not needed
    '                             to interpret arguments, this error should not be returned.
    '   %DISP_E_PARAMNOTOPTIONAL  A required parameter was omitted.
    ' ********************************************************************************************
    FUNCTION IDispatch_Invoke (BYVAL pthis AS DWORD, BYVAL dispidMember AS LONG, BYREF riid AS GUID, _
    BYVAL lcid AS DWORD, BYVAL wFlags AS WORD, BYREF pdispparams AS DISPPARAMS, BYREF pvarResult AS VARIANT, _
    BYREF pexcepinfo AS EXCEPINFO, BYREF puArgErr AS DWORD) AS DWORD
       LOCAL HRESULT AS DWORD
       LOCAL pmethod AS DWORD
       if pthis = 0 then exit function
       pmethod = TB_VTableAddress (pthis, 24)
       CALL DWORD pmethod USING IDispatch_Invoke (pthis, dispidMember, riid, lcid, wFlags, pdispparams, pvarResult, pexcepinfo, puArgErr) TO HRESULT
       FUNCTION = HRESULT
    END FUNCTION
    ' ********************************************************************************************
    ' ********************************************************************************************
    ' CallByName
    ' ********************************************************************************************
    function TB_CallByName ( _
        BYVAL pthis AS DWORD, _                                    ' *IDispatch
        BYVAL vNameOrId AS VARIANT, _                              ' Name or identifier
        byval callType as long, _                                  ' Call type
        byref vParams() as VARIANT, _                              ' Array of variants
        byref vResult as variant, _                                ' Variant result
        byref pex as EXCEPINFO _                                   ' EXCEPINFO
        ) EXPORT AS LONG                                           ' Error code
        dim dw_puArgErr AS DWORD, DISPID_PROPERTYPUT AS LONG, IID_NULL AS GUID
        dim vArgs(0) AS VARIANT, udt_DispParams AS DISPPARAMS
        dim strName as string, DispID as long, nParams as long, i as long, idx as long
        ' Check for null pointer
        if pthis = 0 then function = -1 : exit function
        ' Get the DispID
        if variantvt(vNameOrId) = %VT_BSTR then
           strName = ucode$(variant$(vNameOrId))
           IDispatch_GetIDOfName pthis, strName, DispID
        else
           DispID = variant#(vNameOrId)
        end if
        ' Copy the array in reversed order
        if varptr(vParams()) then
           nParams = ubound(vParams) - lbound (vParams) + 1
           if nParams > 0 then
              redim vArgs(nParams - 1)
              idx = nParams - 1
              for i = Lbound(vParams) to Ubound(vParams)
                 if variantvt(vParams(i)) = %VT_EMPTY then
                    vArgs(idx) = error %DISP_E_PARAMNOTFOUND
                 else
                    vArgs(idx) = vParams(i)
                 end if
                 DECR idx
                 if idx < 0 then exit for
              next
           end if
       end if
       if CallType = 4 or CallType = 8 then  ' %DISPATCH_PROPERTYPUT and %DISPATCH_PROPERTYPUTREF
          DISPID_PROPERTYPUT = -3
          udt_DispParams.CountNamed = 1
          udt_DispParams.NamedDispId = VARPTR(DISPID_PROPERTYPUT)
       end if
       udt_DispParams.CountArgs = nParams
       if nParams > 0 then udt_DispParams.VariantArgs = varptr(vArgs(0))
       function = IDispatch_Invoke(pthis, DispID, IID_NULL, 0, CallType, udt_DispParams, vResult, pex, dw_puArgErr)
    END function
    ' ********************************************************************************************
    GLOBAL oItem AS DISPATCH
      
    SUB WmiQuery(computerName As String, query As String, perItem As DWORD)
     LOCAL hr AS LONG                                  ' HRESULT
     LOCAL pService AS ISWbemServices                  ' Services object
     LOCAL pObjectSet AS ISWbemObjectSet               ' ISWbemObjectSet interface
     LOCAL pEnum AS IEnumVariant                       ' Generic collection's enumerator reference
     LOCAL strDisplayName AS STRING                    ' Display name
     LOCAL strQuery AS STRING                          ' Query string
     LOCAL vItem AS VARIANT                            ' Generic object variant
     LOCAL vRes AS VARIANT                             ' General purpose variant
     ' Connect to WMI using a moniker
     IF LEN(computerName) = 0 THEN computerName = "."
     strDisplayName = "winmgmts:{impersonationLevel=impersonate}!\\" & computerName & "\root\CIMV2"
     pService = WmiGetObject(strDisplayName)
     IF ISNOTHING(pService) THEN EXIT SUB
     ' Execute a query to get a reference to the collection of objects
     strQuery = UCODE$(query):
     pObjectSet = pService.ExecQuery(strQuery, UCODE$("WQL"), %wbemFlagReturnImmediately)
     IF ISNOTHING(pObjectSet) THEN EXIT SUB
     pEnum = pObjectSet.NewEnum_:                       ' Retrieve a reference to the collection's enumerator
     IF ISNOTHING(pEnum) THEN EXIT SUB
     ' Iterate through the collection of objects
     DO
      hr = pEnum.Next(1, vItem, BYVAL %NULL):         ' Retrieve a reference to the next object in the collection
      IF hr <> %S_OK THEN EXIT DO
      oItem = vItem :                                 ' Assign the VT_DISPATCH variant to the object variable
      vItem = EMPTY
      IF ISNOTHING(oItem) THEN EXIT DO
      CALL DWORD perItem USING WmiItem
      oItem = NOTHING:                                ' Release the object
     LOOP
     pEnum = NOTHING: ' Release the enumerator
     pObjectSet = NOTHING: ' Release the collection
     pService = NOTHING: ' Release the service
    END SUB
    FUNCTION WmiGetStr(propName As String) As String
     Dim res AS Variant
     Dim ret As LONG
     ret = TB_CallByName( ObjPtr(oItem), propName, %DISPATCH_PROPERTYGET,  byval %NULL, res, ByVal %NULL)
     FUNCTION = VARIANT$(res)
    END FUNCTION
    FUNCTION WmiGetNum(propName As String) As Long
     Dim res AS Variant
     Dim hr As Long
     hr = TB_CallByName( ObjPtr(oItem), propName, %DISPATCH_PROPERTYGET,  byval %NULL, res, ByVal %NULL)
     FUNCTION = VARIANT#(res)
    END FUNCTION
    FUNCTION WmiGetLocalDate(propName As String) As String
     Dim res AS Variant
     Dim hr As Long
     Dim sDate As String
     hr = TB_CallByName( ObjPtr(oItem), propName, %DISPATCH_PROPERTYGET,  byval %NULL, res, ByVal %NULL)
     Dim ret As String
     sDate = VARIANT$(res)
     IF sDate="" Then
      FUNCTION = ""
      EXIT FUNCTION
     END IF
     ret = FORMAT$(Val(Mid$(sdate,1,4)),"0000")
     ret += "-"
     ret += FORMAT$(Val(Mid$(sdate,5,2)),"00")
     ret += "-"
     ret += FORMAT$(Val(Mid$(sdate,7,2)),"00")
     ret += " "
     ret += FORMAT$(Val(Mid$(sdate,9,2)),"00")
     ret += ":"
     ret += FORMAT$(Val(Mid$(sdate,11,2)),"00")
     ret += ":"
     ret += FORMAT$(Val(Mid$(sdate,13,2)),"00")
     FUNCTION = ret
    END FUNCTION
    FUNCTION WmiGetUtcDate(propName As String) As String
     Dim dt AS Double
     Dim y As Long
     Dim m As Long
     Dim d As Long
     Dim minOffset As Long
     Dim st As SystemTime
     DIM p As LONG
     Dim ret As String
     Dim sDate AS STRING
     Dim res AS Variant
     Dim hr As Long
     hr = TB_CallByName( ObjPtr(oItem), propName, %DISPATCH_PROPERTYGET,  byval %NULL, res, ByVal %NULL)
     sDate = VARIANT$(res)
     IF sDate="" Then
      FUNCTION = ""
      EXIT FUNCTION
     END IF
     Reset st
     st.wYear = Val(Mid$(sdate,1,4))
     st.wMonth = Val(Mid$(sdate,5,2))
     st.wDay = Val(Mid$(sdate,7,2))
     st.wHour = Val(Mid$(sdate,9,2))
     st.wMinute = Val(Mid$(sdate,11,2))
     st.wSecond = Val(Mid$(sdate,13,2))
     p = Instr(sDate, "-")
     IF p=0 Then
      p = Instr(sdate, "+")
     END IF
     minOffset = Val(Mid$(sDate,p, 5))
     SystemTimeToVariantTime  st, dt
     dt += minOffset/1440
     VariantTimeToSystemTime dt, st
     ret = FORMAT$(st.wYear,"0000")
     ret += "-"
     ret += FORMAT$(st.wMonth,"00")
     ret += "-"
     ret += FORMAT$(st.wDay,"00")
     ret += " "
     ret += FORMAT$(st.wHour,"00")
     ret += ":"
     ret += FORMAT$(st.wMinute,"00")
     ret += ":"
     ret += FORMAT$(st.wSecond,"00")
     FUNCTION = ret
    END FUNCTION
    LarryC
    Website
    Sometimes life's a dream, sometimes it's a scream

  • #2
    Here's a program that uses it.

    Code:
    #COMPILE EXE
    #DIM ALL
    #INCLUDE "WMI.inc"
    #INCLUDE "WMIFunction.inc"
     
    Global myMessage As String
    Macro AddMsg(msg)
      myMessage += msg + $CrLf
    End Macro
    #If %DEF(%PB_CC32)
     Macro WaitForIt()
      StdOut myMessage
      WaitKey$
     End Macro
    #Else
     Macro WaitForIt()
      MsgBox myMessage
     End Macro
    #EndIf
     
    FUNCTION PBMAIN() AS LONG
     AddMsg( "Disk Info")
     wmiQuery(".", "SELECT * FROM Win32_LogicalDisk", CODEPTR(printDiskInfo) )
     AddMsg( "")
     AddMsg( "CPU Info")
     wmiQuery(".", "SELECT * FROM Win32_Processor", CODEPTR(printCpuInfo) )
     AddMsg( "")
     AddMsg( "OS Info")
     wmiQuery(".", "SELECT * FROM Win32_OperatingSystem", CODEPTR(printOsInfo) )
     AddMsg( "")
     AddMsg( "Done, press any key to exit")
     WaitForIt()
    END FUNCTION
     
    SUB PrintDiskInfo()
     AddMsg( "Drive: " + wmiGetStr("Name") )
     AddMsg( "Type:. " + STR$(wmiGetNum("DriveType")) )
     AddMsg( "Size:. " + wmiGetStr("Size") )
     AddMsg( "Name:. " + wmiGetStr("VolumeName") )
     AddMsg( "-----------------------------------------" )
     AddMsg( "" )
    END SUB
     
    SUB PrintCpuInfo()
     AddMsg( "Name:......... " + wmiGetStr("Name") )
     AddMsg( "Description:.. " + wmiGetStr("Description") )
     AddMsg( "Clock speed:.. " + STR$(wmiGetNum("CurrentClockSpeed")) )
     AddMsg( "Cores:........ " + STR$(wmiGetNum("NumberOfCores")) )
     AddMsg( "Logical procs: " + STR$(wmiGetNum("NumberOfLogicalProcessors")) )
     AddMsg( "Data width:... " + STR$(wmiGetNum("DataWidth")) )
     AddMsg( "-----------------------------------------" )
     AddMsg( "" )
    END SUB
     
    SUB PrintOsInfo()
     AddMsg( "OS:.......... " + wmiGetStr("Caption") )
     AddMsg( "Rebooted:.... " + wmiGetLocalDate("LastBootUpTime") )
     AddMsg( "UTC rebooted: " + wmiGetUtcDate("LastBootUpTime") )
     AddMsg( "-----------------------------------------" )
     AddMsg( "" )
    END SUB
    LarryC
    Website
    Sometimes life's a dream, sometimes it's a scream

    Comment


    • #3
      Updated the code to work with PB 10. You can get it here.
      LarryC
      Website
      Sometimes life's a dream, sometimes it's a scream

      Comment


      • #4
        sll doesnt work

        Larry,

        When I compiled the sll with the main program it compiles successful. When I executed than I see nothing from information. What does it wrong here with the sll?.

        Can you please help me:

        Code:
        #Compile SLL "clsWMI_sll.sll"
        #Dim All
        
        #Include Once "WIN32API.INC"
        #Include Once "WMI.INC"
        
        Global myMessage As WString
        
        Macro AddMsg(msg)
            myMessage += msg + $CrLf
        End Macro
        
        Interface IWmiItem
            Inherit IUnknown
            Method Item(value As IDispatch, wmi As IWmiClass)
        End Interface
        
        Interface IWmiClass
            Inherit IUnknown
            Method Query(computerName As WString, query As WString, perItem As IWmiItem)
            Method GetStr(propName As WString) As WString
            Method GetNum(propName As WString) As Long
            Method GetLocalDate(propName As WString) As WString
            Method GetUtcDate(propName As WString) As WString
        End Interface
        
        %DISPATCH_METHOD         = 1
        %DISPATCH_PROPERTYGET    = 2
        %DISPATCH_PROPERTYPUT    = 4
        %DISPATCH_PROPERTYPUTREF = 8
        ' ********************************************************************************************
        ' EXCEPINFO structure
        ' ********************************************************************************************
        'TYPE EXCEPINFO
        '   wCode AS WORD               ' An error code describing the error.
        '   wReserved AS WORD           ' Reserved
        '   bstrSource AS DWORD         ' Source of the exception.
        '   bstrDescription AS DWORD    ' Textual description of the error.
        '   bstrHelpFile AS DWORD       ' Help file path.
        '   dwHelpContext AS DWORD      ' Help context ID.
        '   pvReserved AS DWORD         ' Reserved.
        '   pfnDeferredFillIn AS DWORD  ' Pointer to function that fills in Help and description info.
        '   scode AS DWORD              ' An error code describing the error.
        'END TYPE
        ' ********************************************************************************************
        ' ********************************************************************************************
        ' Helper function to calculate the VTable address.
        ' ********************************************************************************************
        Function TB_VTableAddress (ByVal pthis As Dword, ByVal dwOffset As Dword) As Dword
            Local ppthis As Dword Ptr
            Local pvtbl As Dword Ptr
            Local ppmethod As Dword Ptr
            ppthis = pthis
            pvtbl = @ppthis
            ppmethod = pvtbl + dwOffset
            Function = @ppmethod
        End Function
        ' ********************************************************************************************
        ' ********************************************************************************************
        ' Maps a single member to a corresponding DispID, which can be used on subsequent calls to
        ' IDispatch_Invoke.
        ' Parameters:
        ' riid
        '   Reserved for future use. Must be IID_NULL.
        ' strName
        '   Name to be mapped.
        ' rgDispId
        '   Retrieved DispID value.
        ' Return Value:
        '   The return value obtained from the returned HRESULT is one of the following:
        '   %S_OK                Success
        '   %E_OUTOFMEMORY       Out of memory
        '   %DISP_E_UNKNOWNNAME  One or more of the names were not known. The returned array of DISPIDs
        '                        contains DISPID_UNKNOWN for each entry that corresponds to an unknown name.
        '   %DISP_E_UNKNOWNLCID  The locale identifier (LCID) was not recognized.
        ' ********************************************************************************************
        Declare Function Proto_IDispatch_GetIDOfName (ByVal pthis As Dword, ByRef riid As Guid, ByRef rgszNames As WString, ByVal cNames As Dword, ByVal lcid As Dword, ByRef rgdispid As Long) As Dword
        
        Function IDispatch_GetIDOfName (ByVal pthis As Dword, ByRef strName As WString, ByRef rgdispid As Long) As Dword
            Local HRESULT As Dword
            Local pmethod As Dword
            Local riid As Guid
            If pthis = 0 Then Exit Function
            pmethod = TB_VTableAddress (pthis, 20)
            Call Dword pmethod Using Proto_IDispatch_GetIDOfName (pthis, riid, strName, 1, 0, rgdispid) To HRESULT
            Function = HRESULT
        End Function
        ' ********************************************************************************************
        ' ********************************************************************************************
        ' Provides access to properties and methods exposed by an object. The dispatch function DispInvoke
        ' provides a standard implementation of IDispatch_Invoke.
        ' Parameters:
        ' dispIdMember
        '   Identifies the member. Use GetIDsOfNames or the object's documentation to obtain the dispatch identifier.
        ' riid
        '    Reserved for future use. Must be IID_NULL.
        ' lcid
        '   The locale context in which to interpret arguments. The lcid is used by the GetIDsOfNames
        '   function, and is also passed to IDispatch_Invoke to allow the object to interpret its
        '   arguments specific to a locale.
        '   Applications that do not support multiple national languages can ignore this parameter.
        ' wFlags
        '   Flags describing the context of the Invoke call, include:
        '     %DISPATCH_METHOD
        '       The member is invoked as a method. If a property has the same name, both this and the
        '       %DISPATCH_PROPERTYGET flag may be set.
        '     %DISPATCH_PROPERTYGET
        '       The member is retrieved as a property or data member.
        '     %DISPATCH_PROPERTYPUT
        '       The member is changed as a property or data member.
        '     %DISPATCH_PROPERTYPUTREF
        '       The member is changed by a reference assignment, rather than a value assignment. This
        '       flag is valid only when the property accepts a reference to an object.
        ' pDispParams
        '   Pointer to a structure containing an array of arguments, an array of argument DISPIDs for
        '   named arguments, and counts for the number of elements in the arrays.
        ' pVarResult
        '   Pointer to the location where the result is to be stored, or NULL if the caller expects no
        '   result. This argument is ignored if DISPATCH_PROPERTYPUT or DISPATCH_PROPERTYPUTREF is specified.
        ' pExcepInfo
        '   Pointer to a structure that contains exception information. This structure should be filled
        '   in if DISP_E_EXCEPTION is returned. Can be NULL.
        ' puArgErr
        '   The index within rgvarg of the first argument that has an error. Arguments are stored in
        '   pDispParams->rgvarg in reverse order, so the first argument is the one with the highest index
        '   in the array. This parameter is returned only when the resulting return value is
        '   %DISP_E_TYPEMISMATCH or %DISP_E_PARAMNOTFOUND. This argument can be set to null.
        ' Return Value:
        '   The return value obtained from the returned HRESULT is one of the following:
        '   %S_OK                     Success
        '   %DISP_E_BADPARAMCOUNT     The number of elements provided to DISPPARAMS is different from the
        '                             number of arguments accepted by the method or property.
        '   %DISP_E_BADVARTYPE        One of the arguments in rgvarg is not a valid variant type.
        '   %DISP_E_EXCEPTION         The application needs to raise an exception. In this case, the
        '                             structure passed in pExcepInfo should be filled in.
        '   %DISP_E_MEMBERNOTFOUND    The requested member does not exist, or the call to Invoke tried to
        '                             set the value of a read-only property.
        '   %DISP_E_NONAMEDARGS       This implementation of IDispatch does not support named arguments.
        '   %DISP_E_OVERFLOW          One of the arguments in rgvarg could not be coerced to the specified type.
        '   %DISP_E_PARAMNOTFOUND     One of the parameter DISPIDs does not correspond to a parameter on
        '                             the method. In this case, puArgErr should be set to the first
        '                             argument that contains the error.
        '   %DISP_E_TYPEMISMATCH      One or more of the arguments could not be coerced. The index within
        '                             rgvarg of the first parameter with the incorrect type is returned
        '                             in the puArgErr parameter.
        '   %DISP_E_UNKNOWNINTERFACE  The interface identifier passed in riid is not IID_NULL.
        '   %DISP_E_UNKNOWNLCID       The member being invoked interprets WString arguments according to
        '                             the LCID, and the LCID is not recognized. If the LCID is not needed
        '                             to interpret arguments, this error should not be returned.
        '   %DISP_E_PARAMNOTOPTIONAL  A required parameter was omitted.
        ' ********************************************************************************************
        Function IDispatch_Invoke (ByVal pthis As Dword, _
                                   ByVal dispidMember As Long, _
                                   ByRef riid As Guid, _
                                   ByVal lcid As Dword, _
                                   ByVal wFlags As Word, _
                                   ByRef pdispparams As DispParams, _
                                   ByRef pvarResult As Variant, _
                                   ByRef pexcepinfo As EXCEPINFO, _
                                   ByRef puArgErr As Dword) As Dword
        
                                   Local HRESULT As Dword
            Local pmethod As Dword
            If pthis = 0 Then Exit Function
            pmethod = TB_VTableAddress (pthis, 24)
            Call Dword pmethod Using IDispatch_Invoke (pthis, dispidMember, riid, lcid, wFlags, pdispparams, pvarResult, pexcepinfo, puArgErr) To HRESULT
            Function = HRESULT
        End Function
        ' ********************************************************************************************
        ' ********************************************************************************************
        ' CallByName
        ' ********************************************************************************************
        Function TB_CallByName ( _
                                ByVal pthis As Dword, _                                    ' *IDispatch
                                ByVal vNameOrId As Variant, _                              ' Name or identifier
                                ByVal callType As Long, _                                  ' Call type
                                ByRef vParams() As Variant, _                              ' Array of variants
                                ByRef vResult As Variant, _                                ' Variant result
                                ByRef pex As EXCEPINFO _                                   ' EXCEPINFO
                               ) Export As Long
                                                                      ' Error code
            Dim dw_puArgErr         As Dword, _
                DISPID_PROPERTYPUT  As Long, _
                IID_NULL            As Guid
        
            Dim vArgs(0)            As Variant, _
                udt_DispParams      As DispParams
        
            Dim strName             As WString, _
                DispID              As Long, _
                nParams             As Long, _
                i                   As Long, _
                idx                 As Long
        
            ' Check for null pointer
            If pthis = 0 Then Function = -1 : Exit Function
        
            ' Get the DispID
            If VariantVT(vNameOrId) = %VT_BStr Then
                strName = Variant$(vNameOrId)
                IDispatch_GetIDOfName pthis, strName, DispID
            Else
                DispID = Variant#(vNameOrId)
            End If
        
            ' Copy the array in reversed order
            If VarPtr(vParams()) Then
                nParams = UBound(vParams) - LBound (vParams) + 1
                If nParams > 0 Then
                    ReDim vArgs(nParams - 1)
                    idx = nParams - 1
                    For i = LBound(vParams) To UBound(vParams)
                        If VariantVT(vParams(i)) = %VT_Empty Then
                            vArgs(idx) = Error %Disp_E_ParamNotFound
                        Else
                            vArgs(idx) = vParams(i)
                        End If
                        Decr idx
                        If idx < 0 Then Exit For
                    Next
                End If
            End If
        
            If CallType = 4 Or CallType = 8 Then  ' %DISPATCH_PROPERTYPUT and %DISPATCH_PROPERTYPUTREF
                DISPID_PROPERTYPUT = -3
                udt_DispParams.CountNamed = 1
                udt_DispParams.NamedDispId = VarPtr(DISPID_PROPERTYPUT)
            End If
        
            udt_DispParams.CountArgs = nParams
            If nParams > 0 Then udt_DispParams.VariantArgs = VarPtr(vArgs(0))
            Function = IDispatch_Invoke(pthis, DispID, IID_NULL, 0, CallType, udt_DispParams, vResult, pex, dw_puArgErr)
        End Function
        ' ********************************************************************************************
        Class WmiClass Common
            Instance oItem As Dispatch
            Interface IWmiClass
                Inherit IUnknown
                'Public Members
                Method Query(computerName As WString, query As WString, perItem As IWmiItem)
                    Local hr As Long                                  ' HRESULT
                    Local pService As ISWbemServices                  ' Services object
                    Local pObjectSet As ISWbemObjectSet               ' ISWbemObjectSet interface
                    Local pEnum As IEnumVariant                       ' Generic collection's enumerator reference
                    Local strDisplayName As WString                   ' Display name
                    Local strQuery As WString                         ' Query WString
                    Local vItem As Variant                            ' Generic object variant
                    Local vRes As Variant                             ' General purpose variant
        
                    ' Connect to WMI using a moniker
                    If Len(computerName) = 0 Then computerName = "."
                    strDisplayName = "winmgmts:{impersonationLevel=impersonate}!\\" & computerName & "\root\CIMV2"
                    pService = WmiGetObject(strDisplayName)
        
                    If IsNothing(pService) Then Exit Method
        
                    ' Execute a query to get a reference to the collection of objects
                    strQuery = query
                    pObjectSet = pService.ExecQuery(strQuery, "WQL", %wbemFlagReturnImmediately)
        
                    If IsNothing(pObjectSet) Then Exit Method
        
                    pEnum = pObjectSet.NewEnum_:                       ' Retrieve a reference to the collection's enumerator
                    If IsNothing(pEnum) Then Exit Method
        
                    ' Iterate through the collection of objects
                    Do
                        hr = pEnum.Next(1, vItem, ByVal %NULL):         ' Retrieve a reference to the next object in the collection
                        If hr <> %S_Ok Then Exit Do
                        oItem = vItem :                                 ' Assign the VT_DISPATCH variant to the object variable
                        vItem = Empty
                        If IsNothing(oItem) Then Exit Do
        
                        If IsObject(perItem) Then
                            perItem.Item(oItem, Me)
                        End If
                        oItem = Nothing:                                ' Release the object
                    Loop
        
                    pEnum = Nothing: ' Release the enumerator
                    pObjectSet = Nothing: ' Release the collection
                    pService = Nothing: ' Release the service
                End Method
        
                Method GetStr(propName As WString) As WString
                    Dim Res As Variant
                    Dim ret As Long
        
                    ret = TB_CallByName( ObjPtr(oItem), propName, %DISPATCH_PROPERTYGET,  ByVal %NULL, Res, ByVal %NULL)
                    Method = Variant$(Res)
                End Method
        
                Method GetNum(propName As WString) As Long
                    Dim Res As Variant
                    Dim hr As Long
        
                    hr = TB_CallByName( ObjPtr(oItem), propName, %DISPATCH_PROPERTYGET,  ByVal %NULL, Res, ByVal %NULL)
                    Method = Variant#(Res)
                End Method
        
                Method GetLocalDate(propName As WString) As WString
                    Dim Res As Variant
                    Dim hr As Long
                    Dim sDate As WString
        
                    hr = TB_CallByName( ObjPtr(oItem), propName, %DISPATCH_PROPERTYGET,  ByVal %NULL, Res, ByVal %NULL)
                    Dim ret As WString
                    sDate = Variant$(Res)
        
                    If sDate="" Then
                        Method = ""
                        Exit Method
                    End If
        
                    ret = Format$(Val(Mid$(sdate,1,4)),"0000")
                    ret += "-"
                    ret += Format$(Val(Mid$(sdate,5,2)),"00")
                    ret += "-"
                    ret += Format$(Val(Mid$(sdate,7,2)),"00")
                    ret += " "
                    ret += Format$(Val(Mid$(sdate,9,2)),"00")
                    ret += ":"
                    ret += Format$(Val(Mid$(sdate,11,2)),"00")
                    ret += ":"
                    ret += Format$(Val(Mid$(sdate,13,2)),"00")
                    Method = ret
                End Method
        
                Method GetUtcDate(propName As WString) As WString
                    Dim dt As Double
                    Dim y As Long
                    Dim m As Long
                    Dim d As Long
                    Dim minOffset As Long
                    Dim st As SystemTime
                    Dim p As Long
                    Dim ret As WString
                    Dim sDate As WString
                    Dim Res As Variant
                    Dim hr As Long
        
                    hr = TB_CallByName( ObjPtr(oItem), propName, %DISPATCH_PROPERTYGET,  ByVal %NULL, Res, ByVal %NULL)
                    sDate = Variant$(Res)
        
                    If sDate="" Then
                        Method = ""
                        Exit Method
                    End If
                    Reset st
        
                    st.wYear = Val(Mid$(sdate,1,4))
                    st.wMonth = Val(Mid$(sdate,5,2))
                    st.wDay = Val(Mid$(sdate,7,2))
                    st.wHour = Val(Mid$(sdate,9,2))
                    st.wMinute = Val(Mid$(sdate,11,2))
                    st.wSecond = Val(Mid$(sdate,13,2))
                    p = InStr(sDate, "-")
        
                    If p=0 Then
                        p = InStr(sdate, "+")
                    End If
        
                    minOffset = Val(Mid$(sDate,p, 5))
                    SystemTimeToVariantTime  st, dt
                    dt += minOffset/1440
                    VariantTimeToSystemTime dt, st
                    ret = Format$(st.wYear,"0000")
                    ret += "-"
                    ret += Format$(st.wMonth,"00")
                    ret += "-"
                    ret += Format$(st.wDay,"00")
                    ret += " "
                    ret += Format$(st.wHour,"00")
                    ret += ":"
                    ret += Format$(st.wMinute,"00")
                    ret += ":"
                    ret += Format$(st.wSecond,"00")
                    Method = ret
                End Method
            End Interface
        End Class
        
        
        ' Classes that implement what I want done for each returned item.
        Class PrintDiskInfo Common
            Interface IWmiItem
            Inherit IUnknown
                Method Item(value As IDispatch, wmi As IWmiClass)
                    AddMsg( "Drive: " + wmi.GetStr("Name") )
                    AddMsg( "Type:. " + Str$(wmi.GetNum("DriveType")) )
                    AddMsg( "Size:. " + wmi.GetStr("Size") )
                    AddMsg( "Name:. " + wmi.GetStr("VolumeName") )
                    AddMsg( "-----------------------------------------" )
                    AddMsg( "" )
                End Method
            End Interface
        End Class
        
        Class PrintCpuInfo Common
            Interface IWmiItem
            Inherit IUnknown
                Method Item(value As IDispatch, wmi As IWmiClass)
                    AddMsg( "Name:......... " + wmi.GetStr("Name") )
                    AddMsg( "Description:.. " + wmi.GetStr("Description") )
                    AddMsg( "Clock speed:.. " + Str$(wmi.GetNum("CurrentClockSpeed")) )
                    AddMsg( "Cores:........ " + Str$(wmi.GetNum("NumberOfCores")) )
                    AddMsg( "Logical procs: " + Str$(wmi.GetNum("NumberOfLogicalProcessors")) )
                    AddMsg( "Data width:... " + Str$(wmi.GetNum("DataWidth")) )
                    AddMsg( "-----------------------------------------" )
                    AddMsg( "" )
                End Method
            End Interface
        End Class
        
        Class PrintOSInfo Common
            Interface IWmiItem
            Inherit IUnknown
                Method Item(value As IDispatch, wmi As IWmiClass)
                    AddMsg( "OS:.......... " + wmi.GetStr("Caption") )
                    AddMsg( "Rebooted:.... " + wmi.GetLocalDate("LastBootUpTime") )
                    AddMsg( "UTC rebooted: " + wmi.GetUtcDate("LastBootUpTime") )
                    AddMsg( "-----------------------------------------" )
                    AddMsg( "" )
                End Method
            End Interface
        End Class
        Code:
        --- The main app ---
        #Compile Exe "pb_win_10_WMI_Qry_sll_Class.exe"
        #Dim All
        
        #Link "clsWMI_sll.sll"
        
        %unicode=1
        Global myMessage As WString
        Macro AddMsg(msg)
            myMessage += msg + $CrLf
        End Macro
        
        #If %Def(%PB_CC32)
            Macro WaitForIt()
             StdOut myMessage
             WaitKey$
            End Macro
        #Else
            Macro WaitForIt()
             MsgBox myMessage
            End Macro
        #EndIf
        
        Function PBMain () As Long
            Dim wmi As IWmiClass
            wmi = Class "WmiClass"
        
            Dim printDisk As IWmiItem
            printDisk = Class "PrintDiskInfo"
            wmi.Query(".", "SELECT * FROM Win32_LogicalDisk", printDisk )
        
            Dim printCPU As IWmiItem
            printCPU = Class "PrintCpuInfo"
            wmi.Query(".", "SELECT * FROM Win32_Processor", printCPU )
        
            Dim printOS As IWmiItem
            printOS = Class "PrintOSInfo"
            wmi.Query(".", "SELECT * FROM Win32_OperatingSystem", printOS )
        
            WaitForIt()
        End Function
        
        ' Classes that implement what I want done for each returned item.
        'Class PrintDiskInfo
        '    Interface IWmiItem
        '     Inherit IUnknown
        '     Method Item(value As IDispatch, wmi As IWmiClass)
        '        AddMsg( "Drive: " + wmi.GetStr("Name") )
        '        AddMsg( "Type:. " + Str$(wmi.GetNum("DriveType")) )
        '        AddMsg( "Size:. " + wmi.GetStr("Size") )
        '        AddMsg( "Name:. " + wmi.GetStr("VolumeName") )
        '        AddMsg( "-----------------------------------------" )
        '        AddMsg( "" )
        '     End Method
        '    End Interface
        'End Class
        '
        'Class PrintCpuInfo
        '    Interface IWmiItem
        '     Inherit IUnknown
        '     Method Item(value As IDispatch, wmi As IWmiClass)
        '        AddMsg( "Name:......... " + wmi.GetStr("Name") )
        '        AddMsg( "Description:.. " + wmi.GetStr("Description") )
        '        AddMsg( "Clock speed:.. " + Str$(wmi.GetNum("CurrentClockSpeed")) )
        '        AddMsg( "Cores:........ " + Str$(wmi.GetNum("NumberOfCores")) )
        '        AddMsg( "Logical procs: " + Str$(wmi.GetNum("NumberOfLogicalProcessors")) )
        '        AddMsg( "Data width:... " + Str$(wmi.GetNum("DataWidth")) )
        '        AddMsg( "-----------------------------------------" )
        '        AddMsg( "" )
        '     End Method
        '    End Interface
        'End Class
        
        'Class PrintOSInfo
        '    Interface IWmiItem
        '     Inherit IUnknown
        '     Method Item(value As IDispatch, wmi As IWmiClass)
        '        AddMsg( "OS:.......... " + wmi.GetStr("Caption") )
        '        AddMsg( "Rebooted:.... " + wmi.GetLocalDate("LastBootUpTime") )
        '        AddMsg( "UTC rebooted: " + wmi.GetUtcDate("LastBootUpTime") )
        '        AddMsg( "-----------------------------------------" )
        '        AddMsg( "" )
        '     End Method
        '    End Interface
        'End Class
        In attachment the exe and the sources

        Kind regards
        Stephane
        Attached Files

        Comment

        Working...
        X