Click here to Skip to main content
15,793,277 members
Articles / Programming Languages / VBScript

Using VBScript to sort servers by best response time - Uses custom ping function for XP and 2000

Rate me:
Please Sign up or sign in to vote.
4.00/5 (4 votes)
5 Feb 2008CPOL 32.5K   220   14  
Uses a custom ping function that will work in XP and 2000. Always pick the servers with the best response time.


Working on a script a while back, there was a need to sort a list of servers by the average response time. Being able to sort servers by their response times gives you the ability to ensure you are connecting to the best server based on your location and avoid servers that are down. Within the script, there are two functions: a custom ping function designed to work with XP and 2000, and the ServersByPingTime function which takes a list of servers and returns an array based on the best average response time. Below, you will find the script and the sample output. You can also download the sample by clicking the link at the top of the page.

The Code

Dim arr : arr = Array( "GOOGLE.COM" , "YAHOO.COM" , _
                       "CAT" , "LOCALHOST")
Dim out
Call ServersByPingTime( arr , out , True )
Dim s
WScript.Echo "In order fastest to slowest: "
For Each S in out
 WScript.Echo s

' Ping function will work on Windows 2000 and Windows XP
' without using the Win32_PingStatus
Function Ping(strHost , ByRef bytesSent , ByRef bytesReceived , _
         ByRef bytesLost , ByRef minMs , ByRef maxMs , ByRef aveMs )
 Ping = False
 Dim objShell, objExec, strPingResults, bRet
 Set objShell = CreateObject("WScript.Shell")
 Set objExec = objShell.Exec("ping -n 1 " & strHost) 
     WScript.Sleep 100
 Loop Until objExec.Status <> 0
 strPingResults = objExec.StdOut.ReadAll
 Dim regexpingstats : Set regexpingstats = new regexp
  regexpingstats.Pattern = "Packets:\s+Sent\s+=\s+([0-9]+).*Received" & _ 
                           "\s+=\s+([0-9]+).*Lost\s+=\s+([0-9]+)(?:.*\s)+" & _ 
                           "Minimum\s+=\s+([0-9]+)ms.*Maximum\s+=\s+" & _ 
 regexpingstats.Global = True
 regexpingstats.IgnoreCase = True
 regexpingstats.MultiLine = True
 If regexpingstats.Test(strPingResults) Then
  Dim m : Set m = regexpingstats.Execute(strPingResults)
  bytesSent = CInt(m.Item(0).subMatches.Item(0))
  bytesReceived = CInt(m.Item(0).subMatches.Item(1))
  bytesLost = CInt(m.Item(0).subMatches.Item(2))
  minMs = CInt(m.Item(0).subMatches.Item(3))
  maxMs = CInt(m.Item(0).subMatches.Item(4))
  aveMs = CInt(m.Item(0).subMatches.Item(5))
  Ping = Eval( bytesSent > bytesLost )
 End If
End Function

'Returns false if no server were found alive
'outSortedByMs - array sorted fastest response to slowest response time
Public Function ServersByPingTime( ByVal inSeverList , _
                ByRef outSortedByMs , bVerbose )
  On Error Resume Next
  ServersByPingTime = False
  outLivingSorted = Array
  Dim s, i , j , temp
  If bVerbose Then
    WScript.Echo("[Performing Connectivity Test of Defined Servers]")
  For Each s In inSeverList 
   If bVerbose Then wscript.StdOut.Write("        Server: " & s )
   Dim bs, br, bl, mi , ma , av
   If Ping( s , bs, br, bl, mi , ma , av ) Then
    If bVerbose Then
     WScript.Echo(" [Passed]")
     WScript.Echo("    Bytes Sent: " & bs )
     WScript.Echo("    Bytes Recv: " & br )
     WScript.Echo("    Bytes Lost: " & bl )
     WScript.Echo("        Min ms: " & mi )
     WScript.Echo("        Max ms: " & ma )
     WScript.Echo("    Average ms: " & av )
    End If 
    i = UBound(outLivingSorted) + 1  
    ReDim Preserve outLivingSorted(i)
    outLivingSorted(i) = Array(s,av)
    ServersByPingTime = True ' Success there are servers alive... 
    If bVerbose Then 
     WScript.Echo(" [Failed]")
    End if
   End If 
  For i = UBound(outLivingSorted) - 1 To 0 Step -1
    For j = 0 To i
      If outLivingSorted(j)(1) > outLivingSorted(j+1)(1) Then
      End If
  'Temp array to store the new pinged and sorted by reponse time...
  Dim temparray
  ReDim temparray(UBound(outLivingSorted))
  For i = 0 To UBound(outLivingSorted) 
    temparray(i) = outLivingSorted(i)(0)
  outSortedByMs = temparray
End Function

Sample Output - Verbose

[Performing Connectivity Test of Defined Servers]
Server: GOOGLE.COM [Passed]
Bytes Sent: 4
Bytes Recv: 3
Bytes Lost: 1
Min ms: 28
Max ms: 31
Average ms: 30
Server: YAHOO.COM [Passed]
Bytes Sent: 4
Bytes Recv: 4
Bytes Lost: 0
Min ms: 15
Max ms: 19
Average ms: 16
Server: CAT [Failed]
Server: LOCALHOST [Passed]
Bytes Sent: 4
Bytes Recv: 4
Bytes Lost: 0
Min ms: 0
Max ms: 0
Average ms: 0
In order fastest to slowest: 


  • 12/20/2007 - Now uses two dimensional array instead of a class with two public members.
  • 02/05/2008 - Bug fixed - Windows 2000 ping was not working, return code was 0 regardless.


This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Written By
Software Developer
United States United States
This member has not yet provided a Biography. Assume it's interesting and varied, and probably something to do with programming.

Comments and Discussions

-- There are no messages in this forum --