PureBoard

Code: Alles auswählen

; Author : DataMiner and many other
; Tweaked by Droopy for Library purpose
; PureBasic 3.93
; 14/06/05
; reworked by DataMiner 28/07/05
;
;- KONSTANTEN  PROZEDUREN  STRUKTUREN
#VT_EMPTY = 0 
#VT_NULL = 1
#VT_I2 = 2
#VT_I4 = 3 
#VT_R4 = 4
#VT_R8 = 5
#VT_CY = 6
#VT_DATE = 7
#VT_BSTR = 8
#VT_DISPATCH = 9
#VT_ERROR = 10
#VT_BOOL = 11
#VT_VARIANT = 12
#VT_UNKNOWN = 13
#VT_DECIMAL = 14
#VT_I1 = 16 
#VT_UI1 = 17
#VT_UI2 = 18
#VT_UI4 = 19
#VT_I8 = 20
#VT_UI8 = 21
#VT_INT = 22
#VT_UINT = 23
#VT_VOID = 24
#VT_HRESULT = 25
#VT_PTR = 26
#VT_SAFEARRAY = 27
#VT_CARRAY = 28
#VT_USERDEFINED = 29
#VT_LPSTR = 30
#VT_LPWSTR = 31
#VT_RECORD = 36
#VT_INT_PTR = 37
#VT_UINT_PTR = 38 
#VT_FILETIME = 64 
#VT_BLOB = 65 
#VT_STREAM = 66 
#VT_STORAGE = 67 
#VT_STREAMED_OBJECT = 68 
#VT_STORED_OBJECT = 69 
#VT_BLOB_OBJECT = 70 
#VT_CF = 71 
#VT_CLSID = 72
#VT_VERSIONED_STREAM = 73
#VT_BSTR_BLOB = $FFF 
#VT_VECTOR = $1000 
#VT_ARRAY = $2000 
#VT_BYREF = $4000 
#VT_RESERVED = $8000 
#VT_ILLEGAL = $FFFF 
#VT_ILLEGALMASKED = $FFF 
#VT_TYPEMASK = $FFF 
#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
#VARIANT_TRUE = $FFFF 
#VARIANT_FALSE = $0000 
#WMISeparator = "," 

Structure DOUBLE 
  high.l 
  low.l 
EndStructure 

Structure BRECORD  
  pvRecord.l;
  IRecordInfo.l
EndStructure

Structure Variant
  vt.w 
  wReserved1.w 
  wReserved2.w 
  wReserved3.w 
  StructureUnion
    bVal.b   
    iVal.w   
    lVal.l  
    Value.l   
    dVal.DOUBLE   
    boolVal.w 
    bstrVal.l 
    scode.l   
    record.BRECORD
  EndStructureUnion
EndStructure 

Structure SIGNSCALE
  scale.b
  sign.b
EndStructure

Structure DECIMAL
  wReserved.w
  signscale.SIGNSCALE
  high32.l
  low64.DOUBLE
EndStructure
  
Structure pToVariant  
  a.l
  b.l
  c.l
  d.l
EndStructure

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

; Wird nur benötigt wenn die COMLib nicht installiert ist ...
; only needed if COMLib is not present...
; Procedure.s Uni2Ansi(*Unicode.l) 
  ; size.l = WideCharToMultiByte_(#CP_ACP, 0, *Unicode, -1, #Null, #Null, #Null, #Null) 
  ; ansi.s=Space(size) 
  ; WideCharToMultiByte_(#CP_ACP, 0, *Unicode, -1, @ansi, size, #Null, #Null) 
  ; ProcedureReturn ansi 
; EndProcedure

ProcedureDLL.s WMI(WMICommand.s)
  ;- 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
  k=CountString(WMICommand,#WMISeparator)
  Dim wmitxt$(k)
  For i=0 To k
    wmitxt$(i) = Trim(StringField(WMICommand,i+1,#WMISeparator))
  Next
  
  hres=svc\ExecQuery(ansi2bstr("WQL"),ansi2bstr(wmitxt$(0)), #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=1 To k
    hres=pclsObj\get(ansi2bstr(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)
        ;Dim rgVar(plUbound)
        For z=0 To plUbound
          SafeArrayGetElement_(x\lVal, @z, @rgVar)
          val.s=val.s+", "+Uni2Ansi(rgVar)
        Next
        val.s=Mid(val.s, 3, Len(val.s))
        
      Case 8195
        val.s=""
        nDim=SafeArrayGetDim_(x\scode)
        SafeArrayGetUBound_(x\scode, nDim, @plUbound)
        ;Dim rgVar(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=Uni2Ansi(x\bstrVal)
        
      Case 3
        val.s=Str(x\lVal)
        
      Case 1
        val.s="n/a"
        
      Default
        val.s=""
        
    EndSelect
    If uReturn <> 0: wmi$=wmi$+wmitxt$(i)+" = "+val+Chr(10)+Chr(13): EndIf
  Next
Until uReturn = 0

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

ProcedureReturn wmi$
EndProcedure

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

EndDataSection

;- MAIN
MessageRequester("SELECT * FROM Win32_NetworkAdapterConfiguration",WMI("SELECT * FROM Win32_NetworkAdapterConfiguration, Description, IPAddress, DNSServerSearchOrder"))
;MessageRequester("SELECT * FROM Win32_VideoController",WMI("SELECT * FROM Win32_VideoController, DeviceID, Caption, AdapterDACType, AdapterRAM, DriverVersion, InstalledDisplayDrivers, CurrentBitsPerPixel, CurrentRefreshRate, CurrentHorizontalResolution, CurrentVerticalResolution"))
;MessageRequester("SELECT * FROM Win32_BIOS",WMI("SELECT * FROM Win32_BIOS, BiosCharacteristics, BIOSVersion, InstallDate, SerialNumber"))