Code-Beispiel

Erreichbarkeit von Servern(LAN/WAN) prüfen(WMI)

Lizenz:	Erster Autor:	Letzte Bearbeitung:
k. A.	ytwinky	19.04.2012

Es ist keine große Aufgabe, zu prüfen, ob ein anderer Rechner erreichbar ist,
denn dafür gibt es den Ping-Befehl(Shell, Konsolenausgabe einlesen und auswerten..)
Wer es kann, wird natürlich sagen: Das geht doch alles mit TSNE!
Das mag sein, ich habe es noch nicht getestet..
Ich wollte es(egtl. immer schon) mit WMI machen, aber die einzige WMI-Funktion die dafür zuständig schien(Win32_PingStatus) 'wollte auf meinem Rechner nicht funktionieren'..
Doch als ich neulich mal wieder etwas ganz anderes gesucht habe, fand ich die Lösung in einer genauen Beschreibung der Funktion: Sie liefert nämlich nur dann Ergebnisse, wenn auch ein Ziel angegeben wird und bildet somit quasi einen Sonderfall unter den WMI-Funktionen..
..Aber wenn man das weiß, ist es kein Problem die Funktion zu benutzen:

#include once "windows.bi"               'in

#define UNICODE                          'this

#include once "disphelper/disphelper.bi" 'order

#include "vbcompat.bi"

#define green 2

#define red 4

#define light 8



Const strComputer="." 'oder "localhost" oder Environ("ComputerName")

Const impersonate="winmgmts:{impersonationLevel=impersonate}!\\" &strComputer &"\root\cimv2"

Dim As Integer Colour(2)={light+red, light+green}, d=Color

Var strServer="localhost", SelectClass=""

'Address

'BufferSize

'NoFragmentation

'PrimaryAddressResolutionStatus

'ProtocolAddress

'ProtocolAddressResolved

'RecordRoute

'ReplyInconsistency

'ReplySize

'ResolveAddressNames

'ResponseTime

'ResponseTimeToLive

'RouteRecord <Array>

'RouteRecordResolved <Array>

'SourceRoute

'SourceRouteType

'StatusCode, returns an empty string if IP|ServerName cannot be resolved via hosts-file or IP is invalid

'Timeout

'TimeStampRecord <Array>

'TimeStampRecordAddress <Array>

'TimeStampRecordAddressResolved <Array>

'TimestampRoute

'TimeToLive

'TypeofService

Dim As HRESULT hres

Dim As ZString Ptr devAddress, devBufferSize, devNoFragmentation, devPrimaryAddressResolutionStatus

Dim As ZString Ptr devProtocolAddress, devProtocolAddressResolved, devRecordRoute, devReplyInconsistency

Dim As ZString Ptr devReplySize, devResolveAddressNames, devResponseTime, devResponseTimeToLive

Dim As ZString Ptr devRouteRecord, devRouteRecordResolved, devSourceRoute, devSourceRouteType

Dim As ZString Ptr devStatusCode, devTimeout, devTimeStampRecord, devTimeStampRecordAddressResolved

Dim As ZString Ptr devTimestampRoute, devTimeToLive, devTypeofService

DISPATCH_OBJ(wmiSvc)

DISPATCH_OBJ(colPing)

dhInitialize(True)

Input "Check pingstatus of server:", strServer 'defaults internally to Environ("Computername") not "localhost"..

SelectClass=!"Select * From Win32_PingStatus Where Address=\34" &strServer &!"\34"

Print "Pinging " &strServer &".."

Print "w8 plz..";

'configure, whether errors should be displayed or not:

'dhToggleExceptions(TRUE) 'if desired remove the first ' ;-))

hres=dhGetObject(impersonate, NULL, @wmiSvc)

hres=dhGetValue("%o", @colPing, wmiSvc, ".ExecQuery(%s)", SelectClass)

FOR_EACH0(objPing, colPing, NULL)

  hres=dhGetValue("%s", @devAddress, objPing, ".Address")

    hres=dhGetValue("%s", @devBufferSize, objPing, ".BufferSize")

    hres=dhGetValue("%s", @devNoFragmentation, objPing, ".NoFragmentation")

    hres=dhGetValue("%s", @devPrimaryAddressResolutionStatus, objPing, ".PrimaryAddressResolutionStatus")

    hres=dhGetValue("%s", @devProtocolAddress, objPing, ".ProtocolAddress")

    hres=dhGetValue("%s", @devProtocolAddressResolved, objPing, ".ProtocolAddressResolved")

    hres=dhGetValue("%s", @devRecordRoute, objPing, ".RecordRoute")

    hres=dhGetValue("%s", @devReplyInconsistency, objPing, ".ReplyInconsistency")

    hres=dhGetValue("%s", @devReplySize, objPing, ".ReplySize")

    hres=dhGetValue("%s", @devResolveAddressNames, objPing, ".ResolveAddressNames")

    hres=dhGetValue("%s", @devResponseTime, objPing, ".ResponseTime")

    hres=dhGetValue("%s", @devResponseTimeToLive, objPing, ".ResponseTimeToLive")

'   hres=dhGetValue("%s", @devRouteRecord, objPing, ".RouteRecord")

'   hres=dhGetValue("%s", @devRouteRecordResolved, objPing, ".RouteRecordResolved")

    hres=dhGetValue("%s", @devSourceRoute, objPing, ".SourceRoute")

    hres=dhGetValue("%s", @devSourceRouteType, objPing, ".SourceRouteType")

    hres=dhGetValue("%s", @devStatusCode, objPing, ".StatusCode")

    hres=dhGetValue("%s", @devTimeout, objPing, ".Timeout")

