'/*程序名称：获取外网IP
'/*说明：核心代码源自网络，youxi01整理修改；
set oDOM = WScript.GetObject("http://ipseeker.cn//")

'/*/////////设置连接是否成功的标志符；/////////
flag=0

'/*////////设置连接次数；///////////
for i=1 to 10
   '/*///////////如果已经成功连接，则跳出for循环；////////
   if oDOM.readyState = "complete" then 
      flag=1
      exit for
   end if
   WScript.sleep 500       '每0.5秒就连接一次；
next

if flag=0 then
    msgbox "连接超时，请重新连接...",vbExclamation,"连接超时"
    wscript.quit
end if

'/*///////////保存返回结果////////////
s=oDOM.documentElement.innerText

'/*///////////正则表达式///////////
Set Re = New RegExp
'/*//////数据匹配：数字.数字.数字.数字
Re.Pattern="(\d+)\.(\d+)\.(\d+)\.(\d+)"
for each r in Re.Execute(s)
     res=r
     exit for
Next

msgbox "您的IP地址是："&vbcrlf&vbcrlf&res,vbInformation,"连接成功"
复制代码

' GetWanIP.vbs
If Ping("www.ip138.com") Then
  Msgbox "你的外网IP是："  & HttpGet("http://1212.ip138.com/ic.asp")
Else
  Msgbox "你的电脑没有连通外网。"
End If

Function HttpGet(ByVal url)
  On Error Resume Next
  With CreateObject("Msxml2.ServerXMLHTTP")
    .open "GET", url, False
    .send
    HttpGet = split(split(.responseText, "[")(1), "]")(0)
  End With
End Function

Function Ping(ByVal host)
  On Error Resume Next
  Ping = False
  Dim objWMIService, colItems
  Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
  Set colItems = objWMIService.ExecQuery("Select * From Win32_PingStatus Where Address='" & host & "'")
  For Each objItem In colItems
    If objItem.StatusCode = 0 Then Ping = True : Exit For
  Next
End Function
复制代码