PureBasic und Windows Management Instrumentation (WMI) *PB4*

[DataMiner]

Code überarbeitet für PB4.
Siehe ersten Beitrag.

[bingo]

auch mit pb4 gibts bei mir keinerlei probleme mit wmi ...

was unicode betrifft ...
ich bleibe bei der klassischen methode und implementiere unicode nur dann , wenn unbedingt notwendig (also unicode in den compiler-settings bleibt aus) .

[DROOPY]

Thanks a lot Dataminer

[DataMiner]

auch mit pb4 gibts bei mir keinerlei probleme mit wmi ...

was unicode betrifft ...
ich bleibe bei der klassischen methode und implementiere unicode nur dann , wenn unbedingt notwendig (also unicode in den compiler-settings bleibt aus) .

Jo, dabei werde ich auch erst mal bleiben. Mal sehen was PB4 final so bringt. Momentan renne ich mit den neuen Funktionen immer nur gegen die Wand, sprich: es kommen Ergebnisse die irgendwie nichts mit dem Code zu tun haben. Liegt wahrscheinlich an mir...

[ts-soft]

Ist wohl ein bißchen eingeschlafen hier

Hab die Include mal ein wenig ausgemistet und Unicode-tauglich gemacht!

Code: Alles auswählen

;- WMI Intialisierung, Datenabruf und Deinitialisierung
; rewritten for PB4 and use as an "IncludeFile"
; save this code as "wmi.pb"
; use it in your project with:
;
; includefile "wmi.pb"
; 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.l
  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.l
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 CountList(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.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

[DataMiner]

Hej, KLASSE!
Vielen Dank, ts-soft

[scholly]

moin, moin...

Der Beispiel-Code funktioniert mit Win32_CDROMDrive und Win32_OperatingSystem, aber irgendwie nicht, wenn ich Win32_PhysicalMedia benutzen will:

Code: Alles auswählen

IncludeFile "wmi.pbi"

WMI_INIT()
 WMI_Call("Select * FROM Win32_CDROMDrive", "Drive, Caption, Description, DeviceID")
 ResetList(wmidata())
 While NextElement(wmidata())
   Debug wmidata()  ; Alle Listenelemente darstellen / show all elements
 Wend
WMI_RELEASE("OK")
 
Debug "--------------------"

Procedure.s CheckOptical(cdvdLW.s)
  TotalNumberOfBytes.q
  GetDiskFreeSpaceEx_(@cdvdLW, @egal1, @TotalNumberOfBytes, @egal2)
  Debug " "
  Debug cdvdLW
  Debug "TotalNumberOfBytes     : " + StrU(TotalNumberOfBytes,#Quad)
  
  If TotalNumberOfBytes < (800*1024*1024);größte mir bekannte CD
    ProcedureReturn "CD"
  Else
    ProcedureReturn "DVD"
  EndIf   
EndProcedure

Debug "in LW y: ist eine " + checkoptical("y:\") ; zum testen eine CD drin
Debug "in LW z: ist eine " + checkoptical("z:\") ; zum testen eine DVD drin

Debug "--------------------"

WMI_INIT()
 WMI_Call("Select * FROM Win32_PhysicalMedia", "Name, MediaType, Serialnumber, MediaDescription,")
 ResetList(wmidata())
 While NextElement(wmidata())
   Debug wmidata()  ; Alle Listenelemente darstellen / show all elements
 Wend
WMI_RELEASE("OK")

Meine Prozedure soll nur sicherstellen, daß ich sehe, was wo drinne is
Als Ausgabe erhalte ich:

Code: Alles auswählen

Z:
TSSTcorp CD/DVDW SH-S182D
CD-ROM-Laufwerk
IDE\CDROMTSSTCORP_CD/DVDW_SH-S182D_______________SB06____\5&39971A7A&0&0.1.0
Y:
HL-DT-ST DVDRAM GSA-4163B
CD-ROM-Laufwerk
IDE\CDROMHL-DT-ST_DVDRAM_GSA-4163B_______________A106____\334B354333313242313020322020202020202020
--------------------
 
y:\
TotalNumberOfBytes     : 530610176
in LW y: ist eine CD
 
z:\
TotalNumberOfBytes     : 4646107136
in LW z: ist eine DVD
--------------------
n/a
n/a
S013J20XC58774
n/a
n/a
n/a
n/a
n/a
n/a
n/a

Was mich extrem wundert, ist die Art/Anzahl der Ausgaben im letzten Teil:
Ich Frage 4 Werte ab, bekomme aber 10 Ausgaben und komischerweise nur eine "Serialnumber", die an derselben Stelle und gleich bleibt, auch wenn ich die beiden Scheiben tausche.

Seeehr merkwürdig

bis denne... scholly

[DataMiner]

@ scholly

n/a bedeutet das x/vt dem Variant-Typ 1 oder #VT_Null entspricht, also als Inhalt NULL hat.
Habe es jetzt nicht selbst ausprobiert, aber was erhälst du wenn du die gleiche Abfrage mit scriptomatic machst?
Dazu kommt das Win32_PhysicalMedia nur mit XP und Vista funktioniert. Siehe http://msdn2.microsoft.com/en-us/library/aa394346.aspx

Eine Übersicht über die Variant-Typen findest du hier: http://www.canaimasoft.com/f90vb/Online ... /TH_99.htm
Wenn du Zeit und Lust hast kannst du ja gerne noch die fehlenden Typen in wmi.pbi integrieren

[scholly]

OS ist XP. SP2 und up to date.
2 DVD-Brenner mit gebrannten Medien drin, einer (y:\) mit einer CD-R, der andere (z:\) mit einer DVD-R.

Sriptomatic (1 oder 2) zeigen für beide "TAG" an, für die DVD wird anscheinend auch die "Serialnumber" angezeigt.

Zeit hätte ich schon, aber an der Lust fehlt es, weil ich eh (noch) nicht verstehe, was da in dem .pbi überhaupt abgeht

[AndyMars]

Ich hoffe es nimmt mir niemand übel, wenn ich diesen Thread wieder ausgrabe... aber ich finde ihn wirklich interessant.

Mit PB 4.3 muss man den ein oder anderen Befehl ersetzten - hab ich soweit auch gemacht, das ist kein Problem. Aber bei Zeile 89 (Prozedur WMI_Call()) weiss ich nicht, wie OnErrorResume() zu ersetzen wäre. Weiss das jemand?

Ich habs für meine (Test-)Zwecke einfach mal auskommentiert - dann gings - aber das ist wohl nicht im Sinne des Erfinders...