Click here to Skip to main content
65,938 articles
CodeProject is changing. Read more.
Articles
(untagged)

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

0.00/5 (No votes)
5 Feb 2008 1  
Uses a custom ping function that will work in XP and 2000. Always pick the servers with the best response time.

Introduction

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
Next 

' 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) 
 Do
     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+" & _ 
                           "([0-9]+)ms.*Average\s+=\s+([0-9]+)ms"
 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 )
     WScript.Echo("")
    End If 
    i = UBound(outLivingSorted) + 1  
    ReDim Preserve outLivingSorted(i)
    outLivingSorted(i) = Array(s,av)
    ServersByPingTime = True ' Success there are servers alive... 
   Else 
    If bVerbose Then 
     WScript.Echo(" [Failed]")
     WScript.Echo("")
    End if
   End If 
  Next
  'Sort...
  For i = UBound(outLivingSorted) - 1 To 0 Step -1
    For j = 0 To i
      If outLivingSorted(j)(1) > outLivingSorted(j+1)(1) Then
         temp=outLivingSorted(j+1)
         outLivingSorted(j+1)=outLivingSorted(j)
         outLivingSorted(j)=temp
      End If
    Next
  Next 
  '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)
  Next
  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: 
LOCALHOST
YAHOO.COM
GOOGLE.COM

History

  • 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.

License

This article has no explicit license attached to it but may contain usage terms in the article text or the download files themselves. If in doubt please contact the author via the discussion board below.

A list of licenses authors might use can be found here