WMI Einträge Überprüfen

Kurzer_18 · Verfasst: Di 21.08.07 16:52

Hallo... ich habe da mal eine frage und sicherlich kann mir der eine oder andere auch die frage beantworten...

also folgendes Problem, ich würde gerne überprüfen ob ein Eintrag in der WMI vorhanden ist oder nicht als test:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:

function WMIGetActiveInfo(const Computer, user, Password: string): TWMIACTIVEInfo;
var
  Locator      : ISWbemLocator;
  Services     : ISWbemServices;
  ObjectDefinition: ISWbemObject;
  ObjectSet    : SWbemObjectSet;
  ObjectInstances: IEnumVariant;
  WMIObject    : ISWbemObject;
  PropertySet  : ISWbemPropertySet;
  WMIProperty  : ISWbemProperty;
  TempObj      : OleVariant;
  ObjValue     : Cardinal;
begin
  Locator := CoSWbemLocator.CreateRemote(Computer);
  try
    try
      Services := Locator.ConnectServer(Computer, 'root\CIMV2', User, Password, '', '', 0, nil);
      if Services <> nil then
      begin
        ObjectDefinition := Services.Get('Win32_WindowsProductActivation', wbemFlagUseAmendedQualifiers, nil);
        ObjectSet := ObjectDefinition.Instances_(0, nil);
        ObjectInstances := (ObjectSet._NewEnum) as IEnumVariant;
        if ObjectInstances.Next(1, TempObj, ObjValue) = S_OK then
        begin
          WMIObject := IUnknown(TempObj) as SWBemObject;
          PropertySet := WMIObject.Properties_;
          WMIProperty := PropertySet.Item('ActivationRequired', 0);
          if not VarIsNull(WMIProperty.Get_Value) then
            Result.ActivationRequired := trim(WMIProperty.Get_Value);
        end;
      end;
    finally
      Locator := nil;
      Services := nil;
    end;
  except
    on e: Exception do
      e.Create(e.Message);
  end;
end;

Wie mache ich des nun wenn der eintrag z.b. nicht vorhanden ist: also des "ActivationRequired" z.b. weil bei einem test habe ich mitbekommen unter vista das es nach dem compilieren ein fehler auftaucht:

---------------------------
Benachrichtigung über Debugger-Exception
---------------------------
Im Projekt Project1.exe ist eine Exception der Klasse EOleException aufgetreten. Meldung: 'Nicht gefunden'. Prozess wurde angehalten. Mit Einzelne Anweisung oder Start fortsetzen.
---------------------------
OK Hilfe
---------------------------

wie behebe ich dies nun?

habe vieles versucht aber immer gescheitert!!!

Bitte daher um eure hilfe DANKE!

MrSaint · Verfasst: Di 21.08.07 17:08

Hallo!

msdn2.microsoft.com/...ibrary/aa393808.aspx sollte mal ein erster Ansatz sein. Da steht bei "Error codes" von einem "Err" Objekt. Ich kenn mich damit nicht aus, aber ich stell mir das jett so vor, dass es da ein Objekt gibt, in dem drin steht ob der letzte Befehl erfolgreich ausgeführt werden konnte und wenn nicht warum nicht. Prüfe also nach dem Zugriff auf PropertySet.Item('ActivationRequired', 0) dieses Err Objekt. Unten auf der Seite sind auch noch Links zu Implementierungsbeispielen, vllt findest du da auch was...

MrSaint

_________________
"people knew how to write small, efficient programs [...], a skill that has subsequently been lost"
Andrew S. Tanenbaum - Modern Operating Systems

Kurzer_18 · Verfasst: Di 21.08.07 17:35

