WMI is your friend. Try this code
Code: Select all
;WMIQuery Version 1.00
;
;Pure Basic 4.51, 4.61, 5.00 Beta
;
;Contributor : Andre (2004), DataMiner (2005) ..... others who have tried :)
;Update : falsam (19.09.2012)
;
;Add
;Procedure WMIQuery(WMIReqSql.s, Map WMIMap.s())
;Run a WMI query and retrieve one or all properties of a class in a map
;
;Example
;NewList WMIResult.WMIClass()
;If WMIQuery("Select Manufacturer, Model, SystemType from Win32_ComputerSystem", WMIResult())
; ForEach WMIResult()
; Debug WMIResult()\Property + "=" + WMIResult()\Value
; Next
;EndIf
;WMI constants
#RPC_C_AUTHN_LEVEL_CONNECT = 2
#RPC_C_IMP_LEVEL_IDENTIFY = 2
#EOAC_NONE = 0
#RPC_C_AUTHN_WINNT = 10
#RPC_C_AUTHZ_NONE = 0
#RPC_C_AUTHN_LEVEL_CALL = 3
#RPC_C_IMP_LEVEL_IMPERSONATE = 3
#CLSCTX_INPROC_SERVER = 1
#WBEMFlagReturnImmediately = 16
#wbemFlagForwardOnly = 32
#WBEM_INFINITE = $FFFFFFFF
#IFlags = #wbemFlagReturnImmediately + #wbemFlagForwardOnly
Structure WMIClass
Property.s
Value.s
EndStructure
Procedure.l ansi2bstr(ansi.s)
Protected Size.l, i.i, tmp.s
size=MultiByteToWideChar_(#CP_ACP,0,ansi,Len(ansi),0,0)
Dim unicode.w(size)
MultiByteToWideChar_(#CP_ACP, 0, ansi, Len(ansi), unicode(), size);#CP_ACP
For i=0 To size
tmp + Hex(unicode(i),#PB_Unicode)
Next
ProcedureReturn SysAllocString_(@unicode())
EndProcedure
Procedure bstr2string (bstr)
Static result.s
result = PeekS(bstr, -1, #PB_Unicode)
ProcedureReturn @result
EndProcedure
; Interrogate WMI Database
Procedure WMIQuery(WMIReqSql.s, List WMI.WMIClass())
Protected Mem.l
Protected hres.i
Protected loc.IWbemLocator
Protected svc.IWbemServices
Protected pUnk.IUnknown
Protected pEnumerator.IEnumWbemClassObject
Protected pclsObj.IWbemClassObject
Protected uReturn
Protected sf.l
Protected lBound.i, uBound.i, i.i
Protected temp.l, x.Variant, Type.i
Protected Property.s, Val.s
Protected nDim.i, plUbound.i, z.i, rgVar
ClearList(WMI())
; --- Step 1: Initialize COM parameters with a call to CoInitializeEx
CoInitializeEx_(0, #COINIT_MULTITHREADED)
; --- Step 2: Initialize COM process security by calling CoInitializeSecurity.
hres=CoInitializeSecurity_(0, -1,0,0,#RPC_C_AUTHN_LEVEL_CONNECT,#RPC_C_IMP_LEVEL_IDENTIFY,0,#EOAC_NONE,0)
If hres <> 0
MessageRequester("ERROR", "unable to call CoInitializeSecurity", #MB_OK)
CoUninitialize_()
ProcedureReturn #False
EndIf
; --- Step 3: Obtain the initial locator to WMI by calling CoCreateInstance.
hres=CoCreateInstance_(?CLSID_WbemLocator,0,#CLSCTX_INPROC_SERVER,?IID_IWbemLocator,@loc.IWbemLocator)
If hres <> 0
MessageRequester("ERROR", "unable to call CoCreateInstance", #MB_OK)
loc\release()
CoUninitialize_()
ProcedureReturn #False
EndIf
; --- Step 4: Obtain a pointer to IWbemServices for the root\cimv2 namespace on the local computer by calling IWbemLocator::ConnectServer.
;hres=loc\ConnectServer(Ansi2Uni("root\cimv2"),0,0,0,0,0,0,@svc)
If #PB_Compiler_Unicode = 1;we create unicode application
hres=loc\ConnectServer(@"root\cimv2" ,0,0,0,0,0,0,@svc.IWbemServices)
Else; non unicode
hres=loc\ConnectServer(ansi2bstr("root\cimv2"),0,0,0,0,0,0,@svc.IWbemServices)
EndIf
If hres <> 0
MessageRequester("ERROR", "unable to call IWbemLocator::ConnectServer", #MB_OK)
svc\release()
loc\release()
CoUninitialize_()
ProcedureReturn #False
EndIf
; --- Step 5: Set IWbemServices proxy security so the WMI service can impersonate the client by calling CoSetProxyBlanket.
hres=svc\queryinterface(?IID_IUnknown,@pUnk.IUnknown)
hres=CoSetProxyBlanket_(svc,#RPC_C_AUTHN_WINNT,#RPC_C_AUTHZ_NONE,0,#RPC_C_AUTHN_LEVEL_CALL,#RPC_C_IMP_LEVEL_IMPERSONATE,0,#EOAC_NONE)
If hres <> 0
MessageRequester("ERROR", "unable to call CoSetProxyBlanket", #MB_OK)
svc\release()
loc\release()
CoUninitialize_()
ProcedureReturn #False
EndIf
hres=CoSetProxyBlanket_(pUnk,#RPC_C_AUTHN_WINNT,#RPC_C_AUTHZ_NONE,0,#RPC_C_AUTHN_LEVEL_CALL,#RPC_C_IMP_LEVEL_IMPERSONATE,0,#EOAC_NONE)
If hres <> 0
MessageRequester("ERROR", "unable to call CoSetProxyBlanket", #MB_OK)
svc\release()
loc\release()
CoUninitialize_()
ProcedureReturn #False
EndIf
pUnk\release()
; --- Step 6: Use the IWbemServices pointer to make requests of WMI.
;hres=svc\ExecQuery(Ansi2Uni("WQL"), Ansi2Uni(WMIReqSql), #IFlags,0,@pEnumerator)
;hres=svc\ExecQuery(@"WQL",@WMIobj, #IFlags,0,@pEnumerator.IEnumWbemClassObject)
If #PB_Compiler_Unicode = 1
hres=svc\ExecQuery(@"WQL",@WMIReqSql, #IFlags,0,@pEnumerator.IEnumWbemClassObject)
Else
hres=svc\ExecQuery(ansi2bstr("WQL"),ansi2bstr(WMIReqSql), #IFlags,0,@pEnumerator.IEnumWbemClassObject)
EndIf
If hres <> 0
MessageRequester("ERROR", "unable to call IWbemServices::ExecQuery", #MB_OK)
svc\Release()
loc\Release()
pEnumerator\Release()
CoUninitialize_()
ProcedureReturn #False
EndIf
; --- Step 7: Get the data from the WQL query. The IEnumWbemClassObject pointer is linked to the data objects that the query returned,
; --- and the data objects can be retrieved with the IEnumWbemClassObject::Next method. This method links the data objects to an IWbemClassObject pointer
; --- that is passed into the method. Use the IWbemClassObject::Get method to get the desired information from the data objects.
mem=AllocateMemory(1000)
hres=pEnumerator\reset()
Repeat
hres = pEnumerator\Next(#WBEM_INFINITE, 1, @pclsObj.IWbemClassObject, @uReturn)
If uReturn = 0
Break
EndIf
; get a list with the names of the properties.
hres=pclsObj\GetNames(0, 0, 0,@sf.l); get a list with the names of the properties.
SafeArrayGetLBound_(sf, 1, @lBound)
SafeArrayGetUBound_(sf, 1, @uBound)
Dim indices(1)
For i = lbound To ubound
indices(0) = i
SafeArrayGetElement_(sf, @indices(), @temp)
If temp
Property = PeekS(temp, -1, #PB_Unicode)
If #PB_Compiler_Unicode = 1
hres=pclsObj\get(@Property, 0, mem, 0, 0)
Else
hres=pclsObj\get(ansi2bstr(Property), 0, mem, 0, 0)
EndIf
type=PeekW(mem)
Select type
Case 8
val.s=PeekS(bstr2string(PeekL(mem+8)))
Case 3
val.s=Str(PeekL(mem+8))
Default
val.s=""
EndSelect
If FindString(WMIReqSql,"*",1) <> 0;we need everything, not just some specific properties
AddElement(WMI())
WMI()\Property = Property
WMI()\Value = val
ElseIf Left(Property,1)<>"_";we need some specific properties, not all, not these starting with '_'.
AddElement(WMI())
WMI()\Property = Property
WMI()\Value = val
EndIf
EndIf
Next
Until uReturn = 0
; --- Step 8: Cleanup
svc\release()
loc\release()
pEnumerator\release()
If uReturn
pclsObj\release()
EndIf
CoUninitialize_()
ProcedureReturn #True
EndProcedure
;- Data Section
DataSection
CLSID_IEnumWbemClassObject:
;1B1CAD8C-2DAB-11D2-B604-00104B703EFD
Data.l $1B1CAD8C
Data.w $2DAB, $11D2
Data.b $B6, $04, $00, $10, $4B, $70, $3E, $FD
IID_IEnumWbemClassObject:
;7C857801-7381-11CF-884D-00AA004B2E24
Data.l $7C857801
Data.w $7381, $11CF
Data.b $88, $4D, $00, $AA, $00, $4B, $2E, $24
CLSID_WbemLocator:
;4590f811-1d3a-11d0-891f-00aa004b2e24
Data.l $4590F811
Data.w $1D3A, $11D0
Data.b $89, $1F, $00, $AA, $00, $4B, $2E, $24
IID_IWbemLocator:
;dc12a687-737f-11cf-884d-00aa004b2e24
Data.l $DC12A687
Data.w $737F, $11CF
Data.b $88, $4D, $00, $AA, $00, $4B, $2E, $24
IID_IUnknown:
;00000000-0000-0000-C000-000000000046
Data.l $00000000
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
EndDataSection
...otherwise he sticks out his tongue 
