silencer1982
Goto Top

LAN -Status mit vbs überprüfung (Server - Client)

Hallo,
möchte gerne einen Script schreiben der mir anzeigt ab wann mein Server im Lan verfügbar ist.

Der Hintergrund ist , da ich meinen Server beim einschalten meines Pc´s über Wake on Lan wecke - möchte ich gerne eine Grafische Meldung ab wann er dann auch erreichbar ist ( bezw. hochgefahren ist) .

Leider bin ich noch Anfänger im bereich VBs .
Wie könnte so ein script aussehen?

Content-ID: 80248

Url: https://administrator.de/contentid/80248

Ausgedruckt am: 08.11.2024 um 19:11 Uhr

Tunerus
Tunerus 08.02.2008 um 13:06:06 Uhr
Goto Top
Ich hab leider gerade meine Unterlagen nicht hier aber vorab schon mal ein kleiner tipp:

Nimm ein Shellobjekt mit dem Du einen Ping absendest an den Server. Die Ping.exe liefert einen Rückgabewert zurück welchen Du prüfst ob er einen bestimmten Status hat. Wenn dieser stimmt eine Messagebox erscheinen lassen ansonsten die Überprüfung nochmal laufen lassen.

Heute Abend kann ich Beispielcode liefern.
SvenGuenter
SvenGuenter 08.02.2008 um 17:52:00 Uhr
Goto Top
Hi hier eine mögliche Lösung

Option Explicit



Private Type WSAdata
   wVersion As Integer
   wHighVersion As Integer
   szDescription(0 To 255) As Byte
   szSystemStatus(0 To 128) As Byte
   iMaxSockets As Integer
   iMaxUdpDg As Integer
   lpVendorInfo As Long
End Type

Private Type Hostent
   h_name As Long
   h_aliases As Long
   h_addrtype As Integer
   h_length As Integer
   h_addr_list As Long
End Type

Private Type IP_OPTION_INFORMATION
   TTL As Byte
   Tos As Byte
   Flags As Byte
   OptionsSize As Long
   OptionsData As String * 128
End Type

Private Type IP_ECHO_REPLY
   Address(0 To 3) As Byte
   Status As Long
   RoundTripTime As Long
   DataSize As Integer
   Reserved As Integer
   data As Long
   Options As IP_OPTION_INFORMATION
End Type

Private Declare Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal Hostname As String) As Long  
Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired&, lpWSAdata As WSAdata) As Long  
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long  
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)  
Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long  
Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal HANDLE As Long) As Boolean  
Private Declare Function IcmpSendEcho Lib "ICMP" (ByVal IcmpHandle As Long, ByVal DestAddress As Long, ByVal RequestData As String, ByVal RequestSize As Integer, RequestOptns As IP_OPTION_INFORMATION, ReplyBuffer As IP_ECHO_REPLY, ByVal ReplySize As Long, ByVal TimeOut As Long) As Boolean  

Private Const SOCKET_ERROR = 0

'Server ist die URL die Funktion liefert eine 1 wenn ping durchkommt und eine 0 wenn er nicht  
'erreichbar ist  
Public Function Ping(ByVal Server As String) As Long

   Dim hFile As Long, lpWSAdata As WSAdata
   Dim hHostent As Hostent, AddrList As Long
   Dim Address As Long, rIP As String
   Dim OptInfo As IP_OPTION_INFORMATION
   Dim EchoReply As IP_ECHO_REPLY
   Dim Hostname As String


   Ping = 0 'Rückgabe anfangs auf null setzen  
   If Left(Server, 7) = "http://" Then Server = Mid(Server, 8) 'http:// entfernen  

   Call WSAStartup(&H101, lpWSAdata)

   If GetHostByName(Server + String(64 - Len(Server), 0)) <> SOCKET_ERROR Then
      CopyMemory hHostent.h_name, ByVal GetHostByName(Server + String(64 - Len(Server), 0)), Len(hHostent)
      CopyMemory AddrList, ByVal hHostent.h_addr_list, 4
      CopyMemory Address, ByVal AddrList, 4
   End If

   hFile = IcmpCreateFile()
   If hFile = 0 Then Exit Function 'Bei Fehler abbrechen  

   OptInfo.TTL = 128

   'Ping senden  
   If IcmpSendEcho(hFile, Address, String(32, "A"), 32, OptInfo, EchoReply, Len(EchoReply) + 8, 2000) Then  
      rIP = CStr(EchoReply.Address(0)) + "." + CStr(EchoReply.Address(1)) + "." + CStr(EchoReply.Address(2)) + "." + CStr(EchoReply.Address(3))  
   Else
      'Fehler aufgetreten  

      Exit Function
   End If

   If EchoReply.Status = 0 Then
  
      Ping = 1
   Else
 
      Ping = 0
   End If
   