'   hres=dhGetValue("%s", @devTimeStampRecord, objPing, ".TimeStampRecord")

'   hres=dhGetValue("%s", @devTimeStampRecordAddress, objPing, ".TimeStampRecordAddress")

'   hres=dhGetValue("%s", @devTimeStampRecordAddressResolved, objPing, ".TimeStampRecordAddressResolved")

    hres=dhGetValue("%s", @devTimestampRoute, objPing, ".TimestampRoute")

    hres=dhGetValue("%s", @devTimeToLive, objPing, ".TimeToLive")

    hres=dhGetValue("%s", @devTypeofService, objPing, ".TypeofService")

  Print !"\rAddress:" &*devAddress

  Print "BufferSize:" &*devBufferSize

  Print "NoFragmentation:" &*devNoFragmentation

  Print "PrimaryAddressResolutionStatus:" &*devPrimaryAddressResolutionStatus

  Print "ProtocolAddress:" &*devProtocolAddress

  Print "ProtocolAddressResolved:" &*devProtocolAddressResolved

  Print "RecordRoute:" &*devRecordRoute

  Print "ReplyInconsistency:" &*devReplyInconsistency

  Print "ReplySize:" &*devReplySize

  Print "ResolveAddressNames:" &*devResolveAddressNames

  Print "ResponseTime:" &*devResponseTime

  Print "ResponseTimeToLive:" &*devResponseTimeToLive

'  Print "RouteRecord:" &*devRouteRecord 'cannot yet recognize arrays :-((

'  Print "RouteRecordResolved:" &*devRouteRecordResolved 'cannot yet recognize arrays :-((

  Print "SourceRoute:" &*devSourceRoute

  Print "SourceRouteType:" &*devSourceRouteType

  Color Colour(Abs(*devStatusCode="0"))

  Print "StatusCode:" &*devStatusCode

  Color d

  Print "Timeout:" &*devTimeout

'  Print "devTimeStampRecord:" &*devdevTimeStampRecord 'cannot yet recognize arrays :-((

'  Print "TimeStampRecordAddress:" &*devTimeStampRecordAddress 'cannot yet recognize arrays :-((

'  Print "TimeStampRecordAddressResolved:" &*devTimeStampRecordAddressResolved 'cannot yet recognize arrays :-((

  Print "TimestampRoute:" &*devTimestampRoute

  Print "TimeToLive:" &*devTimeToLive

  Print "TypeofService:" &*devTypeofService

NEXT_(objPing)

SAFE_RELEASE(wmiSvc)

SAFE_RELEASE(colPing)

dhUninitialize(True)

Print "Eniki..";

GetKey

Dieser Code ist nur zum Ausprobieren und Erkennen, ob mehr damit möglich ist, als ich benötige..
Fakt ist, Win32_StatusCode liefert in .StatusCode "0" zurück, wenn(und nur dann) das Ziel erreichbar ist..
.Statuscode liefert auch Fehlermeldungen oder ist gar leer(z.B. wenn das zu prüfende Ziel nicht via hosts. aufgelöst werden kann).
Doch nun zum Programm: Es liefert einen Errorlevel 1, wenn das Ziel erreichbar ist und 0, wenn nicht..

#include once "windows.bi"               'in

#define UNICODE                          'this

#include once "disphelper/disphelper.bi" 'order

#include "vbcompat.bi"

Const strComputer="." 'oder "localhost" oder Environ("ComputerName")

Const impersonate="winmgmts:{impersonationLevel=impersonate}!\\" &strComputer &"\root\cimv2"

Const red=4, green=2, light=8

Dim As Integer Colour(2)={light+red, green}, d=Color, Status=0

Dim As String strServer="localhost", SelectClass=""

Dim As HRESULT hres

Dim As ZString Ptr devStatusCode, devProtocolAddress

DISPATCH_OBJ(wmiSvc)

DISPATCH_OBJ(colPing)

dhInitialize(True)

    Input "Check pingstatus of server:", strServer 'defaults internally to Environ("Computername") not localhost..

    SelectClass=!"Select StatusCode,ProtocolAddress  From Win32_PingStatus Where Address=\34" &strServer &!"\34"

    Print "Pinging " &strServer &".."

    Print "w8 plz..";

    'configure, whether errors should be displayed or not:

    'dhToggleExceptions(TRUE) 'if desired remove the first ' ;-))

    hres=dhGetObject(impersonate, NULL, @wmiSvc)

    hres=dhGetValue("%o", @colPing, wmiSvc, ".ExecQuery(%s)", SelectClass)

    FOR_EACH0(objPing, colPing, NULL)

        hres=dhGetValue("%s", @devStatusCode, objPing, ".StatusCode")

        hres=dhGetValue("%s", @devProtocolAddress, objPing, ".ProtocolAddress")

        Status=Abs(*devStatusCode="0")

      Color Colour(Status)

          Print !"\rStatusCode:" &*devStatusCode

          If *devProtocolAddress<>"" Then Print "ProtocolAddress:" &*devProtocolAddress

      Color d

    NEXT_(objPing)

SAFE_RELEASE(wmiSvc)

SAFE_RELEASE(colPing)

dhUninitialize(True)

Print "Eniki..";

GetKey

End Status

Zusätzlich ist die Ausgabe noch farbig: grün=erreichbar, rot=unerreichbar ;-))
Fröhliches Checken
Gruß
ytwinky

Zusätzliche Informationen und Funktionen

Das Code-Beispiel wurde am 19.04.2012 von ytwinky angelegt.
Die aktuellste Version wurde am 19.04.2012 von ytwinky gespeichert.

Bearbeiten

Versionen