LANPing script for network diagnostics: VBScript version

James Wright responds to readers of an earlier blog who wanted a handy troubleshooting script (LANPing) to work with Windows Server 2008/Vista and Windows 7. Here is the VBScript version.

In the first blog I wrote for TechRepublic, I introduced you to what I call LANPing, a command in Windows Server 2003 / Windows XP that sends ping requests to the Default Gateway, DNS and WINS Servers, and the local IP. This command gives you a quick glimpse into the basic connectivity of your servers. In the responses to that blog, I promised that I would share the script I use to accomplish this in Windows Server 2008 / Windows Vista and Windows 7. Well, here is the VBScript I wrote for this.

The code is here with plenty of comments to try and explain what I am doing. I have not written a PowerShell version as yet and will deliver that version to you next.

Note: Try this text file to copy and paste from.

On Error Resume Next
' Housekeeping
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim WSHShell : Set WSHShell = wscript.CreateObject("")
Dim strLogFile
strLogFile  = "C:\LANPing.txt" ‘Customize this value to wherever you would like to save the Log File
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim strPingResponse
strPingResponse = "Variable Not Set"
Dim strComputer
strComputer = "."
'Checking to see if LANPing.txt exists and, if so, deleting it
If objFSO.FileExists(strLogFile) Then
objFSO.DeleteFile(strLogFile), TRUE
End If
'Getting the IP Information only for the adapters that are IP Enabled
Dim objWMIService : Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration Where IPEnabled = True",,48)
For Each objItem in colItems
If objFSO.FileExists(strLogFile) Then
'Opening the Log file for appending data
Set objFile = objFSO.OpenTextFile(strLogFile, ForAppending)
objFile.WriteLine "======================================================="
'Creating the Log file and opening for initial Writing
Set objFile = objFSO.CreateTextFile(strLogFile)
Set objFile = objFSO.OpenTextFile(strLogFile, ForWriting)
objFile.WriteLine "======================================================="
objFile.WriteLine "======================================================="
objfile.WriteLine "LANPing Log File " & now
objFile.WriteLine "======================================================="
objFile.WriteLine "======================================================="
End If
'Gathering information needed in the script
If Not isNull(objItem.DNSHostName) Then
'Setting variables used throughout the script - the exception is strPing which is set/reset thru the script
strHostName =  objItem.DNSHostname 'Setting the Hostname variable
strDescript = "The Description is: " & objItem.Description
strLocalIP = Join(objItem.IPAddress, ",") 'Used for pinging the local computer
strSubNet = Join(objItem.IPSubnet, ",") 'Get Subnet Information
strDefGateway = Join(objItem.DefaultIPGateway, ",") 'Used for pinging the Default Gateway
strDNSSrchOrd = Join(objItem.DNSServerSearchOrder, ",") 'Getting the DNS Search Order
strDomain = objItem.DNSDomain ' Getting Domain information
strPrimWins = objItem.WINSPrimaryServer 'Used for pinging the Primary WINS Server
strSecWins = objItem.WINSSecondaryServer 'Used if needed
'Writing the Information for the adapter currently being checked and sending Ping Requests
objFile.WriteLine "Information for: " & objItem.Description
objFile.WriteLine "Hostname: " & strHostName & "." & strDomain
objFile.WriteLine strDescript
objFile.WriteLine "IP Address: " & strLocalIP & " on Subnet: " & strSubNet
strPing = strLocalIP 'Resetting strPing
objFile.WriteLine "**************************************************"
objFile.WriteLine "Pinging Local IP Address" & "(" & strLocalIP & ")"
UpCheck(strPing) 'Calling the UpCheck function and passing current strPing value to it
objFile.WriteLine "Default Gateway: " & strDefGateway
strPing = strDefGateway 'Resetting strPing
objFile.WriteLine "***************************************************"
objFile.WriteLine "Pinging the Default Gateway" & "(" & strDefGateway & ")"
UpCheck(strPing) 'Calling the UpCheck function and passing current strPing value to it
objFile.WriteLine "DNS Search Order: " & strDNSSrchOrd
'Splitting out the DNS Search Order and capturing the first DNS Server in strPrimDNS
arrDNS = Split(strDNSSrchOrd, ",", -1, 1) ' Creating an array of the DNS Servers
For x = LBound(arrDNS) to UBound (arrDNS)
'Setting the value of strPrimDNS to the value of the first item in the Array
strPrimDNS = arrDNS(0)
'Checking the value of strPrimDNS and acting accordingly
If Not isNull(strPrimDNS) Then
strPing = strPrimDNS 'Resetting strPing
objFile.WriteLine "**************************************"
objFile.WriteLine "Pinging the first listed DNS Server" & "(" & strPrimDNS & ")"
UpCheck(strPing) 'Calling UpCheck function and passing current strPing value
objFile.WriteLine "There is not a DNS Entry available"
End If
'Checking WINS information and sending to Ping Function and/or writing to Log
objFile.WriteLine "Primary WINS Server: " & strPrimWins
If Not isNull(strPrimWins) Then
strPing = strPrimWins 'Resetting strPing
objFile.WriteLine "*********************************************"
objFile.WriteLine "Pinging the Primary WINS Server" & "(" & strPrimWINS & ")"
UpCheck(strPing) 'Calling UpCheck function and passing current strPing value
objFile.WriteLine "There is not a Primary WINS Server listed"
End If
objFile.WriteLine "Secondary WINS Server: " & strSecWins
If Not isNull(strSecWins) Then
strPing = strSecWins 'Resetting strPing
objFile.WriteLine "*********************************************"
objFile.WriteLine "Pinging the Secondary WINS Server" & "(" & strSecWINS & ")"
UpCheck(strPing) 'Calling UpCheck function and passing current strPing value
objFile.WriteLine "There is not a Secondary WINS Server listed"
End If
objFile.WriteLine "===================================================="
End If
Sub UpCheck(strPing)
Dim strPingResults
'Creating and setting pingExec and sending Ping Requests
Dim pingExec : Set pingExec = WSHShell.Exec("ping " & strPing & " -n 3 -w 3000") '3 echo requests, wait 3 secs
'Capturing Ping Reply Information
strPingResults = LCase(pingExec.StdOut.ReadAll)
'Writing Ping Results to the Log file
objFile.WriteLine strPingResults
'Un-REM line below to have the Ping Results displayed on screen as well as in the Log File
'Wscript.Echo strPingResults
End Sub
'Finishing up
'Notification that the script has completed
Wscript.Echo "Script has completed operations"
'Open Log File "notepad.exe C:\LANPing.txt"


VBScript is older than and not as polished as PowerShell, but it can still be quite useful. If this script doesn't work initially, be sure to check your system's security settings. It is my hope that this script helps you out in your troubleshooting.


James Wright is a veteran IT professional who has spent the majority of his career as a Systems Administrator. James has also served as a Systems Analyst, Helpdesk Senior Technician and as a Programmer Analyst. This range of experience has allowed hi...

Editor's Picks