How to use Windows Management Instrumentation (WMI) with PB

DataMiner · Post by **DataMiner** » Fri Apr 15, 2005 4:41 pm

Code updated for 5.20+

One first: I´m not the autor of the code, only the "manager" of many source-snipsets, and only a small part of it is made by me. Let me say a big "Thank You!" to all coders who will find their code here

BUT it´s the first working sample, using the basic calls of WMI.
It will work on MS-OS > Win9x. Win9x (and NT4) needs the WMI-Core installed first.
http://msdn.microsoft.com/library/defau ... st/wmi.asp

***********************************************************
* EDIT (25.04.2007) PB4 and unicode updated code, reworked by ts-soft *
***********************************************************

Code: Select all

;- WMI Intialisierung, Datenabruf und Deinitialisierung 
; rewritten for PB4 and use as an "IncludeFile" 
; save this code as "wmi.pbi" 
; use it in your project with: 
; 
; includefile "wmi.pbi" 
; WMI_INIT() 
; WMI_Call("Select * FROM Win32_OperatingSystem", "Caption, CSDVersion, SerialNumber, RegisteredUser, Organization") 
; ResetList(wmidata()) 
; While NextElement(wmidata()) 
;   Debug wmidata()  ; Alle Listenelemente darstellen / show all elements 
; Wend 
; WMI_RELEASE("OK") 
; 
;---------------------------------------------------------------------------------------------------------------- 
; Update für PB4 Final by ts-soft 
; unnötige Konstanten und Structuren entfernt (sind in PB enthalten) 
; voller Unicode support 
; --------------------------------------------------------------------------------------------------------------- 
;- KONSTANTEN  PROZEDUREN  STRUKTUREN 

#COINIT_MULTITHREAD = 0 
#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 
#IFlags = #wbemFlagReturnImmediately + #wbemFlagForwardOnly 
#WBEM_INFINITE = $FFFFFFFF 
#WMISeparator = "," 

