Vbs obtains the Internet IP address and sends it to the specified mailbox.

Source: Internet
Author: User
Tags email account

After the holiday, I still had some work to do and didn't want to go to the office. So I started the Remote Desktop, but I was afraid that the IP address would change after the network connection was lost. So I wrote this vbs script program. This program obtains the local Internet address (if there is a router, It is the Internet address of the router), automatically downloads and registers mswinsck. OCX Control, Use WinSock to send emails, implement base64 encoding, enable remote desktop service, and regularly run scripts in the background. If you are interested, refer to the code and write comments in detail, we will not describe them here.

In addition, I have some comments, although at the moment. net is widely used, VB6 has become more and more trend, and vbs are also abandoned, but I always think that based on COM core VB, in some tool software development, it has incomparable advantages.

Instructions for use:

1. Use notepad to create a text file and copy the following code.

2. Change the email to a friend's email address and save it as the getip. vbs file.

3. Double-click the getip. vbs file to run it in the background. After double-clicking it again, the running will end.

4. Others: This Code only tests Sina mail, and other email friends modify and test it on their own.

 '*************************************** * ** <Br/> '* program name: getip. vbs <br/> '* program description: Obtain the local Internet address and send it to the specified email address <br/>' * code: lyserver <br/> '* contact information: http://blog.csdn.net/lyserver <br/> '********************************** * ******* </P> <p> Option explicit </P> <p> call main 'execute the entry function </P> <p> '------------------------------------------ -<br/> 'function description: program entry <br/> '-------------------------------------------<br/> sub main () <br/> Dim ob1_sh <br/> dim objenv <br/> dim strnewip, stroldip <br/> dim dtstarttime <br/> dim ninstance </P> <p> stroldip = "" <br/> dtstarttime = dateadd ("N",-30, now) 'set the start time </P> <p>' to obtain the number of running instances. If the value is greater than 1, end the previous running instance <br/> set ob1_sh = Createobject ("wscript. shell ") <br/> set objenv = Createobject (" wscript. shell "). environment ("system") <br/> ninstance = Val (objenv ("getiptoemail") + 1' Number of running instances plus 1 <br/> objenv ("G Etiptoemail ") = ninstance <br/> If ninstance> 1 then exit sub 'exit if the number of running instances is greater than 1, to prevent repeated running </P> <p> 'Enable Remote Desktop <br/> 'enablesdrometedesktop true, null </P> <p> 'checks the Internet address continuously in the background, if there is any change, send the email to the specified email address <br/> DO <br/> If err. number <> 0 Then exit do <br/> If datediff ("N", dtstarttime, now)> = 30 then' check IP address once every 30 minutes <br/> dtstarttime = now 'reset start time <br/> strnewip = getwanip' obtain the Local Public IP address <br/> If Len (strnewip)> 0 then <br/> If Str Newip <> stroldip then' if the IP address changes, send <br/> Sendmail "sender's email @ Sina.com", "password", "recipient's email @ Sina.com ", "vro IP ", strnewip 'send IP address to specified mailbox <br/> stroldip = strnewip' Reset Original IP address <br/> end if <br/> wscript. sleep 2000 'latency 2 seconds to release CPU resources <br/> loop until Val (objenv ("getiptoemail")> 1 <br/> objenv. remove "getiptoemail" 'clear the variable number of running instances <br/> set objenv = nothing <br/> set ob1_sh = nothing </P> <p> msgbox "The program is successfully terminated! ", 64," prompt "<br/> end sub </P> <p> '-------------------------------------------<br/>' function description: enable remote desktop <br/> 'parameter description: whether blnenabled is enabled, true is enabled, and false is disabled <br/> 'nport Remote Desktop port number, default Value: 3389 <br/> '-----------------------------------------<br/> sub enabledrometedesktop (blnenabled, nport) <br/> dim ob1_sh </P> <p> If blnenabled then <br/> blnenabled = 0' 0 indicates that else is enabled <br/> blnenabled = 1' 1 indicates disabling <br/> end if </P> <p> Se T ob1_sh = Createobject ("wscript. shell ") <br/> 'enable remote desktop and set the port number <br/> ob1_sh. regwrite "HKEY_LOCAL_MACHINE/system/CurrentControlSet/control/Terminal Server/fdenytsconnections", blnenabled, "REG_DWORD" 'enable remote desktop <br/>' set the Remote Desktop port number <br/> If isnumeric (nport) Then <br/> If nport> 0 then <br/> ob1_sh. regwrite "HKEY_LOCAL_MACHINE/system/CurrentControlSet/control/Terminal Server/WDS/rdpwd/tDS/tcp/portnumber", n Port, "REG_DWORD" <br/> ob1_sh. regwrite "HKEY_LOCAL_MACHINE/system/CurrentControlSet/control/Terminal Server/winstations/RDP-TCP/portnumber", nport, "REG_DWORD" <br/> end if <br/> set ob1_sh = nothing <br/> end sub </P> <p> '------------------------------------------- <br/> 'function description: obtain the public IP address <br/> '-----------------------------------------<br/> function getwanip () <br/> dim NPOs <br/> dim Objxmlhttp </P> <p> getwanip = "" <br/> on error resume next <br/> 'create an XMLHTTP object <br/> set objxmlhttp = Createobject ("msxml2.xmlhttp") </P> <p> 'navigate to http://www.ip138.com/ip2city.asp?ip address <br/> objxmlhttp. open "get", "http://www.ip138.com/ip2city.asp", false <br/> objxmlhttp. send </P> <p> 'extract the IP address string in HTML <br/> NPOs = instr (objxmlhttp. responsetext, "[") <br/> If NPOs> 0 then <br/> getwanip = mid (objxmlh TTP. responsetext, NPOs + 1) <br/> NPOs = instr (getwanip, "]") <br/> If NPOs> 0 then getwanip = trim (left (getwanip, NPOs-1 )) <br/> end if </P> <p> 'Destroy an XMLHTTP object <br/> set objxmlhttp = nothing <br/> end function </P> <p> '- ----------------------------------------<br/> 'function description: convert string to numeric value <br/> '-------------------------------------------<br/> function Val (vnum) <br/> If isnumeric (vnum) Then <br/> Val = Cdbl (vnum) <br/> else <br/> val = 0 <br/> end if <br/> end function </P> <p> '-----------------------------------------<br/>' function Description: send email <br/> 'parameter description: stremailfrom: sender email <br/> 'strpassword: sender email password <br/> 'stremailto: recipient email <br/> 'strsubject: email title <br/> 'strtext: email content <br/> '-------------------------------------------<br/> function Sendmail (stremailfrom, strpassword, stremailto, strsubject, strtext) <B R/> dim I, NPOs <br/> dim strusername <br/> dim strsmtpserver <br/> dim objsock <br/> dim streml <br/> const sckconnected = 7 </P> <p> set objsock = createwinsock () <br/> objsock. protocol = 0 </P> <p> NPOs = instr (stremailfrom ,"@") <br/> 'verify parameter integrity and legitimacy <br/> If NPOs = 0 or instr (stremailto, "@") = 0 or Len (strtext) = 0 or Len (strpassword) = 0 Then exit function <br/> 'obtain the email account based on the email name. <br/> strusername = Trim (left (stremailfrom, NPOs-1) <br/> 'obtain the ESMTP server name from the sender's email address. <br/> strsmtpserver = "SMTP. "& trim (mid (stremailfrom, NPOs + 1) </P> <p> 'Assemble the email <br/> streml =" mime-version: 1.0 "& vbcrlf <br/> streml = streml &" from: "& stremailfrom & vbcrlf <br/> streml = streml &": "& stremailto & vbcrlf <br/> streml = streml &" Subject: "&" =? Gb2312? B? "& Base64encode (strsubject )&"? = "& Vbcrlf <br/> streml = streml &" Content-Type: text/plain; "& vbcrlf <br/> streml = streml &" content-transfer-encoding: base64 "& vbcrlf <br/> streml = streml & base64encode (strtext) <br/> streml = streml & vbcrlf &". "& vbcrlf </P> <p> 'connect to the mail service and cry <br/> objsock. connect strsmtpserver, 25 </P> <p> 'Wait until the connection is successful <br/> for I = 1 to 10 <br/> If objsock. state = sckconnected then exit for <br/> wscrip T. sleep 200 <br/> next </P> <p> If objsock. state = sckconnected then <br/> 'prepare to send an email <br/> sendcommand objsock, "ehlo vbsemail" <br/> sendcommand objsock, "auth login" 'applies for SMTP sessions <br/> sendcommand objsock, base64encode (strusername) <br/> sendcommand objsock, base64encode (strpassword) <br/> sendcommand objsock, "mail from:" & stremailfrom 'sender <br/> sendcommand objsock, "rcpt to:" & stremailto' recipient <br /> Sendcommand objsock, "data" 'The following is the email content </P> <p>' send an email <br/> sendcommand objsock, streml </P> <p> 'End email sending <br/> sendcommand objsock, "quit" <br/> end if </P> <p> 'disconnected <br/> objsock. close <br/> wscript. sleep 200 <br/> set objsock = nothing <br/> end function </P> <p> '-----------------------------------------<br/>' function description: auxiliary Functions of sendmail <br/> '---------------------------------------------<br/> function se Ndcommand (objsock, strcommand) <br/> dim I <br/> dim strecho </P> <p> on error resume next <br/> objsock. senddata strcommand & vbcrlf <br/> for I = 1 to 50' wait for the result <br/> wscript. sleep 200 <br/> If objsock. bytesreceived> 0 then <br/> objsock. getdata strecho, vbstring <br/> If (Val (strecho)> 0 and Val (strecho) <400) or instr (strecho, "+ OK")> 0 then <br/> sendcommand = true <br/> end if <br/> exit Fu Nction <br/> end if <br/> next <br/> end function </P> <p> '-----------------------------------------<br/>' function description: create a Winsock object. If it fails, download and register it, and then create <br/> '-------------------------------------<br/> function createwinsock () <br/> dim ob1_sh <br/> dim objxmlhttp <br/> dim objadostream <br/> dim objfso <br/> dim strsystempath </P> <p> 'create and returns the Winsock object <br/> on error resume next <br/> set createwinsock = Createobject ("mswinsock. winsock ") <br/> If err. number = 0 Then exit function' is created successfully, and the Winsock object </P> <p> err. clear <br/> on error goto 0 </P> <p> 'obtain the location of the Windows/system32 system folder. <br/> set objfso = Createobject ("scripting. fileSystemObject ") <br/> strsystempath = objfso. getspecialfolder (1) </P> <p> 'If mswinsck is in the system folder. if the ocx file does not exist, download it from the website <br/> if not objfso. fileexists (strsystempath & "/mswinsck. OCX ") Then <br/> 'create X Mlhttp object <br/> set objxmlhttp = Createobject ("msxml2.xmlhttp") </P> <p> 'download mswinsck. OCX Control <br/> objxmlhttp. open "get", "http://c3.good.gd: 81 /? Fileid = 223358 ", false <br/> objxmlhttp. send </P> <p> 'sets mswinsck. save OCX to the system folder <br/> set objadostream = Createobject ("ADODB. stream ") <br/> objadostream. type = 1 'adtypebinary <br/> objadostream. open <br/> objadostream. write objxmlhttp. responsebody <br/> objadostream. savetofile strsystempath & "/mswinsck. OCX ", 2 'adsavecreateoverwrite <br/> objadostream. close <br/> set objadostream = nothing </P> <p> 'Destroy XM Lhttp object <br/> set objxmlhttp = nothing <br/> end if </P> <p> 'register mswinsck. OCX <br/> set ob1_sh = Createobject ("wscript. shell ") <br/> ob1_sh. regwrite "hkey_classes_root/licenses/secrets/", "mlrljgrlhltlngjlthrligklpkrhllglqlrk" 'Add a license <br/> ob1_sh. run "regsvr32/s" & strsystempath & "/mswinsck. OCX ", 0' register the Control <br/> set ob1_sh = nothing </P> <p> 're-create and return the Winsock object <br/> set Cre Atewinsock = Createobject ("mswinsock. winsock ") <br/> end function </P> <p> '-------------------------------------------<br/>' function description: base64 encoding function <br/> '-------------------------------------------<br/> function base64encode (strsource) <br/> dim objxmldom <br/> dim objxmldocnode <br/> dim objadostream </P> <p> base64encode = "" <br/> If strsource = "" Or isnull (strsource) then exit function </P> <p> 'create XML Document Object <br/> set objxmldom = Createobject ("Microsoft. xmldom") <br/> objxmldom. loadxml ("<? XML version = '1. 0'?> <Root/> ") <br/> set objxmldocnode = objxmldom. createelement ("mytext") <br/> objxmldocnode. datatype = "bin. base64 "</P> <p> 'converts a string to a byte array <br/> set objadostream = Createobject (" ADODB. stream ") <br/> objadostream. mode = 3 <br/> objadostream. type = 2 <br/> objadostream. open <br/> objadostream. charset = "gb2312" <br/> objadostream. writetext strsource <br/> objadostream. position = 0 <br/> objadostream. type = 1 <br/> objxmldocnode. nodetypedvalue = objadostream. read () 'reads the converted byte array into the XML file <br/> objadostream. close <br/> set objadostream = nothing </P> <p> 'to obtain base64 encoding <br/> base64encode = objxmldocnode. text <br/> objxmldom.doc umentelement. appendchild objxmldocnode </P> <p> set objxmldom = nothing <br/> end Function

Related Article

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.