RPC Server nicht verfügbar

[msickel]

Hallo,

Ich habe diesen Code gefunden (ich glaube sogar hier )
Er soll den Status der Netzwerkkarten auslesen.

Delphi-Quellcode:

unit main;

interface

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

type

  TNetworkCard = class(TObject)
  private
    FKey: string;
    FStatus: Integer;
    FIPAddresses: TStrings;
    function GetStatusAsText:string;
  public
    constructor Create;
    destructor Destroy;override;
    property Key: string read FKey write FKey;
    property Status: Integer read FStatus write FStatus;
    property StatusAsText: string read GetStatusAsText;
    property IPAddresses: TStrings read FIPAddresses;
  end;

  TNetworkCards = class(TObject)
  private
    FItems: TObjectList;
    function GetItems(Index: Integer):TNetworkCard;
    function GetCount:Integer;
  public
    constructor Create;
    destructor Destroy;override;
    procedure Add(AItem: TNetworkCard);
    procedure Clear;
    procedure SetIPAddresses(const AKey: string;AAddresses: TStrings);
    property Items[Index: Integer]:TNetworkCard read GetItems;default;
    property Count: Integer read GetCount;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    Memo3: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    procedure GetNetworkStatus(ACards: TNetworkCards);
    procedure GetNetworkAddress(ACards: TNetworkCards);
  public
    FNetworkCards: TNetworkCards;
    FLocator: OleVariant;
    FRoot: OleVariant;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses ActiveX, ComObj;

procedure TForm1.Button1Click(Sender: TObject);
var cnt: Integer;
begin
  Memo1.Clear;
  Memo2.Clear;
  Memo3.Clear;
  FNetworkCards.Clear;
  FLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FRoot := FLocator.ConnectServer('.', 'root\cimv2');
  try
    GetNetworkStatus(FNetworkCards);
    GetNetworkAddress(FNetworkCards);
    for cnt := 0 to FNetworkCards.Count - 1 do
      with FNetworkCards[cnt] do begin
        Memo1.Lines.Add(StatusAsText);
        Memo2.Lines.Add(IPAddresses.CommaText);
        Memo3.Lines.Add(Format('%s <-> %s <-> %s', [Key, StatusAsText, IPAddresses.CommaText]));
      end;
  finally
    FRoot := NULL;
    FLocator := NULL;
  end;
end;

procedure TForm1.GetNetworkAddress(ACards: TNetworkCards);
var
 instances: OleVariant;
 item: OleVariant;
 ipadd: OleVariant;
 enum: IEnumVariant;
 ret: Cardinal;
 tmp: TStringList;
 cnt: Integer;
begin
  tmp := TStringList.Create;
  instances := FRoot.InstancesOf('Win32_NetworkAdapterConfiguration');
  try
    enum := IEnumVariant(IUnknown(instances._NewEnum));
    while enum.Next(1, item, ret) = S_OK do begin
      ipadd := item.IPAddress;
      if VarIsArray(ipadd) then
        for cnt := VarArrayLowBound(ipadd,1) to VarArrayHighBound(ipadd,1) do
          tmp.Add(VarToStr(ipadd[cnt]));
      ACards.SetIPAddresses(VarToStr(item.Caption), tmp);
      item := NULL;
    end;
  finally
    enum := nil;
    instances := NULL;
    tmp.Free;
  end;
end;

procedure TForm1.GetNetworkStatus(ACards: TNetworkCards);
var
 instances: OleVariant;
 item: OleVariant;
 enum: IEnumVariant;
 ret: Cardinal;
 nIt: TNetworkCard;
begin
  instances := FRoot.InstancesOf('Win32_NetworkAdapter');
  try
    enum := IEnumVariant(IUnknown(instances._NewEnum));
    while enum.Next(1, item, ret) = S_OK do begin
      nIt := TNetworkCard.Create;
      nIt.Key := VarToStr(item.Caption);
      nIt.Status := StrToIntDef(VarToStr(item.NetConnectionStatus), -1);
      ACards.Add(nIt);
      item := NULL;
    end;
  finally
    enum := nil;
    instances := NULL;
  end;
end;

{ TNetworkCard }

constructor TNetworkCard.Create;
begin
  inherited Create;
  FIPAddresses := TStringList.Create;
end;

destructor TNetworkCard.Destroy;
begin
  FreeAndNil(FIPAddresses);
  inherited Destroy;
end;

function TNetworkCard.GetStatusAsText: string;
begin
  case FStatus of
    0:  Result := 'Disconnected';
    1:  Result := 'Connecting';
    2:  Result := 'Connected';
    3:  Result := 'Disconnecting';
    4:  Result := 'Hardware not present';
    5:  Result := 'Hardware disabled';
    6:  Result := 'Hardware malfunction';
    7:  Result := 'Media disconnected';
    8:  Result := 'Authenticating';
    9:  Result := 'Authentication succeeded';
    10: Result := 'Authentication failed';
  else
    Result := 'unknown'
  end;
end;

{ TNetworkCards }

constructor TNetworkCards.Create;
begin
  inherited Create;
  FItems := TObjectList.Create;
end;

destructor TNetworkCards.Destroy;
begin
  FreeAndNil(FItems);
  inherited Destroy;
end;

procedure TNetworkCards.Add(AItem: TNetworkCard);
begin
  FItems.Add(AItem);
end;

procedure TNetworkCards.Clear;
begin
  FItems.Clear;
end;

function TNetworkCards.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TNetworkCards.GetItems(Index: Integer): TNetworkCard;
begin
  Result := FItems[Index] as TNetworkCard;
end;

procedure TNetworkCards.SetIPAddresses(const AKey: string;AAddresses: TStrings);
var cnt: Integer;
begin
  for cnt := 0 to FItems.Count - 1 do
    if AnsiSameText(TNetworkCard(FItems[cnt]).FKey, AKey) then begin
      TNetworkCard(FItems[cnt]).IPAddresses.Assign(AAddresses);
      Break;
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FNetworkCards := TNetworkCards.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FNetworkCards);
end;

end.

Compilieren funktioniert wunderbar, jedoch wenn ich das Programm dann ausführe erhalte ich immer den Fehler "Rpc Server nicht verfügbar".

Was mache ich falsch?

Betriebssystem Windows 7 32 und 64 bit

Was muss ich tun um den Code ans laufen zu bekommen?

Gruss Martin

[himitsu]

ich hab da auch was gefunden ... ich glaube ebenfalls hier
RPC Server nicht verfügbar
und da die DP keine " mag, auch nochmal via Google
http://www.google.de/search?q=%22Rpc...lphipraxis.net

Das ist wohl kein Problem dieses Codes, sondern von Windows.

[msickel]

kann man diese Windows Problem irgendwie in den Griff bekommen?

[himitsu]

Ja, das Wie steht auch in ein/zwei dieser Threads drinnen.
z.B. müssen bestimmte Services laufen, welche oftmals deaktiviert sind.

[msickel]

Habe den Fehler gefunden,

nach Änderung dieser Codezeile hat alles perfekt funktioniert.

FRoot := FLocator.ConnectServer('.', 'root\cimv2'); in

FRoot := FLocator.ConnectServer('localhost', 'root\cimv2');