Naja bringt mich nicht wirklich weiter.. :-(

MrSaint · Verfasst: Di 21.08.07 17:51

Wieso nicht? Wo fehlts?

_________________
"people knew how to write small, efficient programs [...], a skill that has subsequently been lost"
Andrew S. Tanenbaum - Modern Operating Systems

Ehemaliges Mitglied Erhaltene Danke: 1

Teste doch mal dieses VBS-Script, das Ergebnis steht dann in WPA.txt:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:

On Error Resume Next

Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20

Set fs = CreateObject("Scripting.FileSystemObject")
Set outFile = fs.CreateTextFile("WPA.txt", True)

arrComputers = Array(".")
For Each strComputer In arrComputers

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

   For Each objItem In colItems
      outFile.WriteLine "ActivationRequired: " & objItem.ActivationRequired & chr(13) & chr(10)
      outFile.WriteLine "Caption: " & objItem.Caption & chr(13) & chr(10)
      outFile.WriteLine "Description: " & objItem.Description & chr(13) & chr(10)
      outFile.WriteLine "IsNotificationOn: " & objItem.IsNotificationOn & chr(13) & chr(10)
      outFile.WriteLine "ProductID: " & objItem.ProductID & chr(13) & chr(10)
      outFile.WriteLine "RemainingEvaluationPeriod: " & objItem.RemainingEvaluationPeriod & chr(13) & 

chr(10)
      outFile.WriteLine "RemainingGracePeriod: " & objItem.RemainingGracePeriod & chr(13) & chr(10)
      outFile.WriteLine "ServerName: " & objItem.ServerName & chr(13) & chr(10)
      outFile.WriteLine "SettingID: " & objItem.SettingID & chr(13) & chr(10)
      outFile.WriteLine
   Next
Next
outFile.Close

Kurzer_18 · Verfasst: Di 21.08.07 18:46

@ hathor hast du eventuell auch eine Delphi Variante davon?

@ MrSaint...

naja habe es versucht mit der try methode aber nicht .... der soll ja vorher überprfen ob es existiert und wenn nicht dann nichts schrieebn udn wenn es da ist soll er den wert schrieben... aber in diesem fall schreibt er trotzdem. und nach dem copilierene ist eh sehste... also sagen wir mal so wenn ich über delphi starte gehts nicht erzeuge ich die exe und starte gehts... aber den wert schreibt er dennoch!!!

Ehemaliges Mitglied Erhaltene Danke: 1

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,
  ActiveX, WbemScripting_TLB;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  aLoc: ISWbemLocator;
  aSrv: ISWbemServices;
  aObjSet: ISWbemObjectSet;
  pEnum: IEnumVARIANT;
  vOut: OleVariant;
  dwRetrieved: LongWord;
  hRes: HResult;
  cWQL, sWQL: string;
  st: TStringList;

implementation

{$R *.dfm}

function GetWMIstring (wmiHost, wmiClass, wmiProperty : string):string;
var  // These are all needed for the WMI querying process
  Locator:  ISWbemLocator;
  Services: ISWbemServices;
  SObject:  ISWbemObject;
  ObjSet:   ISWbemObjectSet;
  SProp:    ISWbemProperty;
  Enum:     IEnumVariant;
  Value:    Cardinal;
  TempObj:  OleVariant;
  SN: string;
begin
  try
  Locator := CoSWbemLocator.Create;
   Services :=  Locator.ConnectServer(wmiHost, 'root\cimv2', '', '', '','', 0, nil);
  ObjSet := Services.ExecQuery('SELECT * FROM '+wmiClass, 'WQL',
    wbemFlagReturnImmediately and wbemFlagForwardOnly , nil);
  Enum :=  (ObjSet._NewEnum) as IEnumVariant;
  while (Enum.Next(1, TempObj, Value) = S_OK) do
  begin
    SObject := IUnknown(tempObj) as ISWBemObject;
    SProp := SObject.Properties_.Item(wmiProperty, 0);
    if VarIsNull(SProp.Get_Value) then
      result := ''
    else
    begin
      SN := SProp.Get_Value;
      result :=  SN;
    end;
  end;
  except // Trap any exceptions (Not having WMI installed will cause one!)
   on exception do
    result := '';
   end;
end;


procedure TForm1.FormActivate(Sender: TObject);
var tmpstr : string;
begin

tmpstr := getWMIstring('','Win32_WindowsProductActivation','ActivationRequired');
  if StrToInt(tmpstr) <> 0 then Label2.caption:= 'ActivationRequired = true';
  if StrToInt(tmpstr) = 0 then Label2.caption:= 'ActivationRequired = false';
tmpstr := getWMIstring('','Win32_WindowsProductActivation','Caption');
Memo1.Lines.Add(tmpstr);
tmpstr := getWMIstring('','Win32_WindowsProductActivation','ActivationRequired');
Memo1.Lines.Add(tmpstr);
tmpstr := getWMIstring('','Win32_WindowsProductActivation','Description');
Memo1.Lines.Add(tmpstr);
tmpstr := getWMIstring('','Win32_WindowsProductActivation','IsNotificationOn');
Memo1.Lines.Add(tmpstr);
tmpstr := getWMIstring('','Win32_WindowsProductActivation','ProductID');
Memo1.Lines.Add(tmpstr);
tmpstr := getWMIstring('','Win32_WindowsProductActivation','RemainingEvaluationPeriod');
Memo1.Lines.Add(tmpstr);
tmpstr := getWMIstring('','Win32_WindowsProductActivation','RemainingGracePeriod');
Memo1.Lines.Add(tmpstr);
tmpstr := getWMIstring('','Win32_WindowsProductActivation','ServerName');
Memo1.Lines.Add(tmpstr);
tmpstr := getWMIstring('','Win32_WindowsProductActivation','SettingID');
Memo1.Lines.Add(tmpstr);

end;

end.

Kurzer_18 · Verfasst: Di 21.08.07 19:13

hehe danke dir... aber das bringt mir nix das wollte ich mit absicht nicht nehmen den das habe ich schonmal getestet... da fängt der immer mit der letzten instance an... also bei z.b. grafikkarte ist es in diesem fall X1900 CrossFire Secondary... also das habe ich mal getestet...

PS. " while (Enum.Next(1, TempObj, Value) = S_OK) do " habe ich in " while (Enum.Next(2, TempObj, Value) = S_OK) do " geändert da springt er eine instance zurück.. aber wenn es nur ein z.b. gibt wie bei Produckt activation bringt er fehler und schmiert wieder beim erzeugen ab... und 0 und 3 gibt es da nicht!!!! alles schon getestet...

Weil wenn dann soll er immer die erste lesen... immer zwischendurch mal irgend eine ist nicht... das bringts ja nicht

Kurzer_18 · Verfasst: Di 21.08.07 21:57

So habe jetzt nochmal getestet und sie da:

---------------------------
Benachrichtigung über Debugger-Exception
---------------------------
Im Projekt Project1.exe ist eine Exception der Klasse EOleException aufgetreten. Meldung: 'Ungültige Klasse'. Prozess wurde angehalten. Mit Einzelne Anweisung oder Start fortsetzen.
---------------------------
OK Hilfe
---------------------------

nachdem ich erzeugt habe.. starte ich die exe alleine kommt folgender fehler:

---------------------------
Project1
---------------------------
'' ist kein gültiger Integerwert.
---------------------------
OK
---------------------------

weis jetzt nicht mehr weiter

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme