On the WMI,again !!

[King64]

I translated  WMI demo by Sapero from Aurora language,http://www.ionicwind.com/forums/index.php/topic,246.0.html, to EB language. To compile it you have to use com.inc and cwmi.eba files.

com.inc

Code Select Expand


$USE "ole32.lib"
$USE "uuid.lib"
$USE "oleaut32.lib"
$USE "WbemUuid.lib" /* From SDK For EB */

EXTERN _CLSID_WbemLocator AS GUID
EXTERN _IID_IWbemLocator AS GUID

TYPEDEF HRESULT        UINT
TYPEDEF LCID          UINT
TYPEDEF DISPID        UINT
TYPEDEF VARTYPE        WORD
TYPEDEF VARIANT_BOOL  WORD
TYPEDEF SCODE          UINT
TYPEDEF LPOLESTR      STRING
TYPEDEF OLECHAR        STRING
TYPEDEF BSTR          POINTER
TYPEDEF IRecordInfo INT
TYPEDEF RPC_AUTH_IDENTITY_HANDLE INT


TYPE VARIANT
VARTYPE vt
WORD wReserved1
WORD wReserved2
WORD wReserved3
INT           lVal[0] : ' VT_I4.
CHAR          bVal[0]      : ' VT_UI1.
WORD          iVal[0]      : ' VT_I2.
FLOAT         fltVal[0]    : ' VT_R4.
DOUBLE        dblVal[0]    : ' VT_R8.
VARIANT_BOOL boolVal[0]  : ' VT_BOOL.
SCODE         scode[0]    : ' VT_ERROR.
BSTR          bstrVal[0] : ' VT_BSTR.
CHAR          cVal[0]      : ' VT_I1.
WORD        uiVal[0]    : ' VT_UI2.
UINT          ulVal[0]    : ' VT_UI4.
INT           INTVal[0]    : ' VT_INT.
UINT          uINTVal[0]  : ' VT_UINT.
POINTER       pvRecord
POINTER       pRecInfo
ENDTYPE

INTERFACE  IWbemLocator
' IUnknown methods
STDMETHOD  QueryINTERFACE(refiid:POINTER,ppv:POINTER),HRESULT
STDMETHOD  AddRef(),HRESULT
STDMETHOD  Release(),HRESULT
' IWbemLocator methods
STDMETHOD  ConnectServer(strNetworkResource:POINTER,strUser:POINTER,strPassword:POINTER,strLocale:POINTER,lSecurityFlags:INT,strAuthority:POINTER,pCtx:POINTER,ppNamespace:POINTER),HRESULT
ENDINTERFACE

INTERFACE IWbemServices
' IUnknown methods
STDMETHOD  QueryINTERFACE(refiid:POINTER,ppv:POINTER),HRESULT
STDMETHOD  AddRef(),HRESULT
STDMETHOD  Release(),HRESULT
' IWbemServices methods
STDMETHOD  OpenNamespace(strNamespace:POINTER,lFlags:INT,pCtx:POINTER,ppWorkingNamespace:POINTER,ppResult:POINTER),HRESULT
STDMETHOD  CancelAsyncCall(pSink:POINTER),HRESULT
STDMETHOD  QueryObjectSink(lFlags:INT,ppResponseHandler:POINTER),HRESULT
STDMETHOD  GetObject(strObjectPath:POINTER,lFlags:INT,pCtx:POINTER,ppObject:POINTER,ppCallResult:POINTER),HRESULT
STDMETHOD  GetObjectAsync(strObjectPath:POINTER,lFlags:INT,pCtx:POINTER,pResponseHandler:POINTER),HRESULT
STDMETHOD  PutClass(pObject:POINTER,lFlags:INT,pCtx:POINTER,ppCallResult:POINTER),HRESULT
STDMETHOD  PutClassAsync(pObject:POINTER,lFlags:INT,pCtx:POINTER,pResponseHandler:POINTER),HRESULT
STDMETHOD  DeleteClass(strClass:POINTER,lFlags:INT,pCtx:POINTER,ppCallResult:POINTER),HRESULT
STDMETHOD  DeleteClassAsync(strClass:POINTER,lFlags:INT,pCtx:POINTER,pResponseHandler:POINTER),HRESULT
STDMETHOD  CreateClassEnum(strSuperclass:POINTER,lFlags:INT,pCtx:POINTER,ppEnum:POINTER),HRESULT
STDMETHOD  CreateClassEnumAsync(strSuperclass:POINTER,lFlags:INT,pCtx:POINTER,pResponseHandler:POINTER),HRESULT
STDMETHOD  PutInstance(pInst:POINTER,lFlags:INT,pCtx:POINTER,ppCallResult:POINTER),HRESULT
STDMETHOD  PutInstanceAsync(pInst:POINTER,lFlags:INT,pCtx:POINTER,pResponseHandler:POINTER),HRESULT
STDMETHOD  DeleteInstance(strObjectPath:POINTER,lFlags:UINT,pCtx:POINTER,ppCallResult:POINTER),HRESULT
STDMETHOD  DeleteInstanceAsync(strObjectPath:POINTER,lFlags:INT,pCtx:POINTER,pResponseHandler:POINTER),HRESULT
STDMETHOD  CreateInstanceEnum(strFilter:POINTER,lFlags:INT,pCtx:POINTER,ppEnum:POINTER),HRESULT
STDMETHOD  CreateInstanceEnumAsync(strFilter:POINTER,lFlags:INT,pCtx:POINTER,pResponseHandler:POINTER),HRESULT
STDMETHOD  ExecQuery(strQueryLanguage:POINTER,strQuery:POINTER,lFlags:INT,pCtx:POINTER,ppEnum:POINTER),HRESULT
STDMETHOD  ExecQueryAsync(strQueryLanguage:POINTER,strQuery:POINTER,lFlags:INT,pCtx:POINTER,pResponseHandler:POINTER),HRESULT
STDMETHOD  ExecNotificationQuery(strQueryLanguage:POINTER,strQuery:POINTER,lFlags:INT,pCtx:POINTER,ppEnum:POINTER),HRESULT
STDMETHOD  ExecNotificationQueryAsync(strQueryLanguage:POINTER,strQuery:POINTER,lFlags:INT,pCtx:POINTER,pResponseHandler:POINTER),HRESULT
STDMETHOD  ExecMethod(strObjectPath:POINTER,strMethodName:POINTER,lFlags:INT,pCtx:POINTER,pInParams:POINTER,ppOutParams:POINTER,ppCallResult:POINTER),HRESULT
STDMETHOD  ExecMethodAsync(strObjectPath:POINTER,strMethodName:POINTER,lFlags:INT,pCtx:POINTER,pInParams:POINTER,pResponseHandler:POINTER),HRESULT
ENDINTERFACE

