' *************************************************************** '
' * 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