VBScript To Get Your Current IP

This script uses Microsoft's Xmlhttp (shipped with Internet Explorer 5
and greater) to connect to showmyip.com, a free service which displays
your current IP. This is particularly useful if you are behind a NAT router
or a firewall.

The script has two 'modes' of operation. In one it displays in a messagebox
your current IP and hostname, in the other, it logs those two items to files
of your choice.

You set the appropriate options in the first section of the script below. Nothing
else needs to be changed.

Please note, if you plan to run this script unattended from the task manager,
ShowMyIP.com requests that you limit your connections to once every thirty
minutes.

'Code begins here

' CurrentIP.vbs
' 1/22/2002
' Copyright Paul R. Sadowski <aa089(at)bfn.org>
'=======================================================
'Change ONLY these Four items as needed!

'Set to False to throw an error when it can't connect, True to ignore connection errors
'best set to True when running from the task scheduler; False when running manually
Const NoError = False

'Set to False to use a messagebox or True to log to files
Const LogToFile = False

'Full Paths To the two logfiles:
Const LogFileIP = "c:\CurrentIP.txt"
Const LogFileName = "c:\CurrentHostName.txt"
'=======================================================
' DO NOT ALTER BELOW THIS LINE!
'=======================================================
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Const URL = "http://www.showmyip.com/"
Const WATCHFOR1 = "SIZE=""+8"">"
Const WATCHFOR2 = "<"
Const WATCHFOR3 = "<br>host/your name: </FONT><FONT FACE=""Verdana"">"

Dim Raw, IPText, NameText, WasError, x

If LogToFIle = True then
  if LogFileIP = "" or LogFileName = "" then
    Wscript.Echo "LogFileIP or LogFIleName is not set!" & vbCRLF & " Exiting!"
    Wscript.Quit
  end if
end if
GetRawData
GetIP
GetName
if LogToFIle = True then
  WriteToFile
else
  MsgBox "IP: " & IPText & vbCRLF & "Hostname: " & NameText
end if

Sub GetRawData
Err.Clear
Set WshShell = WScript.CreateObject("WScript.Shell")
If NoError = True then
  On Error Resume Next
end if
Set Http = CreateObject("Microsoft.XmlHttp")
Http.open "GET", URL, FALSE
Http.send ""
Raw = http.responseText
If NoError = True then
  On Error GoTo 0
end if
if Err.Number <> 0 then
  if NoError = False then
    MsgBox "Could not connect to server " & URL & vbCRLF & " exiting"
    Wscript.Quit
  else
    WasError = True
  end if
end if
Err.Clear
Set Http = Nothing
Set WshShell = Nothing
End Sub

Sub GetIP
x = Instr(Raw, WATCHFOR1)
if x <> 0 then
  IPText = mid(Raw, x + Len(WATCHFOR1))
  x = Instr(IPText, WATCHFOR2)
  if x <> 0 then
    IPText = mid(IPText, 1, x-1)
  end if
end if
End Sub

Sub GetName
if WasError = True then
  Exit Sub
end if
x = Instr(Raw, WATCHFOR3)
if x <> 0 then
  NameText = mid(Raw, x + Len(WATCHFOR3))
  x = Instr(NameText, WATCHFOR2)
  if x <> 0 then
    NameText = mid(NameText, 1, x-1)
  end if
  if Instr(NameText, ">") <> 0 then
    do until x = 0
      x = Instr(NameText, ">")
      if x <> 0 then
        NameText = mid(NameText, x+1)
      end if
    loop
  end if
end if
End Sub

Sub WriteToFile
if LogFileIP <> "" and LogFileName <> "" and IPText <> "" then
Set fs = CreateObject("Scripting.FileSystemObject")

  Set f = fs.OpenTextFile(LogFileIP, ForWriting, True, TristateFalse)
  f.WriteLine (IPText)
  f.close

  Set f = fs.OpenTextFile(LogFileName, ForWriting, True, TristateFalse)
  f.WriteLine (NameText)
  f.close

Set f = Nothing
Set fs = Nothing
end if
End Sub