Option Explicit
 
' Benötigte API-Deklaration
Private Declare Function IsDestinationReachable Lib _
  "Sensapi.dll" Alias "IsDestinationReachableA" _
  (ByVal lpszDestination As String, _
  lpQOCInfo As QOCINFO) As Long
 
Private Type QOCINFO
  dwSize As Long
  dwFlags As Long
  dwInSpeed As Long
  dwOutSpeed As Long
End Type
 
 
' Server anpingen und Reaktionszeit zurückgeben
Public Function Ping(ByVal sHost As String) As Single
  Dim QI As QOCINFO
  Dim vTime As Single
 
  QI.dwSize = Len(QI)
  vTime = Timer
  If IsDestinationReachable(sHost, QI) = 1 Then
    Ping = Timer - vTime
  Else
    Ping = -1
  End If
  Ping = Round(Ping, 3) * 1000 ' in ms
End Function

------------------------------------------------

man lernt nie aus...