复制代码 代码如下:

Function GetIPAddress()

Dim Flag, Source

Set GetIPObj = WScript.GetObject("http://ipseeker.cn//")

Flag = 0

For i=1 To 10

If GetIPObj.readyState = "complete" Then

Flag=1

Exit For

End If

WScript.Sleep 500

Next

If Flag = 0 Then

GetIPAddress = "Get IP Address Time Out ..."

Else

Source = GetIPObj.documentElement.innerText

Set Rep = New RegExp

Rep.Pattern="(d+).(d+).(d+).(d+)"

For Each result in Rep.Execute(Source)

GetIPAddress = result

Exit For

Next

End If

End Function

Function MailTo(MailAddress)

Dim NameSpace, MailObject

NameSpace = "http://schemas.microsoft.com/cdo/configuration/"

Set MailObject = CreateObject("CDO.Message")

MailObject.From = "*****@21cn.com"

MailObject.To = MailAddress

MailObject.Subject = "IP Address Information"

MailObject.Textbody = Now & ": " & GetIPAddress()

MailObject.Configuration.Fields.Item(NameSpace & "sendusing") = 2

MailObject.Configuration.Fields.Item(NameSpace & "smtpserver") = "smtp.21cn.com"

MailObject.Configuration.Fields.Item(NameSpace & "smtpserverport") = 25

MailObject.Configuration.Fields.Item(NameSpace & "smtpauthenticate") = 1

MailObject.Configuration.Fields.Item(NameSpace & "sendusername") = "*****"

MailObject.Configuration.Fields.Item(NameSpace & "sendpassword") = "*****"

MailObject.Configuration.Fields.Update

MailObject.Send

End Function

MailTo ("******@qq.com")

原文：http://www.enun.net/?p=1199