Procedure StringToBStr(string$) 
  Protected Unicode$ = Space(StringByteLength(string$, #PB_Unicode) + 1) 
  Protected bstr_string 
  PokeS(@Unicode$, String$, -1, #PB_Unicode) 
  bstr_string = SysAllocString_(@Unicode$) 
  ProcedureReturn bstr_string 
EndProcedure 

Procedure.s UniToPB(*Unicode) 
  ProcedureReturn PeekS(*Unicode, #PB_Any, #PB_Unicode) 
EndProcedure 

Global txt$, loc.IWbemLocator, svc.IWbemServices, pEnumerator.IEnumWbemClassObject, pclsObj.IWbemClassObject, x.Variant, error 
Global NewList wmidata.s() 

ProcedureDLL.s wmi_release(dumdum$) 
  ;- WMI Release 
  svc\release() 
  loc\release() 
  pEnumerator\release() 
  If error=0 
    pclsObj\release() 
  EndIf 
  CoUninitialize_() 
  If FindString(dumdum$, "ERROR", 1) 
    MessageRequester("", dumdum$) 
    End 
  EndIf 
EndProcedure 

ProcedureDLL.s wmi_init() 
  ;- WMI Initialize 
  txt$="" 
  CoInitializeEx_(0,#COINIT_MULTITHREAD) 
  hres=CoInitializeSecurity_(0, -1,0,0,#RPC_C_AUTHN_LEVEL_CONNECT,#RPC_C_IMP_LEVEL_IDENTIFY,0,#EOAC_NONE,0) 
  If hres <> 0: txt$="ERROR: unable To call CoInitializeSecurity": wmi_release(txt$): EndIf 
  hres=CoCreateInstance_(?CLSID_WbemLocator,0,#CLSCTX_INPROC_SERVER,?IID_IWbemLocator,@loc.IWbemLocator) 
  If hres <> 0: txt$="ERROR: unable To call CoCreateInstance": wmi_release(txt$): EndIf 
  hres=loc\ConnectServer(StringToBStr("root\cimv2"),0,0,0,0,0,0,@svc.IWbemServices) 
  If hres <> 0: txt$="ERROR: unable To call IWbemLocator::ConnectServer": wmi_release(txt$): EndIf 
  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: txt$="ERROR: unable To call CoSetProxyBlanket": wmi_release(txt$): 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: txt$="ERROR: unable To call CoSetProxyBlanket": wmi_release(txt$): EndIf 
  pUnk\release() 
  ProcedureReturn txt$ 
EndProcedure 

ProcedureDLL.s WMI_Call(WMISelect.s, WMICommand.s) 
  ;- Call Data 
  ;OnErrorResume() 
  error=0 
  WMICommand=WMISelect+","+WMICommand 
  ClearList(wmidata()) 
  k=CountString(WMICommand,#WMISeparator) 
  Dim wmitxt$(k) 
  For i=0 To k 
    wmitxt$(i) = Trim(StringField(WMICommand,i+1,#WMISeparator)) 
  Next 
  
  hres=svc\ExecQuery(StringToBStr("WQL"),StringToBStr(wmitxt$(0)), #IFlags,0,@pEnumerator.IEnumWbemClassObject) 
  If hres <> 0: txt$="ERROR: unable To call IWbemServices::ExecQuery": wmi_release(txt$): EndIf 
  hres=pEnumerator\reset() 
  Repeat 
  hres=pEnumerator\Next(#WBEM_INFINITE, 1, @pclsObj.IWbemClassObject, @uReturn) 
  For i=1 To k 
    Sleep_(0) 
    If uReturn <> 0 
      
      hres=pclsObj\get(StringToBStr(wmitxt$(i)), 0, @x.Variant, 0, 0) 
      
      type=x\vt 
      
      Select type 
          
        Case 8200 
          val.s="" 
          nDim=SafeArrayGetDim_(x\lVal) 
          SafeArrayGetUBound_(x\lVal, nDim, @plUbound) 
          For z=0 To plUbound 
            SafeArrayGetElement_(x\lVal, @z, @rgVar) 
            val.s=val.s+", "+UniToPB(rgVar) 
          Next 
          val.s=Mid(val.s, 3, Len(val.s)) 
          
        Case 8195 
          val.s="" 
          nDim=SafeArrayGetDim_(x\scode) 
          SafeArrayGetUBound_(x\scode, nDim, @plUbound) 
          For z=0 To plUbound 
            SafeArrayGetElement_(x\scode, @z, @rgVar) 
            val.s=val.s + ", " +  Str(rgVar) 
          Next 
          val.s=Mid(val.s, 3, Len(val.s)) 
          
        Case 11 
          If x\boolVal=0 
            val.s="FALSE" 
          ElseIf x\boolVal=-1 
            val.s="TRUE" 
          EndIf 
          
        Case 8 
          val.s=UniToPB(x\bstrVal) 
          
        Case 3 
          val.s=Str(x\lVal) 
          
        Case 1 
          val.s="n/a" 
          
        Default 
          val.s="" 
          
      EndSelect 
      
      If FindString(wmitxt$(i), "Date", 1) Or FindString(wmitxt$(i), "Time", 1) 
        AddElement(wmidata()) 
        wmidata()=Mid(val, 7, 2)+"."+Mid(val, 5, 2)+"."+Mid(val, 1, 4)+" "+Mid(val, 9, 2)+":"+Mid(val, 11,2)+":"+Mid(val, 13,2) ;+Chr(10)+Chr(13) 
      Else 
        AddElement(wmidata()) 
        wmidata()=Trim(val) ;+Chr(10)+Chr(13) 
      EndIf 
    EndIf 
  Next 
  
Until uReturn = 0 
If ListSize(wmidata())=0 
  For i=1 To k 
    AddElement(wmidata()) 
    wmidata()="n/a" 
  Next 
  error=1 
EndIf 
ProcedureReturn wmidata() 
EndProcedure 

;- Data Section 
DataSection 
  CLSID_IEnumWbemClassObject: 
  ;1B1CAD8C-2DAB-11D2-B604-00104B703EFD 
  Data.i $1B1CAD8C 
  Data.w $2DAB, $11D2 
  Data.b $B6, $04, $00, $10, $4B, $70, $3E, $FD 
  IID_IEnumWbemClassObject: 
  ;7C857801-7381-11CF-884D-00AA004B2E24 
  Data.i $7C857801 
  Data.w $7381, $11CF 
  Data.b $88, $4D, $00, $AA, $00, $4B, $2E, $24 
  CLSID_WbemLocator: 
  ;4590f811-1d3a-11d0-891f-00aa004b2e24 
  Data.i $4590F811 
  Data.w $1D3A, $11D0 
  Data.b $89, $1F, $00, $AA, $00, $4B, $2E, $24 
  IID_IWbemLocator: 
  ;dc12a687-737f-11cf-884d-00aa004b2e24 
  Data.i $DC12A687 
  Data.w $737F, $11CF 
  Data.b $88, $4D, $00, $AA, $00, $4B, $2E, $24 
  IID_IUnknown: 
  ;00000000-0000-0000-C000-000000000046 
  Data.i $00000000 
  Data.w $0000, $0000 
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46 
  
EndDataSection

Have fun!

dell_jockey · Post by **dell_jockey** » Fri Apr 15, 2005 7:52 pm

Danke schön, DataMiner!

DataMiner · Post by **DataMiner** » Fri Apr 15, 2005 8:03 pm

... here is another one. If you want to call several classes with objects:

Code: Select all

;- KONSTANTEN  PROZEDUREN
#COINIT_MULTITHREAD=0
#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
#IFlags = #wbemFlagReturnImmediately + #wbemFlagForwardOnly
#WBEM_INFINITE=$FFFFFFFF

Procedure.l ansi2bstr(ansi.s)
  size.l=MultiByteToWideChar_(#CP_ACP,0,ansi,-1,0,0)
  Dim unicode.w(size)
  MultiByteToWideChar_(#CP_ACP, 0, ansi, Len(ansi), unicode(), size)
  ProcedureReturn SysAllocString_(@unicode())
EndProcedure

Procedure bstr2string (bstr)
  Shared result.s
  result.s = ""
  pos=bstr
  While PeekW (pos)
    result=result+Chr(PeekW(pos))
    pos=pos+2
  Wend
  ProcedureReturn @result
EndProcedure

;- WMI Initialize
CoInitializeEx_(0,#COINIT_MULTITHREAD)
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): Goto cleanup: EndIf
hres=CoCreateInstance_(?CLSID_WbemLocator,0,#CLSCTX_INPROC_SERVER,?IID_IWbemLocator,@loc.IWbemLocator)
If hres <> 0: MessageRequester("ERROR", "unable to call CoCreateInstance", #MB_OK): Goto cleanup: EndIf
hres=loc\ConnectServer(ansi2bstr("root\cimv2"),0,0,0,0,0,0,@svc.IWbemServices)
If hres <> 0: MessageRequester("ERROR", "unable to call IWbemLocator::ConnectServer", #MB_OK): Goto cleanup: EndIf
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): Goto cleanup: 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): Goto cleanup: EndIf
pUnk\release()

;- CallData
Restore CallData1
Read k
Dim wmitxt$(k)
For i=1 To k
  Read wmitxt$(i)
Next
Gosub WMI
MessageRequester(wmitxt$(1), wmi$, #MB_OK)
wmi$=""
Restore CallData2
Read k
Dim wmitxt$(k)
For i=1 To k
  Read wmitxt$(i)
Next
Gosub WMI
MessageRequester(wmitxt$(1), wmi$, #MB_OK)
wmi$=""
Restore CallData3
Read k
Dim wmitxt$(k)
For i=1 To k
  Read wmitxt$(i)
Next
Gosub WMI
MessageRequester(wmitxt$(1), wmi$, #MB_OK)
wmi$=""
Restore CallData4
Read k
Dim wmitxt$(k)
For i=1 To k
  Read wmitxt$(i)
Next
Gosub WMI
MessageRequester(wmitxt$(1), wmi$, #MB_OK)
Goto cleanup

WMI:
hres=svc\ExecQuery(ansi2bstr("WQL"),ansi2bstr(wmitxt$(1)), #IFlags,0,@pEnumerator.IEnumWbemClassObject)
If hres <> 0: MessageRequester("ERROR", "unable to call IWbemServices::ExecQuery", #MB_OK): Goto cleanup: EndIf
hres=pEnumerator\reset()
Repeat
hres=pEnumerator\Next(#WBEM_INFINITE, 1, @pclsObj.IWbemClassObject, @uReturn)
For i=2 To k
  mem=AllocateMemory(1000)
  hres=pclsObj\get(ansi2bstr(wmitxt$(i)), 0, mem, 0, 0)
  type=PeekW(mem)
  Select type
    Case 11
      v=PeekL(mem+8)
      If v=0 
        val.s="FALSE" 
      Else 
        val.s="TRUE"
      EndIf
    Case 8
      val.s=PeekS(bstr2string(PeekL(mem+8)))
    Case 3
      val.s=Str(PeekL(mem+8))
    Default
      val.s=""
  EndSelect
  If uReturn <> 0: wmi$=wmi$+wmitxt$(i)+" = "+val+Chr(10)+Chr(13): EndIf
  FreeMemory(mem)
Next
Until uReturn = 0
Return

;- Cleanup
cleanup:
svc\release()
loc\release()
pEnumerator\release()
pclsObj\release()
CoUninitialize_()
End

;- DATA
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

CallData1:
Data.l 6
Data.s "Select * FROM Win32_OperatingSystem", "Name", "CSDVersion", "SerialNumber", "RegisteredUser", "Organization"
CallData2:
Data.l 4
Data.s "SELECT * FROM Win32_BIOS", "Manufacturer", "Caption", "SerialNumber"
CallData3:
Data.l 10
Data.s "SELECT * FROM Win32_VideoController", "DeviceID", "Caption", "AdapterDACType", "DriverVersion", "InstalledDisplayDrivers", "CurrentBitsPerPixel", "CurrentRefreshRate", "CurrentHorizontalResolution", "CurrentVerticalResolution"
CallData4:
Data.l 9
Data.s "SELECT * FROM Win32_LogicalDisk", "DeviceID", "Description", "VolumeName", "FileSystem", "Size", "FreeSpace", "VolumeSerialNumber", "Compressed"

EndDataSection

Tranquil · Post by **Tranquil** » Sat Apr 16, 2005 7:38 pm

Nice one!! Very nice one! thanks for sharing!!

NoahPhense · Post by **NoahPhense** » Sat Apr 16, 2005 8:01 pm

Tranquil wrote:Nice one!! Very nice one! thanks for sharing!!

That last one is very nice. I'll be using it in my machine dependant
encryption algorythm.

Very nice!

- np

DataMiner · Post by **DataMiner** » Wed Apr 20, 2005 7:24 pm

Thank you for your answers. Too much the honour.

Perhaps it was already noticeable someone that "type" can take the values 8200 and 8195. "8200" is the return value for a text array.
Unfortunately I still have found no way to pick out such an array from the memory.
I would be grateful for each suggestion.