Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

A Script to Ping a Range of IP Addresses (VBS - VBScript)

Status
Not open for further replies.

ricardo08

Technical User
May 6, 2013
2
thread329-886788

Hi everybody,

I want to publish some improvements that I've made from thread Link, for me it was VERY HELPFUL, and in gratitude to the author "nullig" I'm going to publish it here. Some improvements are:

[ul]
[li]Verify that the IP has only numbers and no letters[/li]
[li]Verify that the IP has the correct format (XXX.XXX.XXX.XXX)[/li]
[li]Verify that each octet is between 1 and 255[/li]
[li]Improvements to the code that makes ping (ping takes less time)[/li]
[li]Improvements to the code that takes hostname[/li]
[li]Improvements to the code that pass from one network segment to another[/li]
[li]Improvements to the code that verifies if Initial IP is greater than End IP[/li]
[/ul]

Here is the code:

'º MultiPing.vbs v2.0 º
'º º
'º Script to ping a range of IP Addresses and º
'º write results to an Excel Workbook º
'º º
'º Noel McGran (23/07/04) º

'User Input of IP range
Message = "Please enter start IP:"
Title = "Start Range"
StartIP = InputBox(Message, Title)
xx = StartIP
Good = ValidIP(xx)

Do While Good = "invalid"
Message = StartIP & " is not a valid IP." & _
vbCrLf & "Please re-enter start IP:"
Title = "Start Range"
StartIP = InputBox(Message, Title)
xx = StartIP
Good = ValidIP(xx)
Loop

Message = "Please enter end IP:"
Title = "End Range"
EndIP = InputBox(Message, Title)
yy = EndIP
Good = ValidIP(yy)

Do While Good = "invalid"

Message = EndIP & " is not a valid IP." & _
vbCrLf & "Please re-enter end IP:"
Title = "End Range"
EndIP = InputBox(Message, Title)
yy = EndIP
Good = ValidIP(yy)
Loop

xx = StartIP
yy = EndIP

Good = GreaterIP(xx, yy)

Do While Good = "before"

Message = EndIP & " is " & Good & " or equal to " & StartIP _
& vbCrLf & "Please re-enter End IP:"
Title = "End Range"
EndIP = InputBox(Message, Title)
xx = StartIP
yy = EndIP
Good = GreaterIP(xx, yy)
Loop

msgText = "IP range is " & StartIP & " to " & EndIP & vbCrLf & "Continue?"

Select Case MsgBox(msgText, vbOKCancel)

Case 1

tempfilename = "C:\Temp\MultiPing\IPtemp.txt"

' Spreadsheet file to be created.
strExcelPath = "C:\Temp\MultiPing\MultiPing.xlsx"

' Bind to Excel object.
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = 1

' Create a new workbook.
objExcel.Workbooks.Add

' Bind to worksheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
objSheet.Name = "Active IPs"

' Populate spreadsheet cells with user attributes.
objSheet.Cells(1, 1).Value = "IP Address"
objSheet.Cells(1, 2).Value = "Computer Name"
objSheet.Cells(1, 3).Value = "Estado"

' Format the spreadsheet.
objSheet.Range("A1:C1").Font.Bold = True
objSheet.Select
objSheet.Range("A2:C2").Select
objExcel.ActiveWindow.FreezePanes = True
objExcel.Columns(1).ColumnWidth = 15
objExcel.Columns(2).ColumnWidth = 20

LF = Chr(10)
Const ForReading = 1, ForWriting = 2, ForAppending = 3

currentIP = StartIP
Set Shell = CreateObject("wscript.shell")
Set fs = CreateObject("scripting.FileSystemObject")

j = 2

Do

Command = "cmd /C PING.EXE -a " & currentIP & " -n 1 -w 700 > " & tempfilename
x = Shell.Run(Command, 0, True)

Set f = fs.OpenTextFile(tempfilename, ForReading, True)
fline = f.readline
fline = f.readline

l1 = InStr(fline, " ")
l2 = InStr(l1 + 1, fline, " ")
l3 = InStr(l2 + 1, fline, " ")
l4 = InStr(fline, ".")
l5 = InStr(1, currentIP, ".")
mname = Mid(fline, l3 + 1, l4 - l3 - 1)

