外网ip有变化发送邮箱vbs版

 家里宽带有公网ip，但是老是变，想着找个报告ip的软件，网上找半天没有好用的，要么就获取不到外网ip的，干脆自己用vbs凑活个。
获取外网ip用的是3322，用了不知道多少年了，依然好用。有其它接口欢迎补充。
邮箱用的是88邮箱，要用专用密码。其他邮箱自测。

Function DeleteLine(strFile, strKey, LineNumber, CheckCase)
'DeleteLine Function by TomRiddle 2008

'Remove line(s) containing text (strKey) from text file (strFile)
'or
'Remove line number from text file (strFile)
'or
'Remove line number if containing text (strKey) from text file (strFile)

'Use strFile = "c:\file.txt" (Full path to text file)
'Use strKey = "John Doe" (Lines containing this text string to be deleted)
'Use strKey = "" (To not use keyword search)
'Use LineNumber = "1" (Enter specific line number to delete)
'Use LineNumber = "0" (To ignore line numbers)
'Use CheckCase = "1" (For case sensitive search )
'Use CheckCase = "0" (To ignore upper/lower case characters)

Const ForReading = 1: Const ForWriting = 2
Dim objFSO, objFile, Count, strLine, strLineCase, strNewFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.opentextfile(strFile, ForReading)
Do Until objFile.AtEndOfStream
strLine = objFile.readline
If CheckCase = 0 Then strLineCase = UCase(strLine): strKey = UCase(strKey)
If LineNumber = objFile.Line - 1 Or LineNumber = 0 Then
If InStr(strLine, strKey) Or InStr(strLineCase, strKey) Or strKey = "" Then
strNewFile = strNewFile
Else
strNewFile=strNewFile&strLine&vbcrlf
End If
Else
strNewFile=strNewFile&strLine&vbcrlf
End If
Loop
objFile.Close
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.opentextfile(strFile, ForWriting)
objFile.write strNewFile
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
End Function

Function GetIPAddress()
 Dim Flag, Source
 Set GetIPObj = wscript.GetObject("http://ip.3322.org")
 Flag = 0
 For i = 1 To 10
    If GetIPObj.readyState = "complete" Then
    Flag = 1
    Exit For
    End If
    wscript.sleep 500
 Next
 If Flag = 0 Then
  GetIPAddress = "Get IP Address Time Out ..."
 Else
  Source = GetIPObj.DocumentElement.innerText
  Set Rep = New RegExp
  Rep.Pattern = "(\d+)\.(\d+)\.(\d+)\.(\d+)"
  For Each result In Rep.Execute(Source)
    GetIPAddress = result
    Exit For
  Next
 End If
  Set GetIPObj = Nothing
End Function

Function MailTo(MailAddress)
    Dim NameSpace, MailObject

    Set objnet = CreateObject("WScript.Network")

    NameSpace = "http://schemas.microsoft.com/cdo/configuration/"

    Set MailObject = CreateObject("CDO.Message")
    MailObject.From = "fromuser@88.com"
    MailObject.To = MailAddress
    MailObject.Subject = Now & objnet.ComputerName & "  IP:" & GetIPAddress()

    MailObject.Textbody = Now & ": " & Chr(10) & Line & Chr(10) & "to" & Chr(10) & GetIPAddress()

    MailObject.Configuration.Fields.Item(NameSpace & "sendusing") = 2
    MailObject.Configuration.Fields.Item(NameSpace & "smtpserver") = "smtp.88.com"
    MailObject.Configuration.Fields.Item(NameSpace & "smtpserverport") = 25
    MailObject.Configuration.Fields.Item(NameSpace & "smtpauthenticate") = 1
    MailObject.Configuration.Fields.Item(NameSpace & "sendusername") = "fromuser"
    MailObject.Configuration.Fields.Item(NameSpace & "sendpassword") = "passwordoffromuser"

    MailObject.Configuration.Fields.Update
    MailObject.Send
    Set objnet = Nothing
End Function

Function Writeip()
Set fs = CreateObject("scripting.filesystemobject")
If (fs.fileexists(filep)) Then
  Set f = fs.opentextfile(filep, 8)
  f.write Data
'  f.writeline data
  f.Close
    Set f = Nothing
Else
  Set f = fs.opentextfile(filep, 2, True)
'  f.writeblanklines 2
  f.write Data
  f.Close
  Set f = Nothing
End If
Set fs = Nothing
End Function

Function Sp(WhatTimes)
wscript.sleep 1000 * WhatTimes
End Function

Function Ping(strHostName)
  ' Standard housekeeping
  Dim colPingResults, objPingResult, strQuery
  ' Define the WMI query
  strQuery = "SELECT * FROM Win32_PingStatus WHERE Address = '" & strHostName & "'"
  ' Run the WMI query
  Set colPingResults = GetObject("winmgmts:root\cimv2").ExecQuery(strQuery)
  ' Translate the query results to either True or False
  For Each objPingResult In colPingResults
    If Not IsObject(objPingResult) Then
      Ping = False
    Else
      If objPingResult.StatusCode = 0 Then
        Ping = True
      Else
        Ping = False
      End If
      'WScript.Echo "Ping status code for " & strHostName & ": " & objPingResult.StatusCode
    End If
  Next
  Set colPingResults = Nothing
End Function

filep = "C:\20220111\3.txt"
Line = "empty"


'---判断ping通开始
Function ceping()
k=0
while k < 1

If Ping("119.29.29.29") = 0 Then
wscript.echo "没ping通"
Sp (3)
'Call ceping
else
wscript.echo Ping("119.29.29.29")
k=2
End If
wend
End Function
'---判断ping通结束

Set fs = CreateObject("scripting.filesystemobject")
If (fs.fileexists(filep)) Then
       DeleteLine filep, "", 0, 0

Set ts = Nothing
Set fs = Nothing
Else

Set ts = Nothing
Set fs = Nothing
End If
       Sp (1)
       Data = "127.0.0.1"
       Writeip()
       Sp (1)

While 1
Call ceping
wscript.echo "ping通"
Data = GetIPAddress()

Set fs = CreateObject("scripting.filesystemobject")

If (fs.fileexists(filep)) Then
Set ts = fs.opentextfile(filep, 1, True)
Line = ts.readline
ts.Close
Set ts = Nothing
Set fs = Nothing
Else
Writeip()
MailTo ("receiveuser@88.com")
Line = Data
Set ts = Nothing
Set fs = Nothing
End If

If StrComp(Line, Data, 0) Then
MailTo ("receiveuser@88.com")
DeleteLine filep, "", 0, 0
Writeip()
Else
'msgbox "ip无变化"
Sp (10)

End If

Wend