Use vbs to obtain the Internet ip address and send it to the mailbox. vbsip

Use vbs to obtain the Internet ip address and send it to the mailbox. vbsip

Get the local Internet address and send it to the specified mailbox, you can also refer to this article http://www.bkjia.com/article/40064.htm

Copy codeThe Code is as follows:
'*************************************** ***
'* Program name: GetIP. vbs
'* Program description: Get the local Internet address and send it to the specified mailbox
'* Encoding: lyserver
'*************************************** ***

Option Explicit

Call Main 'execution entry function

'-------------------------------------------
'Function Description: program entry
'-------------------------------------------
Sub Main ()
Dim ob1_sh
Dim objEnv
Dim strNewIP, strOldIP
Dim dtStartTime
Dim nInstance

StrOldIP = ""
DtStartTime = DateAdd ("n",-30, Now) 'set the start time

'Obtain the number of running instances. If the value is greater than 1, the previous running instances are terminated.
Set ob1_sh = CreateObject ("WScript. Shell ")
Set objEnv = CreateObject ("WScript. Shell"). Environment ("System ")
NInstance = Val (objEnv ("GetIpToEmail") + 1' Number of running instances plus 1
ObjEnv ("GetIpToEmail") = nInstance
If nInstance> 1 Then Exit Sub 'Exit If the number of running instances is greater than 1 to prevent repeated running

'Enable Remote Desktop
'Enablesdrometedesktop True, Null

'The Internet address is continuously detected in the background. If there is any change, an email is sent to the specified mailbox.
Do
If Err. Number <> 0 Then Exit Do
If DateDiff ("n", dtStartTime, Now)> = 30 then', check the IP address once every 30 minutes.
DtStartTime = Now 'reset Start Time
StrNewIP = GetWanIP get the local public IP Address
If Len (strNewIP)> 0 Then
If strNewIP <> strOldIP Then 'is sent If the IP address changes
SendMail "sender's email address @ sina.com", "password", "recipient's email address @ sina.com", "router IP Address", strNewIP 'sends an IP address to the specified email address
StrOldIP = strNewIP 'reset the original IP Address
End If
End If
End If
WScript. Sleep 2000 latency 2 seconds to release CPU resources
Loop Until Val (objEnv ("GetIpToEmail")> 1
ObjEnv. Remove "GetIpToEmail" 'clear the number of running instances variable
Set objEnv = Nothing
Set ob1_sh = Nothing

MsgBox "program is successfully terminated! ", 64," prompt"
End Sub

'-------------------------------------------
'Function Description: Enable Remote Desktop
'Parameter description: whether blnEnabled is enabled, True is enabled, and False is disabled.
'Nport Remote Desktop port number. The default value is 3389.
'-------------------------------------------
Sub EnabledRometeDesktop (blnEnabled, nPort)
Dim ob1_sh

If blnEnabled Then
BlnEnabled = 0' 0 indicates Enabled
Else
BlnEnabled = 1' 1 indicates disabled
End If

Set ob1_sh = CreateObject ("WScript. Shell ")
'Enable Remote Desktop and set the port number.
Ob1_sh. RegWrite "HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Control/Terminal Server/fDenyTSConnections", blnEnabled, "REG_DWORD" 'enable remote desktop
'Set the Remote Desktop port number
If IsNumeric (nPort) Then
If nPort> 0 Then
Ob1_sh. RegWrite "HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Control/Terminal Server/Wds/rdpwd/Tds/tcp/PortNumber", nPort, "REG_DWORD"
Ob1_sh. RegWrite "HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Control/Terminal Server/WinStations/RDP-Tcp/PortNumber", nPort, "REG_DWORD"
End If
End If
Set ob1_sh = Nothing
End Sub

'-------------------------------------------
'Function Description: Obtain the public IP Address
'-------------------------------------------
Function GetWanIP ()
Dim nPos
Dim objXmlHTTP

GetWanIP = ""
On Error Resume Next
'Create an XMLHTTP object
Set objXmlHTTP = CreateObject ("MSXML2.XMLHTTP ")

'Navigate to http://www.ip138.com/ip2city.asp?ip address
ObjXmlHTTP. open "GET", "http://iframe.ip138.com/ic.asp", False
ObjXmlHTTP. send

'Extract the IP address string from 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 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 an email
'Parameter Description: strEmailFrom: sender's email address
'Strpassword: the sender's email password.
'Stremailto: Recipient's email address
'Strsubject: Mail title
'Strtext: Mail 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 legitimacy
If nPos = 0 Or InStr (strEmailTo, "@") = 0 Or Len (strText) = 0 Or Len (strPassword) = 0 Then Exit Function
'Get the email account by email name
StrUsername = Trim (Left (strEmailFrom, nPos-1 ))
'Obtain the ESMTP server name based on the sender's email address.
StrSmtpServer = "smtp." & Trim (Mid (strEmailFrom, nPos + 1 ))

'Assemble the 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
StrEML = strEML & Base64Encode (strText)
StrEML = strEML & vbCrLf & "." & vbCrLf

'Connect to the mail service and cry
ObjSock. Connect strSmtpServer, 25

'Wait until the connection is successful
For I = 1 To 10
If objSock. State = sckConnected Then Exit
WScript. Sleep 200
Next

If objSock. State = sckConnected Then
'Prepare to send the email
SendCommand objSock, "EHLO VBSEmail"
SendCommand objSock, "auth login" 'apply for an SMTP session
SendCommand objSock, Base64Encode (strUsername)
SendCommand objSock, Base64Encode (strPassword)
SendCommand objSock, "mail from:" & strEmailFrom 'sender
SendCommand objSock, "rcpt to:" & strEmailTo 'recipient
SendCommand objSock, "DATA" 'is the mail content below

'Send email
SendCommand objSock, strEML

'End email sending
SendCommand objSock, "QUIT"
End If

'Disconnect
ObjSock. Close
WScript. Sleep 200
Set objSock = Nothing
End Function

'-------------------------------------------
'Function Description: Auxiliary Function of SendMail
'-------------------------------------------
Function SendCommand (objSock, strCommand)
Dim I
Dim strEcho

On Error Resume Next
ObjSock. SendData strCommand & vbCrLf
For I = 1 To 50' wait For the result
WScript. Sleep 200
If objSock. BytesReceived> 0 Then
ObjSock. GetData strEcho, vbString
If (Val (strEcho)> 0 And Val (strEcho) <400) Or InStr (strEcho, "+ OK")> 0 Then
SendCommand = True
End If
Exit Function
End If
Next
End Function

'-------------------------------------------
'Function Description: Creates a Winsock object. If a Winsock object fails, it is downloaded and registered before being created.
'-------------------------------------------
Function CreateWinsock ()
Dim ob1_sh
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 'is created successfully, the Winsock object is returned.

Err. Clear
On Error GoTo 0

'Get the 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 it from the website
If Not objFSO. FileExists (strSystemPath & "/mswinsck. ocx") Then
'Create an 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 the 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 XMLHTTP object
Set objXmlHTTP = Nothing
End If

'Register MSWinsck. ocx
Set ob1_sh = CreateObject ("WScript. Shell ")
Ob1_sh. RegWrite "HKEY_CLASSES_ROOT/Licenses/2c49f800-c2dd-11cf-9ad6-0080c7e7b78d/", "allow" 'Add a license
Ob1_sh. Run "regsvr32/s" & strSystemPath & "/mswinsck. ocx", 0' register the control
Set ob1_sh = 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"

'Convert string to 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 () 'read the converted byte array to the XML document.
ObjAdoStream. Close
Set objAdoStream = Nothing

'Get BASE64 encoding
Base64Encode = objXmlDocNode. Text
ObjXmlDOM.doc umentElement. appendChild objXmlDocNode

Set objXmlDOM = Nothing
End Function

Obtain the Internet ip address using a vbs script

'Token generation verification code when starting verification when starting Verification
On error resume next
Set ie = CreateObject ("internetexplorer. application ")
Ie. navigate ("www.ip138.com/ip2city.asp ")
Ie. Visible = False
While ie. busy Or ie. readystate <> 4
WEnd
Set regEx = New RegExp
RegEx. Pattern = "\ d. * \ d"
Set Matches = regEx.Execute(ie.doc ument. body. innerhtml)
Ie. quit
For Each Match in Matches
RetStr = Match. Value
Next
Msgbox "Internet IP:" & RetStr
'Zookeeper generation verification code. When the zookeeper is finished

VBS obtains the Internet ip address and the network is disconnected.

Step 1: copy the following code and save it as vbs

Public Function GetIP
ComputerName = "."
Dim ob1_miservice, colItems, objItem, objAddress
Set ob1_miservice = GetObject ("winmgmts: \" & ComputerName & "\ root \ cimv2 ")
Set colItems = ob1_miservice. ExecQuery ("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True ")
For Each objItem in colItems
For Each objAddress in objItem. IPAddress
If objAddress <> "" then
GetIP = objAddress
Exit Function
End If
Next
Next
End Function

MyIP = "127.0.0.1"
Do
If Not GetIP = MyIP Then
StrNICName = "disable = net pci \*"
Set objShell = CreateObject ("Wscript. Shell ")
StrCommand = "devcon.exe" & strNICName
ObjShell. Run strCommand, 0, False
End If
Wscript. Sleep 3000
Loop

Step 2:
Download from Microsoft Website: download.microsoft.com/...on.exe
Decompress the downloaded file and unlock it! Folder.
Run the vbs file.
I have tested it on my computer and passed it all.

Step 3:
You can add extra points.

If you have any questions, you must answer them!