INTERFACE IEnumWbemClassObject
' IUnknown methods
STDMETHOD  QueryINTERFACE(refiid:POINTER,ppv:POINTER),HRESULT
STDMETHOD  AddRef(),HRESULT
STDMETHOD  Release(),HRESULT
' IEnumWbemClassObject methods
STDMETHOD Reset(),HRESULT
STDMETHOD _Next(lTimeout:INT,uCount:UINT,apObjects:POINTER,puReturned:POINTER),HRESULT
STDMETHOD NextAsync(uCount:UINT,pSink:POINTER),HRESULT
STDMETHOD Clone(ppEnum:POINTER),HRESULT
STDMETHOD Skip(lTimeout:INT,nCount:UINT),HRESULT
ENDINTERFACE

INTERFACE IWbemClassObject
' IUnknown methods
STDMETHOD  QueryINTERFACE(refiid:POINTER,ppv:POINTER),HRESULT
STDMETHOD  AddRef(),HRESULT
STDMETHOD  Release(),HRESULT
' IWbemClassObject methods
STDMETHOD  GetQualifierSet(ppQualSet:POINTER),HRESULT
STDMETHOD  _Get(wszName:POINTER,lFlags:INT,pVal:POINTER,gType:POINTER,plFlavor:POINTER),HRESULT
STDMETHOD  _Put(wszName:POINTER,lFlags:INT,pVal:POINTER,pType:POINTER),HRESULT
STDMETHOD  _Delete(wszName:POINTER),HRESULT
STDMETHOD  GetNames(wszQualifierName:POINTER,lFlags:INT,pQualifierVal:POINTER,pNames:POINTER),HRESULT
STDMETHOD  BeginEnumeration(lEnumFlags:INT),HRESULT
STDMETHOD  _Next(lFlags:INT,strName:POINTER,pVal:POINTER,pType:POINTER,plFlavor:POINTER),HRESULT
STDMETHOD  EndEnumeration(),HRESULT
STDMETHOD  GetPropertyQualifierSet(wszProperty:POINTER,ppQualSet:POINTER),HRESULT
STDMETHOD  Clone(ppCopy:POINTER),HRESULT
STDMETHOD  GetObjectText(lFlags:INT,pstrObjectText:POINTER),HRESULT
STDMETHOD  SpawnDerivedClass(lFlags:INT,ppNewClass:POINTER),HRESULT
STDMETHOD  SpawnInstance(lFlags:INT,ppNewInstance:POINTER),HRESULT
STDMETHOD  CompareTo(lFlags:INT,pCompareTo:POINTER),HRESULT
STDMETHOD  GetPropertyOrigin(wszName:POINTER,pstrClassName:POINTER),HRESULT
STDMETHOD  InheritsFrom(strAncestor:POINTER),HRESULT
STDMETHOD  GetMethod(wszName:POINTER,lFlags:INT,ppInSignature:POINTER,ppOutSignature:POINTER),HRESULT
STDMETHOD  PutMethod(wszName:POINTER,lFlags:INT,pInSignature:POINTER,pOutSignature:POINTER),HRESULT
STDMETHOD  DeleteMethod(wszName:POINTER),HRESULT
STDMETHOD  BeginMethodEnumeration(lEnumFlags:IT),HRESULT
STDMETHOD  NextMethod(lFlags:INT,pstrName:POINTER,ppInSignature:POINTER,ppOutSignature:POINTER),HRESULT
STDMETHOD  EndMethodEnumeration(),HRESULT
STDMETHOD  GetMethodQualifierSet(wszMethod:POINTER,ppQualSet:POINTER),HRESULT
STDMETHOD  GetMethodOrigin(wszMethodName:POINTER,pstrClassName:POINTER),HRESULT
ENDINTERFACE

DECLARE IMPORT, CoInitializeEx(pvReserved:POINTER,dwCoInit:UINT),HRESULT
DECLARE IMPORT, VariantInit(pvarg:POINTER)
DECLARE IMPORT, VariantClear(pvarg:POINTER),HRESULT
DECLARE IMPORT, SysAllocString(sz:STRING),BSTR
DECLARE IMPORT, SysFreeString(bstring:BSTR)
DECLARE IMPORT, MultiByteToWideChar(codepage:UINT,dwFlags:UINT,lpMBS:STRING,cchMB:INT,lpWCS:POINTER,cchWC:INT)
DECLARE IMPORT, lstrlenW(lpString:POINTER),INT
DECLARE CDECL EXTERN _sprintf(buf:STRING,format:STRING, ...),INT

