Automated script to prevent Dead IP range

S

seburn

Expert Member
Joined
Apr 25, 2005
Messages
1,127
Reaction score
0
Location
JHB
Code: 
' *************************************************************** '
	' *  Initialize some variables.					* '
	' *************************************************************** '
	Dim strDUN
	strDUN="Your dial up name" 'Eg iBurst connection 1
	username="yourusername"
	password="yourpassword"
	arrayBadip=Array("64","65")

	msgbox "Connecting to the internet."
	incorrectIP=true
	while incorrectIp
		InternetConnect
		ip=GetIp
		incorrectIp=false
		thirdOct=ip
		thirdOct=right(thirdOct,len(thirdOct)-instr(thirdOct,"."))
		thirdOct=right(thirdOct,len(thirdOct)-instr(thirdOct,"."))
		thirdOct=left(thirdOct,instr(thirdOct,".")-1)
		for i=0 to ubound(arrayBadip)
			if thirdOct=arrayBadip(i) then
				'uncomment the line below for debug
                                                    'msgbox "wrong ip:"&ip&" third octet:"&thirdOct
				incorrectIp=true
				InternetDisconnect
			end if
		Next
		if incorrectIp=false then
			
			msgbox "You are now online."
		end if
		
	wend 
		
 

' *********************************************************************** '
' *  Subroutine to connect to the internet.				* '
' *********************************************************************** '
Sub InternetConnect()
	commandLine = "rasdial "&strDUN&" "&userName&" "&password
   	Set WshShell = CreateObject("WScript.Shell")
   	call WshShell.Run (commandLine,8,true)
   	set WshShell=nothing
End Sub

' *********************************************************************** '
' *  Subroutine to disconnect from the internet.			* '
' *********************************************************************** '
Sub InternetDisconnect()
	commandLine = "rasdial "&strDUN&" /Disconnect"
   	Set WshShell = CreateObject("WScript.Shell")
   	call WshShell.Run (commandLine,8,true)
   	set WshShell=nothing
End Sub
' *********************************************************************** '
' *  Subroutine to get ip address.			* '
' *********************************************************************** '
Function GetIP()
  Dim ws : Set ws = CreateObject("WScript.Shell")
  Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
  Dim TmpFile : TmpFile = fso.GetSpecialFolder(2) & "/ip.txt"
  Dim ThisLine, IP
  If ws.Environment("SYSTEM")("OS") = "" Then
    ws.run "winipcfg /batch " & TmpFile, 0, True
  Else
    ws.run "%comspec% /c ipconfig > " & TmpFile, 0, True
  End If
  With fso.GetFile(TmpFile).OpenAsTextStream
    Do While NOT .AtEndOfStream
      ThisLine = .ReadLine
      If InStr(ThisLine, "Address") <> 0 Then IP = Mid(ThisLine, InStr(ThisLine, ":") + 2)
    Loop
    .Close
  End With
  'WinXP (NT? 2K?) leaves a carriage return at the end of line
  If IP <> "" Then
    If Asc(Right(IP, 1)) = 13 Then IP = Left(IP, Len(IP) - 1)
  End If
  GetIP = IP
  fso.GetFile(TmpFile).Delete  
  Set fso = Nothing
  Set ws = Nothing
End Function
A little messy but hey ... Copy into notepad and save as .vbs
Fill in your details connection name username password and viola.
Run the app ... If you have trouble and need to stop the loop you will have to hit ctrl alt del and click processes and kill wscript process.

This will not work AFAIK if you have not dialed in using this method already
 
But his cant work when using a router I assume?

A bit of a problem for me and alot of people I guess. Or am I wrong?

I cant really understand most of the code.. But I'll give it a try, thanks.

btw, to make it into an ap wont you need to run the vbc.exe compiler?
 
No it won't work on routers unless you use bridge mode (dial per pc and create connection per pc... not sure if modem allows multiple connections) and no you don't need compiler its vbscript
 
Comical variation of your script...

This variation of Seburn’s script, will prevent all the slow and dead IP60/69 ranges from being selected, therefore only allowing the faster 70 range and will display the final IP in a msg box, once connected. Be aware that it may take several tries before you are successfully connected via a stable IP address.

Remember to change the name of your dial-up connection, your username, password and msg's if you want.

' *************************************************************** '
' * Initialize some variables.* '
' *************************************************************** '
Dim strDUN
strDUN="iBurst"
username="your username"
password="your password"
arrayBadip=Array("64","65","66","67","68","69")
'uncomment the line below for debug
msgbox "Click OK to connect to the internet."
incorrectIP=true
while incorrectIp
InternetConnect
ip=GetIp
incorrectIp=false
thirdOct=ip
thirdOct=right(thirdOct,len(thirdOct)-instr(thirdOct,"."))
thirdOct=right(thirdOct,len(thirdOct)-instr(thirdOct,"."))
thirdOct=left(thirdOct,instr(thirdOct,".")-1)
for i=0 to ubound(arrayBadip)
if thirdOct=arrayBadip(i) then
'uncomment the line below to show connection progress
msgbox "IP of Death found – Click OK to retry :"&ip&""
incorrectIp=true
InternetDisconnect
end if
Next
if incorrectIp=false then
'uncomment the line below to show connection progress
msgbox "Congratulations you have won the iBurst IP lottery! You are now connected with IP Address: "&ip&""
end if
wend
' *********************************************************************** '
' * Subroutine to connect to the internet. * '
' *********************************************************************** '
Sub InternetConnect()
commandLine = "rasdial "&strDUN&" "&userName&" "&password
Set WshShell = CreateObject("WScript.Shell")
call WshShell.Run (commandLine,8,true)
set WshShell=nothing
End Sub

' *********************************************************************** '
' * Subroutine to disconnect from the internet. * '
' *********************************************************************** '
Sub InternetDisconnect()
commandLine = "rasdial "&strDUN&" /Disconnect"
Set WshShell = CreateObject("WScript.Shell")
call WshShell.Run (commandLine,8,true)
set WshShell=nothing
End Sub
' *********************************************************************** '
' * Subroutine to get ip address. * '
' *********************************************************************** '
Function GetIP()
Dim ws : Set ws = CreateObject("WScript.Shell")
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim TmpFile : TmpFile = fso.GetSpecialFolder(2) & "/ip.txt"
Dim ThisLine, IP
If ws.Environment("SYSTEM")("OS") = "" Then
ws.run "winipcfg /batch " & TmpFile, 0, True
Else
ws.run "%comspec% /c ipconfig > " & TmpFile, 0, True
End If
With fso.GetFile(TmpFile).OpenAsTextStream
Do While NOT .AtEndOfStream
ThisLine = .ReadLine
If InStr(ThisLine, "Address") <> 0 Then IP = Mid(ThisLine, InStr(ThisLine, ":") + 2)
Loop
.Close
End With
'WinXP (NT? 2K?) leaves a carriage return at the end of line
If IP <> "" Then
If Asc(Right(IP, 1)) = 13 Then IP = Left(IP, Len(IP) - 1)
End If
GetIP = IP
fso.GetFile(TmpFile).Delete
Set fso = Nothing
Set ws = Nothing
End Function
 
Last edited:
You must log in or register to reply here.
Back
Top
Sign up to the MyBroadband newsletter
X