If mname = Mid(currentIP, 1, l5 - 1) Then
mname = "No encontrado"
End If

fline = f.readline
l5 = InStr(fline, " ")

If Mid(fline, 1, l5 - 1) <> "Respuesta" Then
found = "No Responde"
objSheet.Cells(j, 3).Value = found
Else
found = "Activo"
objSheet.Cells(j, 3).Value = found
End If

objSheet.Cells(j, 1).Value = currentIP
objSheet.Cells(j, 2).Value = mname

f.Close
xx = currentIP
currentIP = newip(xx)
j = j + 1

Loop Until currentIP = EndIP

Command = "cmd /C PING.EXE -a " & EndIP & " -n 1 -w 700 > " & tempfilename
x = Shell.Run(Command, 0, True)

Set f = fs.OpenTextFile(tempfilename, ForReading, True)
fline = f.readline
fline = f.readline

l1 = InStr(fline, " ")
l2 = InStr(l1 + 1, fline, " ")
l3 = InStr(l2 + 1, fline, " ")
l4 = InStr(fline, ".")
l5 = InStr(1, EndIP, ".")
mname = Mid(fline, l3 + 1, l4 - l3 - 1)

If mname = Mid(EndIP, 1, l5 - 1) Then
mname = "No encontrado"
End If

fline = f.readline
l5 = InStr(fline, " ")

If Mid(fline, 1, l5 - 1) <> "Respuesta" Then
found = "No Responde"
objSheet.Cells(j, 3).Value = found
Else
found = "Activo"
objSheet.Cells(j, 3).Value = found
End If

objSheet.Cells(j, 1).Value = EndIP
objSheet.Cells(j, 2).Value = mname

f.Close

' Save the spreadsheet and close the workbook.
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close

' Quit Excel.
objExcel.Application.Quit

' Clean Up
Set objSheet = Nothing
Set objExcel = Nothing

WScript.echo "Done!"

Case 2
WScript.echo "Goodbye."
Set objSheet = Nothing
Set objExcel = Nothing

End Select

'------------
'function for increasing the IP number
'------------
Function newip(xx)

s = 1

s1 = InStr(s, xx, ".", 1)
s2 = InStr(s1 + 1, xx, ".", 1)
s3 = InStr(s2 + 1, xx, ".", 1)
s4 = Len(xx) + 1

o1 = CInt(Mid(xx, 1, s1 - 1))
o2 = CInt(Mid(xx, s1 + 1, s2 - s1 - 1))
o3 = CInt(Mid(xx, s2 + 1, s3 - s2 - 1))
o4 = CInt(Mid(xx, s3 + 1, s4 - s3 - 1))
o4 = o4 + 1

If o4 > 255 Then 'If octet 4 is greater to 255, then pass to next network segment
o3 = o3 + 1
o4 = 0
End If

If o3 > 255 Then 'If octet 3 is greater to 255, then pass to next network segment
o2 = o2 + 1
o3 = 0
o4 = 0
End If

If o2 > 255 Then 'If octet 2 is greater to 255, then pass to next network segment
o1 = o1 + 1
o2 = 0
o3 = 0
o4 = 0
End If

newip = (o1 & "." & o2 & "." & o3 & "." & o4)

End Function

'------------
'function for validating the IP address
'------------
Function ValidIP(xx)

n = 1
n0 = n
s = 1
valido = "valid"

s1 = InStr(s, xx, ".", 1)
s2 = InStr(s1 + 1, xx, ".", 1)
s3 = InStr(s2 + 1, xx, ".", 1)
s4 = Len(xx) + 1
s5 = InStr(s3 + 1, xx, ".", 1)