DECLARE IMPORT, CoSetProxyBlanket(pProxy:POINTER,_
dwAuthnSvc:UINT,_
dwAuthzSvc:UINT,_
pServerPrincName:POINTER,_
dwAuthnLevel:UINT,_
dwImpLevel:UINT,_
pAuthInfo:POINTER ,_
dwCapabilities:UINT),HRESULT

DECLARE IMPORT, CoInitializeSecurity(_
  pVoid:POINTER,_
  cAuthSvc:UINT,_
  asAuthSvc:POINTER,_
  pReserved1:POINTER,_
  dwAuthnLevel:UINT,_
  dwImpLevel:UINT,_
  pAuthList:POINTER,_
  dwCapabilities:UINT,_
  pReserved3:POINTER),HRESULT

CONST COINIT_MULTITHREADED     = 0x0
CONST COINIT_APARTMENTTHREADED = 0x2
CONST COINIT_DISABLE_OLE1DDE   = 0x4
CONST COINIT_SPEED_OVER_MEMORY = 0x8

'enum EOLE_AUTHENTICATION_CAPABILITIES
CONST EOAC_NONE = 0
CONST EOAC_MUTUAL_AUTH = 0x1
CONST EOAC_STATIC_CLOAKING = 0x20
CONST EOAC_DYNAMIC_CLOAKING = 0x40
CONST EOAC_ANY_AUTHORITY = 0x80
CONST EOAC_MAKE_FULLSIC = 0x100
CONST EOAC_DEFAULT = 0x800
CONST EOAC_SECURE_REFS = 0x2
CONST EOAC_ACCESS_CONTROL = 0x4
CONST EOAC_APPID = 0x8
CONST EOAC_DYNAMIC = 0x10
CONST EOAC_REQUIRE_FULLSIC = 0x200
CONST EOAC_AUTO_IMPERSONATE = 0x400
CONST EOAC_NO_CUSTOM_MARSHAL = 0x2000
CONST EOAC_DISABLE_AAA = 0x1000

CONST RPC_C_AUTHZ_NONE    = 0
CONST RPC_C_AUTHZ_NAME    = 1
CONST RPC_C_AUTHZ_DCE     = 2
CONST RPC_C_AUTHZ_DEFAULT = 0xffffffff

CONST RPC_C_AUTHN_LEVEL_DEFAULT       = 0
CONST RPC_C_AUTHN_LEVEL_NONE          = 1
CONST RPC_C_AUTHN_LEVEL_CONNECT       = 2
CONST RPC_C_AUTHN_LEVEL_CALL          = 3
CONST RPC_C_AUTHN_LEVEL_PKT           = 4
CONST RPC_C_AUTHN_LEVEL_PKT_INTEGRITY = 5
CONST RPC_C_AUTHN_LEVEL_PKT_PRIVACY   = 6

CONST RPC_C_IMP_LEVEL_DEFAULT      = 0
CONST RPC_C_IMP_LEVEL_ANONYMOUS    = 1
CONST RPC_C_IMP_LEVEL_IDENTIFY     = 2
CONST RPC_C_IMP_LEVEL_IMPERSONATE  = 3
CONST RPC_C_IMP_LEVEL_DELEGATE     = 4

CONST RPC_C_AUTHN_NONE          = 0
CONST RPC_C_AUTHN_DCE_PRIVATE   = 1
CONST RPC_C_AUTHN_DCE_PUBLIC    = 2
CONST RPC_C_AUTHN_DEC_PUBLIC    = 4
CONST RPC_C_AUTHN_GSS_NEGOTIATE = 9
CONST RPC_C_AUTHN_WINNT        = 10
CONST RPC_C_AUTHN_GSS_SCHANNEL = 14
CONST RPC_C_AUTHN_GSS_KERBEROS = 16
CONST RPC_C_AUTHN_DPA          = 17
CONST RPC_C_AUTHN_MSN          = 18
CONST RPC_C_AUTHN_DIGEST        = 21
CONST RPC_C_AUTHN_MQ          = 100
CONST RPC_C_AUTHN_DEFAULT      = 0xFFFFFFFF

'enum CLSCTX
CONST CLSCTX_INPROC_SERVER         = 0x1
CONST CLSCTX_INPROC_HANDLER        = 0x2
CONST CLSCTX_LOCAL_SERVER          = 0x4
CONST CLSCTX_INPROC_SERVER16       = 0x8
CONST CLSCTX_REMOTE_SERVER         = 0x10
CONST CLSCTX_INPROC_HANDLER16      = 0x20
CONST CLSCTX_RESERVED1             = 0x40
CONST CLSCTX_RESERVED2             = 0x80
CONST CLSCTX_RESERVED3             = 0x100
CONST CLSCTX_RESERVED4             = 0x200
CONST CLSCTX_NO_CODE_DOWNLOAD      = 0x400
CONST CLSCTX_RESERVED5             = 0x800
CONST CLSCTX_NO_CUSTOM_MARSHAL     = 0x1000
CONST CLSCTX_ENABLE_CODE_DOWNLOAD  = 0x2000
CONST CLSCTX_NO_FAILURE_LOG        = 0x4000
CONST CLSCTX_DISABLE_AAA           = 0x8000
CONST CLSCTX_ENABLE_AAA            = 0x10000
CONST CLSCTX_FROM_DEFAULT_CONTEXT  = 0x20000
CONST CLSCTX_SERVER  = 21

