Shulou(Shulou.com)06/03 Report--

This article mainly explains "how to use vbs to get the extranet ip and send it to the mailbox". Interested friends may wish to have a look at it. The method introduced in this paper is simple, fast and practical. Let's let the editor take you to learn "how to use vbs to get the extranet ip and send it to the mailbox".

The copy code is as follows:

'*

'* Program name: GetIP.vbs

'* Program description: obtain the local public network address and send it to the specified mailbox

'* Encoding: 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 running instances. If it is greater than 1, the previously run instances will be terminated.

Set objWsh = 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 runs

'enable remote Desktop

'EnabledRometeDesktop True, Null

'continuously check the public network address in the background, and send an email to the specified mailbox if there is any change

Do

If Err.Number 0 Then Exit Do

If DateDiff ("n", dtStartTime, Now) > = 30 Then 'check IP every half hour

DtStartTime = Now 'reset start time

StrNewIP = GetWanIP 'get the local public network IP address

If Len (strNewIP) > 0 Then

If strNewIP strOldIP Then 'send if the IP has changed

SendMail "sender mailbox @ sina.com", "password", "recipient mailbox @ sina.com", "router IP", strNewIP 'send IP to the specified mailbox

StrOldIP = strNewIP 'reset the original IP

End If

End If

End If

WScript.Sleep 2000 'delay 2 seconds to release CPU resources

Loop Until Val (objEnv ("GetIpToEmail")) > 1

ObjEnv.Remove "GetIpToEmail" 'clears the variable on the number of running instances

Set objEnv = Nothing

Set objWsh = Nothing

MsgBox "Program terminated successfully!", 64, "prompt"

End Sub

'

'function description: open remote Desktop

'Parameter description: whether blnEnabled is enabled, True is enabled, and False is closed

'Port number of nPort remote Desktop, default is 3389

'

Sub EnabledRometeDesktop (blnEnabled, nPort)

Dim objWsh

If blnEnabled Then

BlnEnabled = 0'0 means it is on

Else

BlnEnabled = 1'1 means off

End If

Set objWsh = CreateObject ("WScript.Shell")

'Open the remote Desktop and set the port number

ObjWsh.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

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: obtain 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 to get the 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 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 email

'Parametric description: strEmailFrom: sender's mailbox

'strPassword: the sender's mailbox password

'strEmailTo: recipient's mailbox

'strSubject: message title

'strText: the content of the message

'

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 the integrity and validity of the parameters

If nPos = 0 Or InStr (strEmailTo, "@") = 0 Or Len (strText) = 0 Or Len (strPassword) = 0 Then Exit Function

'get the mailbox account number according to the mailbox name

StrUsername = Trim (Left (strEmailFrom, nPos-1))

'get the ESMTP server name based on the sender's mailbox

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 & vbCrLf

StrEML = strEML & Base64Encode (strText)

StrEML = strEML & vbCrLf & "." & vbCrLf

'Connect to the mail service and cry

ObjSock.Connect strSmtpServer, 25

'wait for the connection to succeed

For I = 1 To 10

If objSock.State = sckConnected Then Exit For

WScript.Sleep 200

Next

If objSock.State = sckConnected Then

'prepare to send an email

SendCommand objSock, "EHLO VBSEmail"

SendCommand objSock, "AUTH LOGIN" 'apply for 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" the following is the content of the email

'send an email

SendCommand objSock, strEML

'end mailbox 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 'waiting 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: create a Winsock object. If it fails, download and register it and then create it.

'

Function CreateWinsock ()

Dim objWsh

Dim objXmlHTTP

Dim objAdoStream

Dim objFSO

Dim strSystemPath

'create and return a Winsock object

On Error Resume Next

Set CreateWinsock = CreateObject ("MSWinsock.Winsock")

If Err.Number = 0 Then Exit Function'is created successfully, and 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 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 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 the XMLHTTP object

Set objXmlHTTP = Nothing

End If

'register for 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 'registration 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 a XML document object

Set objXmlDOM = CreateObject ("Microsoft.XMLDOM")

ObjXmlDOM.loadXML ("")

Set objXmlDocNode = objXmlDOM.createElement ("MyText")

ObjXmlDocNode.dataType = "bin.base64"

'convert 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 the BASE64 code

Base64Encode = objXmlDocNode.Text

ObjXmlDOM.documentElement.appendChild objXmlDocNode

Set objXmlDOM = Nothing

End Function

At this point, I believe you have a deeper understanding of "how to use vbs to get the ip of the public network and send it to the mailbox". You might as well do it in practice. Here is the website, more related content can enter the relevant channels to inquire, follow us, continue to learn!

Welcome to subscribe "Shulou Technology Information " to get latest news, interesting things and hot topics in the IT industry, and controls the hottest and latest Internet news, technology news and IT industry trends.