Use the VBS to get the extranet IP and send it to the mailbox _vbs

Get the local extranet address and send it to the specified mailbox, and refer to this article http://www.jb51.net/article/40064.htm

Copy Code code as follows:

'* **************************************** *
' * Program name: Getip.vbs
' * Program Description: Get the local extranet address and send to the designated mailbox
' * Code: Lyserver
'* **************************************** *

Option Explicit

Call Main ' Executes the entry function

'- ----------------------------------------- -
' Function Description: Program entry
'- ----------------------------------------- -
Sub Main ()
Dim objwsh
Dim objenv
Dim Strnewip, Stroldip
Dim Dtstarttime
Dim ninstance

Stroldip = ""
Dtstarttime = DateAdd ("n", -30, now) ' Set start time

' Get the number of run instances, if greater than 1, then end the previously running instance
Set objwsh = CreateObject ("Wscript.Shell")
Set objenv = CreateObject ("Wscript.Shell"). Environment ("System")
Ninstance = Val (objenv ("Getiptoemail")) + 1 ' run instance number plus 1
Objenv ("getiptoemail") = Ninstance
If ninstance > 1 Then exit Sub ' exit if the number of running instances is greater than 1 to prevent duplicate operation

' Open Remote Desktop
' Enabledrometedesktop True, Null

' Continuously detects the extranet address in the background and sends the message to the designated mailbox if any changes are detected
Todo
If err.number <> 0 Then Exit do
If DateDiff ("n", Dtstarttime, now) >= Then ' Half an hour check IP
Dtstarttime = Now ' reset start time
Strnewip = Getwanip ' Get local public network IP address
If Len (STRNEWIP) > 0 Then
If Strnewip <> stroldip Then ' If IP has changed then send
SendMail "Sender's mailbox @sina.com", "password", "Addressee Mailbox @sina.com", "Router IP", strnewip ' send IP to designated mailbox
Stroldip = Strnewip ' Reset the original IP
End If
End If
End If
Wscript.Sleep 2000 ' delay of 2 seconds to free up CPU resources
Loop Until Val (objenv ("Getiptoemail")) > 1
Objenv.remove "Getiptoemail" clears run instance number variable
Set objenv = Nothing
Set objwsh = Nothing

MsgBox "The program is terminated successfully!", 64, "Prompt"
End Sub

'- ----------------------------------------- -
' Function Description: Open Remote Desktop
' Parameter description: blnenabled is turned on, true is turned on, false is closed
' Nport the port number of Remote Desktop, defaults to 3389
'- ----------------------------------------- -
Sub enabledrometedesktop (blnenabled, Nport)
Dim objwsh

If blnenabled Then
blnenabled = 0 ' 0 means open
Else
blnenabled = 1 ' 1 means close
End If

Set objwsh = CreateObject ("Wscript.Shell")
' Open Remote Desktop and set the port number
Objwsh.regwrite "Hkey_local_machine/system/currentcontrolset/control/terminal Server/fDenyTSConnections", Blnenabled, "REG_DWORD" ' Open Remote Desktop
' Set the Remote Desktop port number
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

'- ----------------------------------------- -
' Function Description: Access to public network IP
'- ----------------------------------------- -
Function Getwanip ()
Dim NPOs
Dim objXmlHttp

Getwanip = ""
On Error Resume Next
' Create a XMLHTTP object
Set objXmlHttp = CreateObject ("MSXML2. XMLHTTP ")

' Navigate to http://www.ip138.com/ip2city.asp for IP address
Objxmlhttp.open "Get", "http://iframe.ip138.com/ic.asp", False
Objxmlhttp.send

' Extract the IP address string in HTML
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

' Destroy the XMLHTTP object
Set objXmlHttp = Nothing
End Function

'- ----------------------------------------- -
' Function Description: Converts a string to a numeric value
'- ----------------------------------------- -
Function Val (Vnum)
If IsNumeric (vnum) Then
Val = CDBL (vnum)
Else
Val = 0
End If
End Function

'- ----------------------------------------- -
' Function Description: Send mail
' Parameter description: Stremailfrom: Sender's mailbox
' Strpassword: Sender's email password
' Stremailto: Recipient's mailbox
' Strsubject: Message headers
' StrText: Message content
'- ----------------------------------------- -
Function SendMail (Stremailfrom, strpassword, Stremailto, Strsubject, StrText)
Dim I, NPOs
Dim strUserName
Dim Strsmtpserver
Dim Objsock
Dim streml
Const sckconnected = 7

Set Objsock = Createwinsock ()
Objsock.protocol = 0

NPOs = InStr (Stremailfrom, "@")
' Verify parameter integrity and legality
If NPOs = 0 or InStr (stremailto, "@") = 0 or len (strText) = 0 or len (strpassword) = 0 Then Exit Function
' Get the email account according to the mailbox name
strUserName = Trim (left (Stremailfrom, nPos-1))
' Get ESMTP server name according to Sender's mailbox
Strsmtpserver = "smtp." & Trim (Mid (Stremailfrom, NPOs + 1))