'enum WBEM_GENERIC_FLAG_TYPE
CONST WBEM_FLAG_RETURN_IMMEDIATELY = 0x10
CONST WBEM_FLAG_RETURN_WBEM_COMPLETE = 0
CONST WBEM_FLAG_BIDIRECTIONAL = 0
CONST WBEM_FLAG_FORWARD_ONLY = 0x20
CONST WBEM_FLAG_NO_ERROR_OBJECT = 0x40
CONST WBEM_FLAG_RETURN_ERROR_OBJECT = 0
CONST WBEM_FLAG_SEND_STATUS = 0x80
CONST WBEM_FLAG_DONT_SEND_STATUS = 0
CONST WBEM_FLAG_ENSURE_LOCATABLE = 0x100
CONST WBEM_FLAG_DIRECT_READ = 0x200
CONST WBEM_FLAG_SEND_ONLY_SELECTED = 0
CONST WBEM_RETURN_WHEN_COMPLETE = 0
CONST WBEM_RETURN_IMMEDIATELY = 0x10
CONST WBEM_MASK_RESERVED_FLAGS = 0x1f000
CONST WBEM_FLAG_USE_AMENDED_QUALIFIERS = 0x20000
CONST WBEM_FLAG_STRONG_VALIDATION = 0x100000

'enum tag_WBEM_TIMEOUT_TYPE
CONST WBEM_NO_WAIT = 0
CONST WBEM_INFINITE = 0xffffffff

'enum VARENUM
CONST VT_EMPTY = 0
CONST VT_NULL = 1
CONST VT_BOOL = 11
CONST VT_I1 = 16
CONST VT_I2 = 2
CONST VT_I4 = 3
CONST VT_I8 = 20
CONST VT_INT = 22
CONST VT_INT_PTR = 37
CONST VT_UI1 = 17
CONST VT_UI2 = 18
CONST VT_UI4 = 19
CONST VT_UI8 = 21
CONST VT_UINT = 23
CONST VT_UINT_PTR = 38
CONST VT_R4 = 4
CONST VT_R8 = 5
CONST VT_CY = 6
CONST VT_DATE = 7
CONST VT_BSTR = 8
CONST VT_DISPATCH = 9
CONST VT_ERROR = 10
CONST VT_VARIANT = 12
CONST VT_UNKNOWN = 13
CONST VT_DECIMAL = 14
CONST VT_VOID = 24
CONST VT_HRESULT = 25
CONST VT_PTR = 26
CONST VT_SAFEARRAY = 27
CONST VT_CARRAY = 28
CONST VT_USERDEFINED = 29
CONST VT_LPSTR = 30
CONST VT_LPWSTR = 31
CONST VT_RECORD = 36
CONST VT_FILETIME = 64
CONST VT_BLOB = 65
CONST VT_STREAM = 66
CONST VT_STORAGE = 67
CONST VT_STREAMED_OBJECT = 68
CONST VT_STORED_OBJECT = 69
CONST VT_BLOB_OBJECT = 70
CONST VT_CF = 71
CONST VT_CLSID = 72
CONST VT_VERSIONED_STREAM = 73
CONST VT_BSTR_BLOB = 0xfff
CONST VT_VECTOR = 0x1000
CONST VT_ARRAY = 0x2000
CONST VT_BYREF = 0x4000
CONST VT_RESERVED = 0x8000
CONST VT_ILLEGAL = 0xffff
CONST VT_ILLEGALMASKED = 0xfff
CONST VT_TYPEMASK = 0xfff


cwmi.eba

Code Select Expand

$INCLUDE "com.inc"

CLASS CWMI

PRIVATE
DECLARE CWMI()
DECLARE _CWMI()
DECLARE SetProperty(szproperty:POINTER)
PUBLIC
DECLARE SetClass(szclass:STRING)
DECLARE QueryProperty(szproperty:POINTER),STRING
DECLARE QueryString(szproperty:POINTER),STRING
DECLARE _Next(OPT prop=null AS POINTER),STRING

INT      ExecQueryFlags
UINT    CurrentState
BSTR      m_bstrSystemClass
BSTR      m_bstrQueryLanguage
STRING    ErrorDescription
COMREF m_pLoc
COMREF m_pSvc
COMREF m_pEnumerator
COMREF m_pclsObj
HRESULT hr
LPOLESTR m_property

ENDCLASS

CONST CWMI_STATE_COINIT = 1

CWMI wmi
STRING s

PRINT"error:"
PRINT wmi.ErrorDescription
PRINT"\n"
PRINT"\n----------- Win32_OperatingSystem ----------------\n\n"
wmi.SetClass("Win32_OperatingSystem")
PRINT"Name        : ", wmi.QueryProperty("Name")
PRINT"BootDevice  : ", wmi.QueryProperty("BootDevice")
PRINT"BuildType    : ", wmi.QueryProperty("BuildType")
PRINT"CountryCode : ", wmi.QueryProperty("CountryCode")
PRINT"Description : ", wmi.QueryProperty("Description")
PRINT"Locale      : ", wmi.QueryProperty("Locale")
PRINT"Manufacturer : ", wmi.QueryProperty("Manufacturer")
PRINT"Organization : ", wmi.QueryProperty("Organization")
PRINT"RegisteredUser: ", wmi.QueryProperty("RegisteredUser")
PRINT"Version      : ", wmi.QueryProperty("Version")
PRINT"SystemDevice: ", wmi.QueryProperty("SystemDevice")
PRINT"SerialNumber : ", wmi.QueryProperty("SerialNumber")
PRINT"\n----------- Win32_UserAccount ----------------\n\n"

