WMI direkt mit PB?

Windowsspezifisches Forum , API ,..
Beiträge, die plattformübergreifend sind, gehören ins 'Allgemein'-Forum.
Antworten
Benutzeravatar
DataMiner
Beiträge: 220
Registriert: 10.10.2004 18:56

WMI direkt mit PB?

Beitrag von DataMiner »

Hallo zusammen!

Wie kann ich, ohne den Umweg über ein VBS-Script, von PB aus auf WMI zugreifen?
z.B. dieses VBS-Script:

Code: Alles auswählen

On Error Resume Next

Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20

arrComputers = Array("42F0ECB1")
For Each strComputer In arrComputers
   WScript.Echo
   WScript.Echo "=========================================="
   WScript.Echo "Computer: " & strComputer
   WScript.Echo "=========================================="

   Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
   Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_PnPEntity", "WQL", _
                                          wbemFlagReturnImmediately + wbemFlagForwardOnly)

   For Each objItem In colItems
      WScript.Echo "Availability: " & objItem.Availability
      WScript.Echo "Caption: " & objItem.Caption
      WScript.Echo "ClassGuid: " & objItem.ClassGuid
      WScript.Echo "ConfigManagerErrorCode: " & objItem.ConfigManagerErrorCode
      WScript.Echo "ConfigManagerUserConfig: " & objItem.ConfigManagerUserConfig
      WScript.Echo "CreationClassName: " & objItem.CreationClassName
      WScript.Echo "Description: " & objItem.Description
      WScript.Echo "DeviceID: " & objItem.DeviceID
      WScript.Echo "ErrorCleared: " & objItem.ErrorCleared
      WScript.Echo "ErrorDescription: " & objItem.ErrorDescription
      WScript.Echo "InstallDate: " & WMIDateStringToDate(objItem.InstallDate)
      WScript.Echo "LastErrorCode: " & objItem.LastErrorCode
      WScript.Echo "Manufacturer: " & objItem.Manufacturer
      WScript.Echo "Name: " & objItem.Name
      WScript.Echo "PNPDeviceID: " & objItem.PNPDeviceID
      strPowerManagementCapabilities = Join(objItem.PowerManagementCapabilities, ",")
         WScript.Echo "PowerManagementCapabilities: " & strPowerManagementCapabilities
      WScript.Echo "PowerManagementSupported: " & objItem.PowerManagementSupported
      WScript.Echo "Service: " & objItem.Service
      WScript.Echo "Status: " & objItem.Status
      WScript.Echo "StatusInfo: " & objItem.StatusInfo
      WScript.Echo "SystemCreationClassName: " & objItem.SystemCreationClassName
      WScript.Echo "SystemName: " & objItem.SystemName
      WScript.Echo
   Next
Next


Function WMIDateStringToDate(dtmDate)
WScript.Echo dtm: 
	WMIDateStringToDate = CDate(Mid(dtmDate, 5, 2) & "/" & _
	Mid(dtmDate, 7, 2) & "/" & Left(dtmDate, 4) _
	& " " & Mid (dtmDate, 9, 2) & ":" & Mid(dtmDate, 11, 2) & ":" & Mid(dtmDate,13, 2))
End Function
Wie würde eine Umsetzung in PB aussehen???

DANKE für jede Hilfe!!!
Nach oben
Benutzeravatar
125
Beiträge: 1322
Registriert: 19.09.2004 16:52
Wohnort: Neu Wulmstorf (Hamburg)
Kontaktdaten:
Kontaktdaten von 125

Beitrag von 125 »

MSScriptControl

1.4

24.01.2004

FloHimself

23 KB

Befehle zur Einbindung des MS ScriptControl (wahlweise VBScript und JScript), ermöglicht die Verwendung von Visual Basic for Applications (VBA) in PureBasic.
Guck ma auf der Pure-Area :)
Bild
BildDas ist Tux. Kopiere Tux in deine Signatur und hilf ihm so auf seinem Weg zur Weltherrschaft.
Nach oben
Benutzeravatar
Kiffi
Beiträge: 10715
Registriert: 08.09.2004 08:21
Wohnort: Amphibios 9

Beitrag von Kiffi »

125 hat geschrieben:
Befehle zur Einbindung des MS ScriptControl (wahlweise VBScript und
JScript), ermöglicht die Verwendung von Visual Basic for Applications (VBA)
in PureBasic.
Guck ma auf der Pure-Area :)
der OP fragte nach einer Lösung ohne VBS.

