擷取外網IP並發送到指定郵箱的vbs代碼[已測]

複製代碼 代碼如下:''getIP
set http=createobject("Microsoft.XMLHTTP")
ipp="http://www.ip138.com/ip2city.asp"
http.open "get",ipp,false
http.send
ss=bytes2BSTR(Http.responsebody)
intStrA = InStr(1,ss,"[",1)+1
sss=mid(ss,intStrA)
intStrB = InStr(1,sss,"]",1)-1
ss=mid(ss,intStrA,intStrB)
'wscript.echo ss

Function bytes2BSTR(vIn)
strReturn = ""
For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
If ThisCharCode < &H80 Then
strReturn = strReturn & Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i = i + 1
End If
Next
bytes2BSTR = strReturn
End Function

''SendEmail
NameSpace = "http://schemas.microsoft.com/cdo/configuration/"
Set Email = CreateObject("CDO.Message")
Email.From = "發送郵箱"
Email.To = "接收郵箱"
Email.Subject = "主題"
Email.Textbody = ss&date() 'ss為擷取到的ip
'Email.AddAttachment "附件的路徑例如：C:\foo.zip"
With Email.Configuration.Fields
.Item(NameSpace&"sendusing") = 2
.Item(NameSpace&"smtpserver") = "smtp.163.com" 'smtp伺服器位址
.Item(NameSpace&"smtpserverport") = 25
.Item(NameSpace&"smtpauthenticate") = 1
.Item(NameSpace&"sendusername") = "賬戶名，發送郵箱的"
.Item(NameSpace&"sendpassword") = "密碼"
.Update
End With
Email.Send

注意代碼中的參數設定。