wmi.SetClass("Win32_UserAccount")
s = wmi.QueryProperty("Caption")
IF s="" THEN PRINT"not installed: ", wmi.ErrorDescription
WHILE (s<>"")
PRINT"Name : ", s
PRINT"Disabled : ", wmi.QueryString("Disabled")
PRINT"AccountType : ", wmi.QuerySTRING("AccountType")
PRINT"SIDType : ", wmi.QuerySTRING("SIDType")
FREEHEAP(&s)
s=wmi._Next()
ENDWHILE
FREEHEAP(&s)

PRINT("\n----------- Win32_NetworkAdapter ----------------\n\n")
wmi.SetClass("Win32_NetworkAdapter")
s = wmi.QueryProperty("Caption")
IF (s="") THEN PRINT"not installed: ", wmi.ErrorDescription
WHILE (s<>"")
PRINT"Name : ", s
PRINT"mac: ", wmi.QuerySTRING("MACAddress") /* crash on "LPT" */
FREEHEAP(&s)
s=wmi._next()
ENDWHILE
FREEHEAP(&s)
PRINT"\n\nerror:\nend.", wmi.ErrorDescription
DO:UNTIL INKEY$<>""
END


SUB CWMI::CWMI()

BSTR object

ErrorDescription = "Uninitialized"
m_bstrSystemClass  = null
m_bstrQueryLanguage = SysAllocSTRING("W\x00Q\x00L\x00\x00")
CurrentState = 0
m_property          = ""
m_pLoc = null
m_pSvc = null
m_pEnumerator = null
m_pclsObj = null
ExecQueryFlags = WBEM_FLAG_FORWARD_ONLY | WBEM_FLAG_RETURN_IMMEDIATELY

'----------------------
'Step 1: Initialize COM
'----------------------
hr = CoInitializeEx(0, COINIT_MULTITHREADED)
IF hr
ErrorDescription = "Failed to initialize COM library"
RETURN
ENDIF
CurrentState |= CWMI_STATE_COINIT

'----------------------------------------------------------
  'Step 2: Set general COM security levels
  'Note: If you are using Windows 2000, you need to specify
  'the default authentication credentials for a user by using
  'a SOLE_AUTHENTICATION_LIST structure in the pAuthList
  'parameter of CoInitializeSecurity
'----------------------------------------------------------
  hr=CoInitializeSecurity(NULL,-1,NULL,NULL,RPC_C_AUTHN_LEVEL_DEFAULT,RPC_C_IMP_LEVEL_IMPERSONATE,NULL,EOAC_NONE,NULL)
IF hr
ErrorDescription = "Failed to initialize security"
RETURN
ENDIF

'-----------------------------------------
  'Step 3: Obtain the initial locator to WMI
'-----------------------------------------
  hr = CoCreateInstance(_CLSID_WbemLocator,0,CLSCTX_INPROC_SERVER,_IID_IWbemLocator, m_pLoc)
IF hr
ErrorDescription = "Failed to create IWbemLocator object"
RETURN
ENDIF

'---------------------------------------------------------------------
  'Step 4: Connect to WMI through the IWbemLocator::ConnectServer method
  'Connect to the root\cimv2 namespace with
  'the current user and obtain pointer pSvc
  'to make IWbemServices calls.
'---------------------------------------------------------------------
SET_INTERFACE m_pLoc,IWbemLocator
SET_INTERFACE m_pSvc,IWbemServices
SET_INTERFACE m_pEnumerator,IEnumWbemClassObject
SET_INTERFACE m_pclsObj,IWbemClassObject
object= SysAllocSTRING(OLESTR("ROOT\\CIMV2"))
hr = m_pLoc->ConnectServer(object,NULL,NULL,0,NULL,0,0,m_pSvc)
SysFreeSTRING(object)
IF hr
ErrorDescription = "Could not connect to root\\cimv2"
RETURN
ENDIF

'----------------------------------------
  'Step 5: Set security levels on the proxy
'----------------------------------------
  hr = CoSetProxyBlanket(m_pSvc,RPC_C_AUTHN_WINNT,RPC_C_AUTHZ_NONE,NULL,RPC_C_AUTHN_LEVEL_CALL,RPC_C_IMP_LEVEL_IMPERSONATE,NULL,EOAC_NONE) /*  <-- Crash point */
IF hr
ErrorDescription = "Could not set proxy blanket"
RETURN
ENDIF
ErrorDescription = "OK"
RETURN

ENDSUB


SUB CWMI::_CWMI()

IF (m_bstrQueryLanguage <> null) THEN SysFreeSTRING(m_bstrQueryLanguage)
SetClass("")
SetProperty("")
IF (m_pclsObj <> null) THEN m_pclsObj->Release()
IF (m_pEnumerator <> null) THEN m_pEnumerator->Release()
IF (m_pSvc <> null) THEN m_pSvc->Release()
IF (m_pLoc <> null) THEN m_pLoc->Release()
IF (CurrentState & CWMI_STATE_COINIT) THEN CoUninitialize()
RETURN

