'--------------------------------------------------------------------------------
'  ExternalIP.vbs (v1.5)
'--------------------------------------------------------------------------------
'
' Retreives your external IP address from http://checkip.dyndns.org/ (this is 
' useful for computers behind routers and firewalls)
'
' Changes in v1.5
'
' - used regular expressions to pick up IP (removes the <!-- proxy --> bug)
'
' Changes in v1.4
'
' - internet connection detected (thanks AdamC)
'
'
' Changes in v1.3
'
' - international version returns 2 IP addresses if you have multiple NICs in your
'   computer - fixed to only show one. (Thanks Rasman)
'
' Changes in v1.2
'
' - uses new URL to save bandwidth
' - Old script was actually returning proxy IP, not actual IP!
'
' Changes in v1.1:
'
' - Added error messages
' - Hid relevant functions from Samurize 0.85b
'
'								-NeM
'--------------------------------------------------------------------------------

Const CheckConnected      = False                            ' Whether you want the script to check if its connected to the internet
                                                            ' Either True of False


Function getExternalIP ()
	dim htmlResult,re,matches
	
	'Check that Computer is connected to the internet
	Connected = IsConnectible("checkip.dyndns.org","","")	

	if Connected = True OR CheckConnected = False then
		htmlResult = ReturnHTML("http://checkip.dyndns.org/")
		Set re = New RegExp
		With re
		    .Pattern = "\d*\.\d*\.\d*\.\d*"
		    .IgnoreCase = True
		    .Global = True
		End With
		Set matches = re.Execute(htmlResult)
		if matches.count > 0 then
		    getexternalip = matches.item(0).value
		Else
		    getExternalIP = "ERROR"
		End If
		
	Else
		getExternalIP = "Offline"
	End If

End Function

Private Function ReturnHTML(sURL)
	Dim objXMLHTTP,HTML
	Set objXMLHTTP = CreateObject("Microsoft.XMLHTTP")
	objXMLHTTP.Open "GET", sURL, False
	objXMLHTTP.Send
	HTML = objXMLHTTP.responseBody
	Set objRS = CreateObject("ADODB.Recordset")
	objRS.Fields.Append "txt", 200, 45000, &H00000080
	objRS.Open
	objRS.AddNew
	objRS.Fields("txt").AppendChunk HTML
	ReturnHTML = objRS("txt").Value
	objRS.Close
	Set objRS = Nothing
	Set objXMLHTTP = Nothing
End Function

' This was done by someone on the forums which I copied, and can I find that post again can I heck
' So who every you are thanks for the cold.
Private Function IsConnectible(sHost,iPings,iTO)
	' Works an "all" WSH versions
	' sHost is a hostname or IP

	' iPings is number of ping attempts
	' iTO is timeout in milliseconds
	' if values are set to "", then defaults below used

	 If iPings = "" Then iPings = 2
	 If iTO = "" Then iTO = 750
	
	 Const OpenAsDefault    = -2
	 Const FailIfNotExist   =  0
	 Const ForReading       =  1
	
	 Set oShell = CreateObject("WScript.Shell")
	 Set oFSO = CreateObject("Scripting.FileSystemObject")
	 sTemp = oShell.ExpandEnvironmentStrings("%TEMP%")
	 sTempFile = sTemp & "\runresult.tmp"

	 oShell.Run "%comspec% /c ping -n " & iPings & " -w " & iTO & " " & sHost & ">" & sTempFile, 0 , True
	
	 Set fFile = oFSO.OpenTextFile(sTempFile, ForReading, FailIfNotExist, OpenAsDefault)

	 sResults = fFile.ReadAll
	 fFile.Close
	 oFSO.DeleteFile(sTempFile)
	
	 Select Case InStr(sResults,"TTL=")
	   Case 0 IsConnectible = False
	   Case Else IsConnectible = True
	 End Select
End Function