Grüße ... Kiffi
Nach oben
Benutzeravatar
DataMiner
Beiträge: 220
Registriert: 10.10.2004 18:56

Beitrag von DataMiner »

GENAU!
Ohne VBS, denn das habe ich schon (siehe Beitrag von "Bingo" http://robsite.de/php/pureboard-archiv/ ... php?t=5024 ) ausprobiert. Leider bin ich dabei auf das Problem gestossen - Wscript läuft nicht immer sauber und, je nach Version, gibts auch noch andere Rückgaben. Nicht schön ...

Edit: Das MSScript-Teil auf PureArea kannste mit der neuen PB-Version nicht mehr benutzen.

Edit2: Link korrigiert.
(kann mir mal einer sagen, warum der link mal funzt und dann wieder nich???)
Zuletzt geändert von DataMiner am 19.03.2005 13:50, insgesamt 3-mal geändert.
Nach oben
Benutzeravatar
bingo
Beiträge: 118
Registriert: 16.09.2004 18:33
Wohnort: thüringen
Kontaktdaten:
Kontaktdaten von bingo

Beitrag von bingo »

hier mal ein muster , um per wmi die pnp's (PNPDeviceID) zu ermitteln ...

Code: Alles auswählen

#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
#WBEM_S_NO_ERROR = 0

Structure d
  l.l
  h.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

Procedure.s unicode2ansi(mem)
  ansi.s=""
  Repeat
    a=PeekW(mem)
    ansi=ansi+Chr(a)
    mem+2
  Until a=0
  ProcedureReturn ansi
EndProcedure

CoInitializeEx_(0,#COINIT_MULTITHREAD)
hres=CoInitializeSecurity_(0, -1,0,0,#RPC_C_AUTHN_LEVEL_CONNECT,#RPC_C_IMP_LEVEL_IDENTIFY,0,#EOAC_NONE,0)
hres=CoCreateInstance_(?CLSID_WbemLocator,0,#CLSCTX_INPROC_SERVER,?IID_IWbemLocator,@loc.IWbemLocator)
hres=loc\ConnectServer(ansi2bstr("root\cimv2"),0,0,0,0,0,0,@svc.IWbemServices)
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)
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)
pUnk\release()
hres=CoCreateInstance_(?CLSID_WbemRefresher,0,#CLSCTX_INPROC_SERVER,?IID_IWbemRefresher,@pRefresher.IWbemRefresher)
hres=pRefresher\queryinterface(?IID_IWbemConfigureRefresher,@pConfig.IWbemConfigureRefresher)
hres=pConfig\AddEnum(svc,ansi2bstr("Win32_PnPEntity"),0,0,@penum.IWbemHiPerfEnum,@id)
pConfig\release()
Dim tab.IWbemObjectAccess(300)
For x=1 To 2
pRefresher\refresh(0)
hres=penum\GetObjects(0,100*SizeOf(IWbemObjectAccess),@tab(),@retour.l)
If x=1
  hres=tab(0)\GetPropertyHandle(ansi2bstr("PNPDeviceID"),0,@pnp)
EndIf
If x>1

*MemoryID = AllocateMemory(500)

For i=0 To retour-1
  tab(i)\Readpropertyvalue(pnp,500,@len,*MemoryID)
  Debug unicode2ansi(*MemoryID)
  ;ZeroMemory_(*MemoryID,500)
  tab(i)\release()
Next i

FreeMemory(*MemoryID)

EndIf
Delay(500)
Next
penum\release()
pRefresher\release();
svc\release()
loc\release()
CoUninitialize_()
End

DataSection

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
IID_IWbemRefresher:
;49353c99-516b-11d1-aea6-00c04fb68820
Data.l $49353C99
Data.w $516B, $11D1
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20
CLSID_WbemRefresher:
;c71566f2-561E-11D1-AD87-00C04FD8FDFF
Data.l $C71566F2
Data.w $561E, $11D1
Data.b $AD,$87,$00,$C0,$4F,$D8,$FD,$FF
IID_IWbemConfigureRefresher:
;49353c92-516b-11d1-aea6-00c04fb68820
Data.l $49353C92
Data.w $516B, $11D1
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20
IID_IWbemObjectAccess:
;49353c9a-516b-11d1-aea6-00c04fb68820
Data.l $49353C9A
Data.w $516B, $11D1
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20

EndDataSection


das wmi-grundgerüst stammt aus dem franz. pb-forum , habe das mal bissl angepasst .
wmi muss nicht immer sein . gerade die pnp's bekommt man per api schneller . manche dinge lassen sich aber per wmi besser abfragen !

das thema kann gern "aufgewertet" werden :wink:
1:0>1
Nach oben
Benutzeravatar
DataMiner
Beiträge: 220
Registriert: 10.10.2004 18:56

Beitrag von DataMiner »

Also, ich muß schon sagen - ich LIEBE dieses Forum!

DANKE Bingo!

Das Problem mit mir und API ist, ich kapiere einfach nicht, wie das in PB umgesetzt werden kann. Gibt´s da nicht ein Tut für Doofe?

Kannst du mir vielleicht noch sagen wie ich den Code "verbiegen" muss, um andere Win32_XXXXXX - Klassen auszuwerten?

Aber, bis hierhin, ein riesen DANKE!

Edit: habs jetzt mal ausprobiert. Ist schonmal ein Anfang...
Trotzdem brauche ich mal jemanden, der mir den Code näher erklärt ...

Edit2: AAAH, jetzt!

Die Zeilen

Code: Alles auswählen

hres=pConfig\AddEnum(svc,ansi2bstr("Win32_PnPEntity"),0,0,@penum.IWbemHiPerfEnum,@id)
und

Code: Alles auswählen

hres=tab(0)\GetPropertyHandle(ansi2bstr("PNPDeviceID"),0,@pnp)
sinds...

DANKE
Nach oben
Benutzeravatar
DataMiner
Beiträge: 220
Registriert: 10.10.2004 18:56

Beitrag von DataMiner »

Habe jetzt den Code für meine Bedürfnisse angepasst.

Vorteil des Codes: funzt auch da, wo er vorher wegen fehlerhafter wscript-Inst. abgeschmiert ist.

:allright:

Edit: setze mal delay auf 1, funzt und der Code ist nicht so schneckenlahm...
Nach oben
Benutzeravatar
DataMiner
Beiträge: 220
Registriert: 10.10.2004 18:56

Beitrag von DataMiner »

Tja, zu früh gefreut - HILFE!!!

Irgendwie sind die Ergebnisse nicht so *ganz* identisch, wie mit VBS ermittelt. Ein riesen Problem: es werden keine Zahlenwerte übergben. Warum?
Hier mal meinen (gekürzten) Code:

Code: Alles auswählen

;- Window Constants
;
Enumeration
  #Window_0
EndEnumeration

;- Gadget Constants
;
Enumeration
  #ListIcon_0
EndEnumeration


Procedure Open_Window_0()
  If OpenWindow(#Window_0, 150, 74, 800, 600,  #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered , "Ausgabe")
    If CreateGadgetList(WindowID())
      
      ;-
      ListIconGadget(#ListIcon_0, 0, 0, 800, 600, "Column1", 100)
      AddGadgetColumn(#ListIcon_0, 2, "Column2", 100)
      AddGadgetColumn(#ListIcon_0, 3, "Column3", 100)
      AddGadgetColumn(#ListIcon_0, 4, "Column4", 100)
      AddGadgetColumn(#ListIcon_0, 5, "Column5", 100)
      AddGadgetColumn(#ListIcon_0, 6, "Column6", 100)
      AddGadgetColumn(#ListIcon_0, 7, "Column7", 100)
      AddGadgetColumn(#ListIcon_0, 8, "Column8", 100)
      AddGadgetColumn(#ListIcon_0, 9, "Column9", 100)
      AddGadgetColumn(#ListIcon_0, 10, "Column10", 100)
      AddGadgetColumn(#ListIcon_0, 11, "Column11", 100)
      AddGadgetColumn(#ListIcon_0, 12, "Column12", 100)
      AddGadgetColumn(#ListIcon_0, 13, "Column13", 100)
      AddGadgetColumn(#ListIcon_0, 14, "Column14", 100)
      AddGadgetColumn(#ListIcon_0, 15, "Column15", 100)
      
    EndIf
  EndIf
EndProcedure

;- KONSTANTEN  STRUKTUREN 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
#WBEM_S_NO_ERROR = 0

Structure d
  l.l
  h.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

Procedure.s unicode2ansi(mem)
  ansi.s=""
  Repeat
    a=PeekW(mem)
    ansi=ansi+Chr(a)
    mem+2
  Until a=0
  ProcedureReturn ansi
EndProcedure

;- MAIN
Open_Window_0()
Dim item$(0)
Dim text$(0)
Enum$=""
Restore video
Read count
Dim item$(count)
For j=1 To count: Read item$(j): Next
Enum$=item$(1)
Gosub wmicall
For i=0 To retour-1: AddGadgetItem (#ListIcon_0, -1, text$(i)): Next
Repeat
  Event = WaitWindowEvent()
Until Event = #PB_EventCloseWindow
End

;- WMI-Call
wmicall:
dm=0
CoInitializeEx_(0,#COINIT_MULTITHREAD)
hres=CoInitializeSecurity_(0, -1,0,0,#RPC_C_AUTHN_LEVEL_CONNECT,#RPC_C_IMP_LEVEL_IDENTIFY,0,#EOAC_NONE,0)
hres=CoCreateInstance_(?CLSID_WbemLocator,0,#CLSCTX_INPROC_SERVER,?IID_IWbemLocator,@loc.IWbemLocator)
hres=loc\ConnectServer(ansi2bstr("root\cimv2"),0,0,0,0,0,0,@svc.IWbemServices)
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)
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)
pUnk\release()
hres=CoCreateInstance_(?CLSID_WbemRefresher,0,#CLSCTX_INPROC_SERVER,?IID_IWbemRefresher,@pRefresher.IWbemRefresher)
hres=pRefresher\QueryInterface(?IID_IWbemConfigureRefresher,@pConfig.IWbemConfigureRefresher)
hres=pConfig\AddEnum(svc,ansi2bstr(Enum$),0,0,@penum.IWbemHiPerfEnum,@id)
pConfig\release()
Dim tab.IWbemObjectAccess(300)

For k=2 To count
  For x=1 To 2
    pRefresher\refresh(0)
    hres=penum\GetObjects(0,100*SizeOf(IWbemObjectAccess),@tab(),@retour.l)
    If dm=0: Dim text$(retour): dm=1: EndIf
    If x=1
      hres=tab(0)\GetPropertyHandle(ansi2bstr(item$(k)),0,@pnp)
    EndIf
    If x>1
      *MemoryID = AllocateMemory(5000)
      For i=0 To retour-1
        tab(i)\Readpropertyvalue(pnp,500,@len,*MemoryID)
        text$(i) +  unicode2ansi(*MemoryID) + Chr(10)
        tab(i)\release()
      Next i
      FreeMemory(*MemoryID)
    EndIf
    
    Delay(10)
  Next
Next
penum\release()
pRefresher\release();
svc\release()
loc\release()
CoUninitialize_()
Return


;- DATA
DataSection

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
IID_IWbemRefresher:
    ;49353c99-516b-11d1-aea6-00c04fb68820
Data.l $49353C99
Data.w $516B, $11D1
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20
CLSID_WbemRefresher:
    ;c71566f2-561E-11D1-AD87-00C04FD8FDFF
Data.l $C71566F2
Data.w $561E, $11D1
Data.b $AD,$87,$00,$C0,$4F,$D8,$FD,$FF
IID_IWbemConfigureRefresher:
    ;49353c92-516b-11d1-aea6-00c04fb68820
Data.l $49353C92
Data.w $516B, $11D1
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20
IID_IWbemObjectAccess:
    ;49353c9a-516b-11d1-aea6-00c04fb68820
Data.l $49353C9A
Data.w $516B, $11D1
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20

video:
Data.l 12
Data.s "Win32_VideoController", "Caption", "AdapterDACType", "VideoProcessor", "AdapterRAM", "VideoModeDescription", "CurrentBitsPerPixel", "CurrentRefreshRate", "DriverVersion", "InfFilename", "InfSection", "InstalledDisplayDrivers"

EndDataSection
Warum wird kein "AdapterRAM", "CurrentBitsPerPixel", "CurrentRefreshRate" wie beim VBS-Bruder ausgegeben???
:? :? :?
Nach oben
Benutzeravatar
bingo
Beiträge: 118
Registriert: 16.09.2004 18:33
Wohnort: thüringen
Kontaktdaten:
Kontaktdaten von bingo

Beitrag von bingo »

beachte den unterschied zwischen Readpropertyvalue und ReadDWORD , um wmi-werte zu übergeben ...

http://msdn.microsoft.com/library/defau ... access.asp

Code: Alles auswählen

#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 
#WBEM_S_NO_ERROR = 0 

Structure d 
  l.l 
  h.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 

Procedure.s unicode2ansi(mem) 
  ansi.s="" 
  Repeat 
    a=PeekW(mem) 
    ansi=ansi+Chr(a) 
    mem+2 
  Until a=0 
  ProcedureReturn ansi 
EndProcedure 

CoInitializeEx_(0,#COINIT_MULTITHREAD) 
hres=CoInitializeSecurity_(0, -1,0,0,#RPC_C_AUTHN_LEVEL_CONNECT,#RPC_C_IMP_LEVEL_IDENTIFY,0,#EOAC_NONE,0) 
hres=CoCreateInstance_(?CLSID_WbemLocator,0,#CLSCTX_INPROC_SERVER,?IID_IWbemLocator,@loc.IWbemLocator) 
hres=loc\ConnectServer(ansi2bstr("root\cimv2"),0,0,0,0,0,0,@svc.IWbemServices) 
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) 
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) 
pUnk\release() 
hres=CoCreateInstance_(?CLSID_WbemRefresher,0,#CLSCTX_INPROC_SERVER,?IID_IWbemRefresher,@pRefresher.IWbemRefresher) 
hres=pRefresher\queryinterface(?IID_IWbemConfigureRefresher,@pConfig.IWbemConfigureRefresher) 
hres=pConfig\AddEnum(svc,ansi2bstr("Win32_VideoController"),0,0,@penum.IWbemHiPerfEnum,@id) 
pConfig\release() 
Dim tab.IWbemObjectAccess(300) 
For x=1 To 2 
pRefresher\refresh(0) 
hres=penum\GetObjects(0,100*SizeOf(IWbemObjectAccess),@tab(),@retour.l) 
If x=1 
  hres=tab(0)\GetPropertyHandle(ansi2bstr("Caption"),0,@caption) 
  hres=tab(0)\GetPropertyHandle(ansi2bstr("AdapterDACType"),0,@AdapterDACType) 
  hres=tab(0)\GetPropertyHandle(ansi2bstr("VideoProcessor"),0,@VideoProcessor) 
  hres=tab(0)\GetPropertyHandle(ansi2bstr("CurrentRefreshRate"),0,@CurrentRefreshRate) 
EndIf 
If x>1 

*MemoryID = AllocateMemory(500) 

For i=0 To retour-1 
  tab(i)\Readpropertyvalue(caption,500,@len,*MemoryID) 
  Debug unicode2ansi(*MemoryID) 
  tab(i)\Readpropertyvalue(AdapterDACType,500,@len,*MemoryID) 
  Debug unicode2ansi(*MemoryID) 
  tab(i)\Readpropertyvalue(VideoProcessor,500,@len,*MemoryID) 
  Debug unicode2ansi(*MemoryID) 
  tab(0)\ReadDWORD(CurrentRefreshRate,@rr)
  Debug rr
  tab(i)\release() 
Next i 

FreeMemory(*MemoryID) 

EndIf 
Delay(100) 
Next 
penum\release() 
pRefresher\release(); 
svc\release() 
loc\release() 
CoUninitialize_() 
End 

DataSection 

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 
IID_IWbemRefresher: 
;49353c99-516b-11d1-aea6-00c04fb68820 
Data.l $49353C99 
Data.w $516B, $11D1 
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20 
CLSID_WbemRefresher: 
;c71566f2-561E-11D1-AD87-00C04FD8FDFF 
Data.l $C71566F2 
Data.w $561E, $11D1 
Data.b $AD,$87,$00,$C0,$4F,$D8,$FD,$FF 
IID_IWbemConfigureRefresher: 
;49353c92-516b-11d1-aea6-00c04fb68820 
Data.l $49353C92 
Data.w $516B, $11D1 
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20 
IID_IWbemObjectAccess: 
;49353c9a-516b-11d1-aea6-00c04fb68820 
Data.l $49353C9A 
Data.w $516B, $11D1 
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20 

EndDataSection
1:0>1
Nach oben
Benutzeravatar
DataMiner
Beiträge: 220
Registriert: 10.10.2004 18:56

Beitrag von DataMiner »

Danke, Danke, Danke, Danke, Danke, ..., :mrgreen:

Das kommt davon, wenn man fremden Code nur benutzt, ohne ihn ganz zu verstehen... :oops:
Nach oben
Antworten

Zurück zu „Windows“