ENDSUB


SUB CWMI::SetClass(szclass:STRING)

IF (m_bstrSystemClass<>null)
SysFreeSTRING(m_bstrSystemClass)
m_bstrSystemClass = null
ENDIF
IF (szclass <> "") THEN m_bstrSystemClass = SysAllocSTRING(OLESTR("SELECT * FROM " + szclass))
RETURN

ENDSUB


SUB CWMI::SetProperty(szproperty:POINTER)

IF (m_property <> "")
FREEHEAP(&m_property)
m_property = ""
ENDIF
IF szproperty <> null THEN m_property = _OLESTR(#<STRING>szproperty)
RETURN

ENDSUB


SUB CWMI::QueryProperty(szproperty:POINTER),STRING

IF ((m_bstrQueryLanguage = null) OR (m_bstrSystemClass = null)) THEN RETURN ""
SetProperty(szproperty)
IF (m_pclsObj <> null)
m_pclsObj->Release()
m_pclsObj = null
ENDIF
IF (m_pEnumerator <> null)
m_pEnumerator->Release()
m_pEnumerator = null
ENDIF

'-------------------------------------------------------------
  'Step 6: Use the IWbemServices pointer to make requests of WMI
'-------------------------------------------------------------

ErrorDescription = "OK"
hr = m_pSvc->ExecQuery(m_bstrQueryLanguage,m_bstrSystemClass,ExecQueryFlags,NULL,m_pEnumerator)
IF hr
m_pEnumerator = null
ErrorDescription = "Query for class failed"
RETURN ""
ENDIF

'---------------------------------------------
  'Step 7: Get the data from the query in step 6
'---------------------------------------------
RETURN _Next()

ENDSUB


SUB CWMI::QueryString(szproperty:POINTER),STRING

RETURN _Next(szproperty)

ENDSUB


SUB CWMI::_Next(prop:POINTER),STRING

INT uRETURN
ISTRING ansi[260]
VARIANT vtProp
POINTER pt

IF ((m_pEnumerator = null) OR (m_property = "")) THEN RETURN ""
uRETURN = 0
ErrorDescription = "OK"
IF (prop=null)
IF (m_pclsObj <> null)
m_pclsObj->Release()
m_pclsObj = null
ENDIF
m_pEnumerator->_Next(WBEM_INFINITE, 1, m_pclsObj, &uRETURN)
IF (uRETURN = 0)
ErrorDescription = "No More"
RETURN ""
ENDIF
ENDIF
vtProp.vt = VT_EMPTY
vtProp.bstrVal = null
IF m_pclsObj <> null
IF (prop=null)
hr = m_pclsObj->_Get(m_property, 0, &vtProp, 0, 0)
ELSE
hr = m_pclsObj->_Get(OLESTR(#<STRING>prop), 0, &vtProp, 0, 0)
ENDIF
IF hr THEN RETURN ""
ENDIF
ansi = "*unsupported variant type*"
IF ((vtProp.vt = VT_BSTR) AND (vtProp.bstrVal <> null))
pt=ToAnsi(vtProp.bstrVal)
ansi=#<STRING>pt
ENDIF
IF ((vtProp.vt = VT_INT) OR (vtProp.vt = VT_I4)) THEN ansi = STR$(vtProp.intVal)
IF (vtProp.vt = VT_UI1) THEN ansi = STR$(vtProp.bVal)
IF ((vtProp.vt = VT_UINT) OR (vtProp.vt = VT_UI4)) THEN ansi = STR$(vtProp.intVal)
IF (vtProp.vt = VT_R4) THEN ansi = STR$(vtProp.fltVal)
IF (vtProp.vt = VT_R8) THEN ansi = STR$(vtProp.dblVal)
IF (vtProp.vt = VT_NULL) THEN ansi = "NULL"
IF (vtProp.vt = VT_BOOL)
IF (vtProp.boolVal<>0) THEN ansi = "TRUE" ELSE ansi="FALSE"
ENDIF
VariantClear(vtProp)
RETURN ansi

ENDSUB


SUB OLESTR(s:STRING),HEAP

INT size
POINTER wsz

size=LEN(s)+1
wsz=ALLOCHEAP(size<<1)
MultiByteToWideChar(0,0,s,size,#<STRING>wsz,size)
RETURN wsz

ENDSUB


SUB _OLESTR(s:STRING),STRING

_asm
push dword[ebp+8]
call OLESTR
mov  [ebp+8],eax
_endasm
RETURN s
ENDSUB


SUB ToAnsi(wsz:POINTER),POINTER

INT size
POINTER sz

IF (wsz=null) THEN RETURN null
size= lstrlenW(#<STRING>wsz)+1
IF (size=1) THEN RETURN null
sz=ALLOCHEAP(size>>1)
_sprintf(#<STRING>sz, "%S", #<STRING>wsz)
RETURN sz

ENDSUB


But the program fails at step 5, on the CoSetProxyBlanket function. I don't why about that error. Any suggestion ?

[sapero]

This is a bit newer version, without the old com.inc:

Code Select Expand

$INCLUDE "WbemCli.inc"
$INCLUDE "stdio.inc"
$INCLUDE "shlwapi.inc"

CLASS CWMI

PRIVATE
DECLARE CWMI()
DECLARE _CWMI()
DECLARE SetProperty(szproperty:LPWSTR)
PUBLIC
DECLARE SetClass(szclass:LPWSTR)
DECLARE QueryProperty(szproperty:LPWSTR),STRING
DECLARE QueryString(szproperty:LPWSTR),STRING
DECLARE _Next(OPT prop=null AS LPWSTR),STRING

INT     ExecQueryFlags
UINT   CurrentState
BSTR     m_bstrSystemClass
BSTR     m_bstrQueryLanguage
STRING   ErrorDescription
HRESULT hr
LPOLESTR m_property
IWbemLocator         m_pLoc
IWbemServices        m_pSvc
IWbemClassObject     m_pclsObj
IEnumWbemClassObject m_pEnumerator

ENDCLASS


CWMI wmi
STRING s

PRINT"error:"
PRINT wmi.ErrorDescription
PRINT"\n"
PRINT"\n----------- Win32_OperatingSystem ----------------\n\n"

wmi.SetClass(L"Win32_OperatingSystem")
PRINT"Name         : ", wmi.QueryProperty(L"Name")
PRINT"BootDevice   : ", wmi.QueryProperty(L"BootDevice")
PRINT"BuildType   : ", wmi.QueryProperty(L"BuildType")
PRINT"CountryCode : ", wmi.QueryProperty(L"CountryCode")
PRINT"Description : ", wmi.QueryProperty(L"Description")
PRINT"Locale       : ", wmi.QueryProperty(L"Locale")
PRINT"Manufacturer : ", wmi.QueryProperty(L"Manufacturer")
PRINT"Organization : ", wmi.QueryProperty(L"Organization")
PRINT"RegisteredUser: ", wmi.QueryProperty(L"RegisteredUser")
PRINT"Version     : ", wmi.QueryProperty(L"Version")
PRINT"SystemDevice  : ", wmi.QueryProperty(L"SystemDevice")
PRINT"SerialNumber : ", wmi.QueryProperty(L"SerialNumber")
PRINT"\n----------- Win32_UserAccount ----------------\n\n"

wmi.SetClass(L"Win32_UserAccount")
s = wmi.QueryProperty(L"Caption")
IF s="" THEN PRINT"not installed: ", wmi.ErrorDescription
WHILE (s<>"")
PRINT"Name        : ", s
PRINT"Disabled    : ", wmi.QueryString(L"Disabled")
PRINT"AccountType : ", wmi.QuerySTRING(L"AccountType")
PRINT"SIDType     : ", wmi.QuerySTRING(L"SIDType")
s=wmi._Next()
ENDWHILE

PRINT("\n----------- Win32_NetworkAdapter ----------------\n\n")
wmi.SetClass(L"Win32_NetworkAdapter")
s = wmi.QueryProperty(L"Caption")
IF (s="") THEN PRINT"not installed: ", wmi.ErrorDescription

WHILE (s<>"")
PRINT"Name : ", s
PRINT"mac: ", wmi.QuerySTRING("MACAddress")
s=wmi._next()
ENDWHILE

PRINT"\n\nerror:\nend.", wmi.ErrorDescription
$ifndef __sapero
_system("pause")
$endif
END


SUB CWMI::CWMI()

BSTR object

ErrorDescription = "Uninitialized"
m_bstrSystemClass   = null
m_bstrQueryLanguage = SysAllocSTRING(L"WQL")
CurrentState = 0
m_property      = 0
m_pLoc = null
m_pSvc = null
m_pEnumerator = null
m_pclsObj = null
ExecQueryFlags = WBEM_FLAG_FORWARD_ONLY | WBEM_FLAG_RETURN_IMMEDIATELY

'----------------------
'Step 1: Initialize COM
'----------------------
hr = CoInitializeEx(0, COINIT_MULTITHREADED)
IF hr
ErrorDescription = "Failed to initialize COM library"
RETURN
ENDIF

'----------------------------------------------------------
'Step 2: Set general COM security levels
'Note: If you are using Windows 2000, you need to specify
'the default authentication credentials for a user by using
'a SOLE_AUTHENTICATION_LIST structure in the pAuthList
'parameter of CoInitializeSecurity
'----------------------------------------------------------
hr=CoInitializeSecurity(NULL,-1,NULL,NULL,RPC_C_AUTHN_LEVEL_DEFAULT,RPC_C_IMP_LEVEL_IMPERSONATE,NULL,EOAC_NONE,NULL)
IF hr
ErrorDescription = "Failed to initialize security"
RETURN
ENDIF

'-----------------------------------------
'Step 3: Obtain the initial locator to WMI
'-----------------------------------------
hr = CoCreateInstance(_CLSID_WbemLocator,0,CLSCTX_INPROC_SERVER,_IID_IWbemLocator, m_pLoc)
IF hr
ErrorDescription = "Failed to create IWbemLocator object"
RETURN
ENDIF

'---------------------------------------------------------------------
'Step 4: Connect to WMI through the IWbemLocator::ConnectServer method
'Connect to the root\cimv2 namespace with
'the current user and obtain pointer pSvc
'to make IWbemServices calls.
'---------------------------------------------------------------------

object = SysAllocSTRING(L"ROOT\CIMV2")
hr = m_pLoc->ConnectServer(object,NULL,NULL,0,NULL,0,0,m_pSvc)
SysFreeString(object)
IF hr
ErrorDescription = "Could not connect to root\\cimv2"
RETURN
ENDIF

'----------------------------------------
 'Step 5: Set security levels on the proxy
'----------------------------------------
 hr = CoSetProxyBlanket(m_pSvc,RPC_C_AUTHN_WINNT,RPC_C_AUTHZ_NONE,NULL,RPC_C_AUTHN_LEVEL_CALL,RPC_C_IMP_LEVEL_IMPERSONATE,NULL,EOAC_NONE) /*  <-- Crash point */
IF hr
ErrorDescription = "Could not set proxy blanket"
RETURN
ENDIF
ErrorDescription = "OK"
RETURN

ENDSUB


SUB CWMI::_CWMI()

IF (m_bstrQueryLanguage <> null) THEN SysFreeString(m_bstrQueryLanguage)
SetClass(NULL)
SetProperty(NULL)
IUnknown_AtomicRelease(&m_pclsObj)
IUnknown_AtomicRelease(&m_pEnumerator)
IUnknown_AtomicRelease(&m_pSvc)
IUnknown_AtomicRelease(&m_pLoc)
CoUninitialize()
RETURN

ENDSUB


SUB CWMI::SetClass(szclass:LPWSTR)

IF (m_bstrSystemClass)
SysFreeString(m_bstrSystemClass)
m_bstrSystemClass = null
ENDIF
IF (szclass) THEN m_bstrSystemClass = SysAllocSTRING(L"SELECT * FROM " + *<wstring>szclass)
RETURN

ENDSUB


SUB CWMI::SetProperty(szproperty:LPWSTR)

IF (m_property) then SysFreeString(m_property)
m_property = 0
IF szproperty THEN m_property = SysAllocString(szproperty)
RETURN

ENDSUB


SUB CWMI::QueryProperty(szproperty:LPWSTR),STRING

IF (!m_bstrQueryLanguage OR !m_bstrSystemClass) THEN RETURN ""
SetProperty(szproperty)
IUnknown_AtomicRelease(&m_pclsObj)
IUnknown_AtomicRelease(&m_pEnumerator)

'-------------------------------------------------------------
'Step 6: Use the IWbemServices pointer to make requests of WMI
'-------------------------------------------------------------

ErrorDescription = "OK"
hr = m_pSvc->ExecQuery(m_bstrQueryLanguage,m_bstrSystemClass,ExecQueryFlags,NULL,&m_pEnumerator)
IF hr
m_pEnumerator = null
ErrorDescription = "Query for class failed"
RETURN ""
ENDIF

'---------------------------------------------
'Step 7: Get the data from the query in step 6
'---------------------------------------------
RETURN _Next()

ENDSUB


SUB CWMI::QueryString(szproperty:LPWSTR),STRING

RETURN _Next(szproperty)

ENDSUB


SUB CWMI::_Next(prop:LPWSTR),STRING

INT uRETURN
ISTRING ansi[260]
VARIANT vtProp

IF (!m_pEnumerator OR !m_property) THEN RETURN ""
uRETURN = 0
ErrorDescription = "OK"
IF (!prop)
IUnknown_AtomicRelease(&m_pclsObj)
m_pEnumerator->_Next(WBEM_INFINITE, 1, &m_pclsObj, &uRETURN)
IF (uRETURN = 0)
ErrorDescription = "No More"
RETURN ""
ENDIF
ENDIF
vtProp.vt = VT_EMPTY
vtProp.bstrVal = null
IF (m_pclsObj<>0)
IF (!prop)
hr = m_pclsObj->_Get(m_property, 0, &vtProp, 0, 0)
ELSE
hr = m_pclsObj->_Get(prop, 0, &vtProp, 0, 0)
ENDIF
IF hr THEN RETURN ""
ENDIF
ansi = "*unsupported variant type*"
VariantChangeType(&vtProp, &vtProp, VARIANT_ALPHABOOL, VT_BSTR)
IF ((vtProp.vt = VT_BSTR) AND vtProp.bstrVal)
ansi=w2s(vtProp.*<wstring>bstrVal)
ENDIF
/* IF ((vtProp.vt = VT_INT) OR (vtProp.vt = VT_I4)) THEN ansi = STR$(vtProp.intVal)
IF (vtProp.vt = VT_UI1) THEN ansi = STR$(vtProp.bVal)
IF ((vtProp.vt = VT_UINT) OR (vtProp.vt = VT_UI4)) THEN ansi = STR$(vtProp.intVal)
IF (vtProp.vt = VT_R4) THEN ansi = STR$(vtProp.fltVal)
IF (vtProp.vt = VT_R8) THEN ansi = STR$(vtProp.dblVal)
IF (vtProp.vt = VT_NULL) THEN ansi = "NULL"
IF (vtProp.vt = VT_BOOL)
IF (vtProp.boolVal<>0) THEN ansi = "TRUE" ELSE ansi="FALSE"
ENDIF*/
VariantClear(vtProp)
RETURN ansi

ENDSUB

EDIT: removed invalid FreeHeap

[King64]

Great job sapero  . I have only a question about the way that you chosen to use the COM objects. I have noticed that you use the COM objects via POINTER and not with COMREF declaration. What's the difference ?

[sapero]

I'm not using comref, nor pointers. "IWbemLocator m_pLoc" is a comref with predefined type, and you don't need to call set_interface on it.
Comref as a type can be used if
1. you want to use single variable for multiple interfaces:

Code Select Expand

comref object

object = get1()
set_interface object, IType1
object->method1()
object->Release()

object = get2()
set_interface object, IType2
object->method2()
object->Release()
2. you share your code or library, with header file (include)
 a) you want to hide the real interface name - use comref, or IUnknown.
 b) the header should "compile" always, without forcing users to include other headers.
3. you just like it

[King64]

Clear explanation. Thanks !!