問題:

公司有一Web系統需開放給香港Office公司查詢資料,但最近動態域名需實名認證,

因系統較小型,非公開大範圍使用,所以再認證一域名也沒多大必要,

所以想定時生成一封能查詢外網IP的郵件發送給相關同事。

方案:

1.新建一個VBS文件用來獲取IP和發送郵件:

 On Error Resume next

 Set objEmail=CreateObject("CDO.Message")

 Call SendMail()

 Sub SendMail
Url="http://www.ip138.com/ips1388.asp" 'https://www.baidu.com/s?wd=ip
Set NP = Createobject("Microsoft.XMLHTTP")
NP.Open "GET", url, False
NP.Send
Data=NP.responsebody
Set NP = Nothing
Data = bytes2BSTR(Data)
Here = InstrRev(Data, "ip138.com IP", -,)
Data = Mid(Data,Here+,)
Data = Replace(Data, "[","")
Data = Replace(Data, "]","")
Data = Replace(Data, " ","")
Data="This mail send from : " & Data & "." & vbcrlf & "You may use this: http://" & Data & ":8080/MISWeb" & vbCrlf & "Bruce " & Now & vbCrlf
'WSH.Echo Data objEmail.From="[email protected]" 'Sender
objEmail.To="[email protected]" 'Receiver:[email protected]
objEmail.Subject="This Mail Only used to Get CCL Factory IP" 'Subject
objEmail.Textbody=Data
CreateObject("Scripting.FileSystemObject").OpenTextFile("CCLFactoryIP.txt",,) _
.Write Data
'WSH.Echo Now & ": " & Data
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing")=
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver")="ppp.com" 'SMTP Server Address
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername")="qqq" 'Username
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword")="zzz" 'Password
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")= 'Password use Text
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport")= 'Smtp Port
objEmail.Configuration.Fields.Update
objEmail.Send
End Sub
Function bytes2BSTR(vIn)
strReturn = ""
For i = To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,))
If ThisCharCode < &H80 Then
strReturn = strReturn & Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn,i+,))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i = i +
End If
Next
bytes2BSTR = strReturn
End Function

2.在Win系統設置定時任務:

Win10: 開始->Windows管理工具->任務計劃程序,操作->創建基本任務,輸入名稱,設定每周一到周五8:58開始,每一小時運行一次,持續8小時。

3.測試完全OK。

【轉載請註明來源】

05-11 09:32