Click here to Skip to main content
11,923,517 members (73,071 online)
Click here to Skip to main content
Add your own
alternative version


13 bookmarked

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

, 5 Feb 2008 CPOL
Rate this:
Please Sign up or sign in to vote.
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)


About the Author

Ludvik Jerabek
Software Developer
United States United States
No Biography provided

You may also be interested in...

Comments and Discussions

-- There are no messages in this forum --
| Advertise | Privacy | Terms of Use | Mobile
Web04 | 2.8.151125.3 | Last Updated 5 Feb 2008
Article Copyright 2007 by Ludvik Jerabek
Everything else Copyright © CodeProject, 1999-2015
Layout: fixed | fluid