使用vbs获得外网ip并发送到邮箱里

获得本地外网地址并发送到指定邮箱，还可以参考这个文章http://www.jb51.net/article/40064.htm

Option Explicit 

Call Main '执行入口函数 

'- ----------------------------------------- - 
' 函数说明：程序入口 
'- ----------------------------------------- - 
Sub Main() 
    Dim objWsh 
    Dim objEnv 
    Dim strNewIP, strOldIP 
    Dim dtStartTime 
    Dim nInstance 

    strOldIP = "" 
    dtStartTime = DateAdd("n", -30, Now) '设置起始时间 

    '获得运行实例数，如果大于1，则结束以前运行的实例 
    Set objWsh = CreateObject("WScript.Shell") 
    Set objEnv = CreateObject("WScript.Shell").Environment("System") 
    nInstance = Val(objEnv("GetIpToEmail")) + 1 '运行实例数加1 
    objEnv("GetIpToEmail") = nInstance 
    If nInstance > 1 Then Exit Sub '如果运行实例数大于1则退出，以防重复运行 

    '开启远程桌面 
    'EnabledRometeDesktop True, Null 

    '在后台连续检测外网地址，如果有变化则发送邮件到指定邮箱 
    Do 
        If Err.Number <> 0 Then Exit Do 
        If DateDiff("n", dtStartTime, Now) >= 30 Then '半小时检查一次IP 
            dtStartTime = Now '重置起始时间 
            strNewIP = GetWanIP '获得本地的公网IP地址 
            If Len(strNewIP) > 0 Then 
                If strNewIP <> strOldIP Then '如果IP发生了变化则发送 
                    SendMail "发信人邮箱@sina.com", "密码", "收信人邮箱@sina.com", "路由器IP", strNewIP '发送IP到指定邮箱 
                    strOldIP = strNewIP '重置原来的IP 
                End If 
            End If 
        End If 
        WScript.Sleep 2000 '延时2秒，以释放CPU资源 
    Loop Until Val(objEnv("GetIpToEmail")) > 1 
    objEnv.Remove "GetIpToEmail" '清除运行实例数变量 
    Set objEnv = Nothing 
    Set objWsh = Nothing 

    MsgBox "程序被成功终止!", 64, "提示" 
End Sub 

'- ----------------------------------------- - 
' 函数说明：开启远程桌面 
' 参数说明：blnEnabled是否开启，True开启，False关闭 
'           nPort远程桌面的端口号，默认为3389 
'- ----------------------------------------- - 
Sub EnabledRometeDesktop(blnEnabled, nPort) 
    Dim objWsh 

    If blnEnabled Then 
        blnEnabled = 0 '0表示开启 
    Else 
        blnEnabled = 1 '1表示关闭 
    End If 

    Set objWsh = CreateObject("WScript.Shell") 
    '开启远程桌面并设置端口号 
    objWsh.RegWrite "HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Control/Terminal Server/fDenyTSConnections", blnEnabled, "REG_DWORD" '开启远程桌面 
    '设置远程桌面端口号 
    If IsNumeric(nPort) Then 
        If nPort > 0 Then 
            objWsh.RegWrite "HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Control/Terminal Server/Wds/rdpwd/Tds/tcp/PortNumber", nPort, "REG_DWORD" 
            objWsh.RegWrite "HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Control/Terminal Server/WinStations/RDP-Tcp/PortNumber", nPort, "REG_DWORD" 
        End If 
    End If 
    Set objWsh = Nothing 
End Sub 

'- ----------------------------------------- - 
' 函数说明：获得公网IP 
'- ----------------------------------------- - 
Function GetWanIP() 
    Dim nPos 
    Dim objXmlHTTP 

    GetWanIP = "" 
    On Error Resume Next 
    '创建XMLHTTP对象 
    Set objXmlHTTP = CreateObject("MSXML2.XMLHTTP") 

    '导航至http://www.ip138.com/ip2city.asp获得IP地址  
    objXmlHTTP.open "GET", "http://iframe.ip138.com/ic.asp", False 
    objXmlHTTP.send 

    '提取HTML中的IP地址字符串 
    nPos = InStr(objXmlHTTP.responseText, "[") 
    If nPos > 0 Then 
        GetWanIP = Mid(objXmlHTTP.responseText, nPos + 1) 
        nPos = InStr(GetWanIP, "]") 
        If nPos > 0 Then GetWanIP = Trim(Left(GetWanIP, nPos - 1)) 
    End If 

    '销毁XMLHTTP对象 
    Set objXmlHTTP = Nothing 
End Function 

'- ----------------------------------------- - 
' 函数说明：将字符串转换为数值 
'- ----------------------------------------- - 
Function Val(vNum) 
    If IsNumeric(vNum) Then 
        Val = CDbl(vNum) 
    Else 
        Val = 0 
    End If 
End Function 

'- ----------------------------------------- - 
' 函数说明：发送邮件 
' 参数说明：strEmailFrom：发信人邮箱 
'           strPassword：发信人邮箱密码 
'           strEmailTo：收信人邮箱 
'           strSubject：邮件标题 
'           strText：邮件内容 
'- ----------------------------------------- - 
Function SendMail(strEmailFrom, strPassword, strEmailTo, strSubject, strText) 
    Dim i, nPos