問題:
公司有一Web系統需開放給香港Office公司查詢資料,但最近動態域名需實名認證,
因系統較小型,非公開大範圍使用,所以再認證一域名也沒多大必要,
所以想定時生成一封能查詢外網IP的郵件發送給相關同事。
方案:
1.新建一個VBS文件用來獲取IP和發送郵件:
1 On Error Resume next 2 3 Set objEmail=CreateObject("CDO.Message") 4 5 Call SendMail() 6 7 Sub SendMail 8 Url="http://www.ip138.com/ips1388.asp" ‘https://www.baidu.com/s?wd=ip 9 Set NP = Createobject("Microsoft.XMLHTTP") 10 NP.Open "GET", url, False 11 NP.Send 12 Data=NP.responsebody 13 Set NP = Nothing 14 Data = bytes2BSTR(Data) 15 Here = InstrRev(Data, "ip138.com IP", -1,0) 16 Data = Mid(Data,Here+83,17) 17 Data = Replace(Data, "[","") 18 Data = Replace(Data, "]","") 19 Data = Replace(Data, " ","") 20 Data="This mail send from : " & Data & "." & vbcrlf & "You may use this: http://" & Data & ":8080/MISWeb" & vbCrlf & "Bruce " & Now & vbCrlf 21 ‘WSH.Echo Data 22 23 objEmail.From="[email protected]" ‘Sender 24 objEmail.To="[email protected]" ‘Receiver:[email protected] 25 objEmail.Subject="This Mail Only used to Get CCL Factory IP" ‘Subject 26 objEmail.Textbody=Data 27 CreateObject("Scripting.FileSystemObject").OpenTextFile("CCLFactoryIP.txt",8,1) _ 28 .Write Data 29 ‘WSH.Echo Now & ": " & Data 30 objEmail.Configuration.Fields.Item _ 31 ("http://schemas.microsoft.com/cdo/configuration/sendusing")=2 32 objEmail.Configuration.Fields.Item _ 33 ("http://schemas.microsoft.com/cdo/configuration/smtpserver")="ppp.com" ‘SMTP Server Address 34 objEmail.Configuration.Fields.Item _ 35 ("http://schemas.microsoft.com/cdo/configuration/sendusername")="qqq" ‘Username 36 objEmail.Configuration.Fields.Item _ 37 ("http://schemas.microsoft.com/cdo/configuration/sendpassword")="zzz" ‘Password 38 objEmail.Configuration.Fields.Item _ 39 ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")=1 ‘Password use Text 40 objEmail.Configuration.Fields.Item _ 41 ("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=25 ‘Smtp Port 42 objEmail.Configuration.Fields.Update 43 objEmail.Send 44 End Sub 45 Function bytes2BSTR(vIn) 46 strReturn = "" 47 For i = 1 To LenB(vIn) 48 ThisCharCode = AscB(MidB(vIn,i,1)) 49 If ThisCharCode < &H80 Then 50 strReturn = strReturn & Chr(ThisCharCode) 51 Else 52 NextCharCode = AscB(MidB(vIn,i+1,1)) 53 strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode)) 54 i = i + 1 55 End If 56 Next 57 bytes2BSTR = strReturn 58 End Function
2.在Win系統設置定時任務:
Win10: 開始->Windows管理工具->任務計劃程序,操作->創建基本任務,輸入名稱,設定每周一到周五8:58開始,每一小時運行一次,持續8小時。
3.測試完全OK。
【轉載請註明來源】
时间: 2024-10-01 21:25:02