If s1 - s < 1 Or s1 - s > 3 Then 'Validate that the octet 1 has 1 to 3 digits
valido = "invalid"
ElseIf s2 - s1 < 2 Or s2 - s1 > 4 Then 'Validate that the octet 2 has 1 to 3 digits
valido = "invalid"
ElseIf s3 - s2 < 2 Or s3 - s2 > 4 Then 'Validate that the octet 3 has 1 to 3 digits
valido = "invalid"
ElseIf s4 - s3 < 2 Or s4 - s3 > 4 Then 'Validate that the octet 4 has 1 to 3 digits
valido = "invalid"
ElseIf s5 <> 0 Then 'Validate that after octet 4 there is nothing more
valido = "invalid"
ElseIf Not IsNumeric(Mid(xx, 1, s1 - 1)) Then 'Validate that the octet 1 is numeric
valido = "invalid"
ElseIf Not IsNumeric(Mid(xx, s1 + 1, s2 - s1)) Then 'Validate that the octet 2 is numeric
valido = "invalid"
ElseIf Not IsNumeric(Mid(xx, s2 + 1, s3 - s2)) Then 'Validate that the octet 3 is numeric
valido = "invalid"
ElseIf Not IsNumeric(Mid(xx, s3 + 1, s4 - s3)) Then 'Validate that the octet 4 is numeric
valido = "invalid"
ElseIf Mid(xx, 1, s1 - 1) > 255 Or Mid(xx, 1, s1 - 1) < 0 Then 'Validate if octet 1 is between 1 and 255
valido = "invalid"
ElseIf Mid(xx, s1 + 1, s2 - s1) > 255 Or Mid(xx, s1 + 1, s2 - s1) < 0 Then 'Validate if octet 2 is between 1 and 255
valido = "invalid"
ElseIf Mid(xx, s2 + 1, s3 - s2) > 255 Or Mid(xx, s2 + 1, s3 - s2) < 0 Then 'Validate if octet 3 is between 1 and 255
valido = "invalid"
ElseIf Mid(xx, s3 + 1, s4 - s3) > 255 Or Mid(xx, s3 + 1, s4 - s3) < 0 Then 'Validate if octet 4 is between 1 and 255
valido = "invalid"
End If

ValidIP = valido

End Function

'------------
'function for validating the End IP address
'------------
Function GreaterIP(xx, yy)

valido = "after"

s = 1
t = 1

s1 = InStr(s, xx, ".", 1)
s2 = InStr(s1 + 1, xx, ".", 1)
s3 = InStr(s2 + 1, xx, ".", 1)
s4 = Len(xx) + 1

t1 = InStr(t, yy, ".", 1)
t2 = InStr(t1 + 1, yy, ".", 1)
t3 = InStr(t2 + 1, yy, ".", 1)
t4 = Len(yy) + 1

so1 = CInt(Mid(xx, 1, s1 - 1))
eo1 = CInt(Mid(yy, 1, t1 - 1))
so2 = CInt(Mid(xx, s1 + 1, s2 - s1 - 1))
eo2 = CInt(Mid(yy, t1 + 1, t2 - t1 - 1))
so3 = CInt(Mid(xx, s2 + 1, s3 - s2 - 1))
eo3 = CInt(Mid(yy, t2 + 1, t3 - t2 - 1))
so4 = CInt(Mid(xx, s3 + 1, s4 - s3 - 1))
eo4 = CInt(Mid(yy, t3 + 1, t4 - t3 - 1))

If so1 < eo1 Then
valido = "after"
Else: valido = "before"
If so2 > eo2 And so1 < eo1 Then
valido = "after"
Else: valido = "before"
If so3 > eo3 And so2 < eo2 Then
valido = "after"
Else: valido = "before"
If so3 > eo3 And so1 < eo1 Then
valido = "after"
Else: valido = "before"
If so4 > eo4 And so3 < eo3 Then
valido = "after"
Else: valido = "before"
If so4 > eo4 And so2 < eo2 Then
valido = "after"
Else: valido = "before"
If so4 > eo4 And so1 < eo1 Then
valido = "after"
Else If so4 < eo4 Then
valido = "after"
Else If so3 < eo3 Then
valido = "after"
Else If so2 < eo2 Then
valido = "after"
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If

GreaterIP = valido

End Function

Greetings
 
I forgot to tell you that this script only function correctly in Windows 7 Spanish. For other versions you have to evaluate from line 100 to 171 and modify specially the l1, l2, l3, l4 and l5 variables, also check conditionals with word "Respuesta" between lines mentioned.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top