code:
Dim objHTTP, strHTML, varStart, varStop
Dim strIP, strCurrIP, objShell
' Get current external IP address from web
Set objHTTP = CreateObject("MSXML2.XMLHTTP")
Call objHTTP.Open("GET", "http://checkip.dyndns.org", False)
objHTTP.Send()
strHTML = objHTTP.ResponseText
' Extarct IP from HTML if HTML was recieved
If strHTML <> "" Then
varStart = InStr(1, strHTML, "Current IP Address:", vbTextCompare) + 19
If varStart Then varStop = InStr(varStart, strHTML, "</body>", vbTextCompare)
If varStart And varStop Then strIP = Mid(strHTML, varStart, varStop - varStart)
Else
strIP = "Unavailable"
End If
' Remove preceeding or trailing spaces
strCurrIP = Trim(strIP)
' Copy IP to clipboard
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "CMD /C ECHO " & strCurrIP & " | CLIP", 2
' Display the current external IP address
MsgBox "External IP: " & strCurrIP
' Clear variables
Set objHTTP = Nothing
Set strHTML = Nothing
Set varStart = Nothing
Set varStop = Nothing
Set strIP = Nothing
Set strCurrIP = Nothing
Set objShell = Nothing
Dim objHTTP, strHTML, varStart, varStop
Dim strIP, strCurrIP, objShell
' Get current external IP address from web
Set objHTTP = CreateObject("MSXML2.XMLHTTP")
Call objHTTP.Open("GET", "http://checkip.dyndns.org", False)
objHTTP.Send()
strHTML = objHTTP.ResponseText
' Extarct IP from HTML if HTML was recieved
If strHTML <> "" Then
varStart = InStr(1, strHTML, "Current IP Address:", vbTextCompare) + 19
If varStart Then varStop = InStr(varStart, strHTML, "</body>", vbTextCompare)
If varStart And varStop Then strIP = Mid(strHTML, varStart, varStop - varStart)
Else
strIP = "Unavailable"
End If
' Remove preceeding or trailing spaces
strCurrIP = Trim(strIP)
' Copy IP to clipboard
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "CMD /C ECHO " & strCurrIP & " | CLIP", 2
' Display the current external IP address
MsgBox "External IP: " & strCurrIP
' Clear variables
Set objHTTP = Nothing
Set strHTML = Nothing
Set varStart = Nothing
Set varStop = Nothing
Set strIP = Nothing
Set strCurrIP = Nothing
Set objShell = Nothing
No comments:
Post a Comment