' Assemble mail
streml = "mime-version:1.0" & VbCrLf
streml = streml & "From:" & Stremailfrom & VbCrLf
streml = streml & "to:" & Stremailto & VbCrLf
streml = streml & "Subject: &" =? GB2312? B. "& Base64Encode (strsubject) &"? = "& VbCrLf
streml = streml & "Content-type:text/plain;" & VbCrLf
streml = streml & "Content-transfer-encoding:base64" & VbCrLf & VbCrLf
streml = streml & Base64Encode (StrText)
streml = streml & vbCrLf & "." & VbCrLf

' Connect to mail service cry
Objsock.connect Strsmtpserver, 25

' Wait for connection to succeed
For i = 1 to 10
If objsock.state = sckconnected Then Exit for
Wscript.Sleep 200
Next

If objsock.state = sckconnected Then
' Ready to send mail
SendCommand objsock, "EHLO vbsemail"
SendCommand objsock, "AUTH LOGIN" ' request for an SMTP session
SendCommand Objsock, Base64Encode (strUserName)
SendCommand Objsock, Base64Encode (strpassword)
SendCommand Objsock, "MAIL from:" & Stremailfrom ' sender
SendCommand Objsock, "RCPT to:" & Stremailto ' addressee
SendCommand objsock, "DATA" ' below is the message content

' Send mail
SendCommand Objsock, Streml

' End mailbox Send
SendCommand objsock, "QUIT"
End If

' Disconnect
Objsock.close
Wscript.Sleep 200
Set Objsock = Nothing
End Function

'- ----------------------------------------- -
' Function Description: SendMail's auxiliary function
'- ----------------------------------------- -
Function SendCommand (Objsock, strcommand)
Dim I
Dim Strecho

On Error Resume Next
Objsock.senddata Strcommand & VbCrLf
For i = 1 to 50 ' wait for results
Wscript.Sleep 200
If objsock.bytesreceived > 0 Then
Objsock.getdata Strecho, vbstring
If (Val (Strecho) > 0 and Val (Strecho) <) Or InStr (Strecho, "+ok") > 0 Then
SendCommand = True
End If
Exit Function
End If
Next
End Function

'- ----------------------------------------- -
' Function Description: Create the Winsock object, and if it fails, download the register and then create
'- ----------------------------------------- -
Function Createwinsock ()
Dim objwsh
Dim objXmlHttp
Dim Objadostream
Dim objFSO
Dim Strsystempath

' Create and return the Winsock object
On Error Resume Next
Set Createwinsock = CreateObject ("Mswinsock.winsock")
If err.number = 0 Then Exit Function ' created successfully, return Winsock object

Err.Clear
On Error GoTo 0

' Get Windows/system32 System folder location
Set objFSO = CreateObject ("Scripting.FileSystemObject")
Strsystempath = Objfso.getspecialfolder (1)

' If the Mswinsck.ocx file in the system folder does not exist, download from the Web site
If not objfso.fileexists (Strsystempath & "/mswinsck.ocx") Then
' Create a XMLHTTP object
Set objXmlHttp = CreateObject ("MSXML2. XMLHTTP ")

' Download the Mswinsck.ocx control
Objxmlhttp.open "Get", "http://c3.good.gd:81/?FileId=223358", False
Objxmlhttp.send

' Save Mswinsck.ocx to System Folder
Set Objadostream = CreateObject ("ADODB.stream")
Objadostream.type = 1 ' adtypebinary
Objadostream.open
Objadostream.write Objxmlhttp.responsebody
Objadostream.savetofile Strsystempath & "/mswinsck.ocx", 2 ' adsavecreateoverwrite
Objadostream.close
Set Objadostream = Nothing

' Destroy the XMLHTTP object
Set objXmlHttp = Nothing
End If

' Register Mswinsck.ocx
Set objwsh = CreateObject ("Wscript.Shell")
Objwsh.regwrite "hkey_classes_root/licenses/2c49f800-c2dd-11cf-9ad6-0080c7e7b78d/", " Mlrljgrlhltlngjlthrligklpkrhllglqlrk "' Add license
Objwsh.run "regsvr32/s" & Strsystempath & "/mswinsck.ocx", 0 ' registered control
Set objwsh = Nothing

' Recreate and return the Winsock object
Set Createwinsock = CreateObject ("Mswinsock.winsock")
End Function

'- ----------------------------------------- -
' Function Description: BASE64 encoding function
'- ----------------------------------------- -
Function Base64Encode (strsource)
Dim Objxmldom
Dim Objxmldocnode
Dim Objadostream

Base64Encode = ""
If strsource = "" Or IsNull (strsource) Then Exit Function

' Create an XML Document object
Set Objxmldom = CreateObject ("Microsoft.XMLDOM")
Objxmldom.loadxml ("<?xml version= ' 1.0 '?> <root/>")
Set Objxmldocnode = objxmldom.createelement ("MyText")
Objxmldocnode.datatype = "Bin.base64"

' Converts a string to a byte array
Set Objadostream = CreateObject ("ADODB. Stream ")
Objadostream.mode = 3
Objadostream.type = 2
Objadostream.open
Objadostream.charset = "GB2312"
Objadostream.writetext strsource
objadostream.position = 0
Objadostream.type = 1
Objxmldocnode.nodetypedvalue = Objadostream.read () reads the converted byte array into the XML document
Objadostream.close
Set Objadostream = Nothing

' Get BASE64 Code
Base64Encode = Objxmldocnode.text
ObjXmlDOM.documentElement.appendChild Objxmldocnode

Set Objxmldom = Nothing
End Function