End Function
60730
60730 08.02.2008 um 17:53:30 Uhr
Goto Top
moin,

die Idee mit dem Ping "bringt" nicht wirklich viel, denn die Netzwerkkarte antwortet schon kurz nach dem Starten, zu dem Zeitpunkt muß SMB oder was auch immer, der Server "serviert" noch garnicht laufen...

Was willst Du denn überprüfen?

Wenn sowas wie Netzwerklaufwerke, dann evtl. so:

Achtung, kein VBS - nur eine .cmd /bat

:start
net use z: \\servername\c$
if exist z:\>nul goto ready
goto start
:ready
echo time/t
echo Server aktiv
net use z: /delete
pause
Tunerus
Tunerus 08.02.2008 um 17:56:30 Uhr
Goto Top
So ich hab grad mal kurz etwas zusammen gebastelt und natürlich könnte man es noch verbessern ;)

sComputername = "localhost" 'Hier den Servernamen eintragen  

Set oShell = WScript.CreateObject("WScript.Shell")  
iErgebnis = oShell.Run("ping.exe -n 1 " & sComputername, 0, true)  

Do while (iErgebnis <> 0)
	Wscript.Sleep(1000)
	iErgebnis = oShell.Run("ping.exe -n 1 " & sComputername, , true)  
Loop
	MsgBox "Computer ist online.", vbInformation, "Hinweis"  

Ich hoffe es hilft Dir!
SvenGuenter
SvenGuenter 08.02.2008 um 17:56:52 Uhr
Goto Top
Du kannst in dem Ping einen Delay einbauen damit du sicher bist das der Server wenn er denn oben ist auch erreichbar ist ;o)
bastla
bastla 09.02.2008 um 23:21:07 Uhr
Goto Top
Hallo Silencer1982!

Wenn das Script auf einem System (solltest Du beim nächsten Mal angeben) ab XP ausgeführt wird, kannst Du (nach einer hier zu findenden Vorlage) auch eine Lösung ohne den CMD-Ping-Befehl verwenden:
Server = "Servername" 'oder auch IP  

Start = Now
Do Until Ping(Server)
	WScript.Sleep 1000
Loop
Ende = Now

WScript.Echo "Script gestartet um:    " & Start & vbCrLF & _  
	"Server erreichbar um: " & Ende & vbCrLF & vbCrLF & _  
	"Dauer: " & DateDiff("s", Start, Ende) & " Sekunden"  


Function Ping(machine)
PingResult = True
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}")._  
	ExecQuery("select * from Win32_PingStatus where address = '"_  
	& machine & "'")  
For Each objStatus in objPing
	If IsNull(objStatus.StatusCode) Or objStatus.StatusCode <> 0 Then 
		PingResult = False
	End If
Next
Ping = PingResult
End Function
@SvenGuenter: Dein Code passt nicht so wirklich unter die Überschrift VBS ...

Grüße
bastla
Silencer1982
Silencer1982 11.02.2008 um 10:03:40 Uhr
Goto Top
xp- klar face-smile das habe ich vergessen.
danke nochmal face-smile
Gruß Silencer1982
60730
60730 11.02.2008 um 10:51:14 Uhr
Goto Top
Der Hintergrund ist , da ich meinen Server
beim einschalten meines Pc´s über
Wake on Lan wecke - möchte ich gerne
eine Grafische Meldung ab wann er dann auch
erreichbar ist ( bezw. hochgefahren ist) .

Moin,

eure Ideen sind ja alle nicht schlecht, aber wie ich bereits geschrieben habe (und jetzt mal ausführlicher beschreibe) - an der Situation, dass der NIC bereits kurz (bei mir 5 sec.) nach dem WOL auf Pings antwortet, und NICHT der Server ändert sich immer noch nichts ;-(

Um den "Serverstatus" selber herauszufinden, reicht also kein "Ping" - denn wie oben beschrieben, darauf antwortet bereits der NIC, während des bootens.

(WOL ist ja auch dafür gedacht, Betriebsysteme per RIS zu installieren, also "muß" nicht zwingend ein OS laufen, um die "Maschenka" anpingen zu können)

@SilenceR - nochmal die Frage, was für Dienste willst du abfragen?
Silencer1982
Silencer1982 19.02.2008 um 14:29:51 Uhr
Goto Top
Also erstmal danke an alle!!!

Im grunde genommen soll mir das Script nur sagen das der Server aufgeweckt wurde.