asp定时自动查询自己的外网ip并发送到邮箱【邮件的使用的组件是jmail】

来源：互联网发布：读梦里花落知多少有感编辑：程序博客网时间：2024/04/30 08:18

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>

　　<html>

　　<head>

　　<meta content="text/html; charset=gb2312" http-equiv="content-type">

　　<Meta http-equiv="Refresh" Content="3600;">

　　</head>

　　<body>

　　<%

　　'邮件的标题

　　title="【ip】查询的IP为"

　　'邮件的内容

　　ip_string=Reg_tager(GetHttpPage("http://iframe.ip138.com/city.asp"),"<center>([^<]*)</center>")

　　'邮件发送给谁

　　SendTo=""

　　'发送人的登陆邮件用户名

　　Email_user=""

　　'发送人的登陆邮箱密码

　　Email_password=""

　　'邮件服务器SMTP地址

　　smtp="smtp.qq.com"

　　response.Write("这一次发送Email的时间是："now()&"<br>"ip_string)

　　email_send(title,ip_string,SendTo,Email_user,Email_password,smtp)

　　%>

　　</body>

　　</html>

　　<%

　　'==================================================

　　'函数名：GetHttpPage

　　'作用：获取网页源码

　　'参数：HttpUrl ------网页地址

　　'==================================================

　　Function GetHttpPage(HttpUrl)

　　If IsNull(HttpUrl)=True Or Len(HttpUrl)<18 Or HttpUrl="$False$" Then

　　GetHttpPage="$False$"

　　Exit Function

　　End If

　　Dim Http

　　Set Http=server.createobject("MSXML2.XMLHTTP")

　　Http.open "GET",HttpUrl,False

　　Http.Send()

　　If Http.Readystate<>4 then

　　Set Http=Nothing

　　GetHttpPage="$False$"

　　Exit function

　　End if

　　GetHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")

　　GetHTTPPage=replace(replace(GetHTTPPage , vbCr,""),vbLf,"")

　　Set Http=Nothing

　　If Err.number<>0 then

　　Err.Clear

　　End If

　　End Function

　　'==================================================

　　'函数名：BytesToBstr

　　'作用：将获取的源码转换为中文

　　'参数：Body ------要转换的变量

　　'参数：Cset ------要转换的类型

　　'==================================================

　　Function BytesToBstr(Body,Cset)

　　Dim Objstream

　　Set Objstream = Server.CreateObject("adodb.stream")

　　objstream.Type = 1

　　objstream.Mode =3

　　objstream.Open

　　objstream.Write body

　　objstream.Position = 0

　　objstream.Type = 2

　　objstream.Charset = Cset

　　BytesToBstr = objstream.ReadText

　　objstream.Close

　　set objstream = nothing

　　End Function

　　'==================================================

　　'函数名：过滤规则

　　'作用：过滤标签取所要的内容

　　'参数：Body ------要转换的变量

　　'==================================================

　　Function Reg_tager(body,rul)

　　Dim RegEx

　　Set RegEx = New RegExp

　　RegEx.IgnoreCase = true

　　RegEx.Global = True

　　RegEx.Pattern = rul

　　If Regex.test(body) then

　　Dim Matches

　　Set Matches = RegEx.Execute(body) ' 执行搜索。

　　For Each Match in Matches ' 遍历匹配集合。

　　RetStr = RetStr & Match.SubMatches(0) '只取src

　　Next

　　Reg_tager= RetStr

　　End If

　　Set RegEx=Nothing

　　End Function

　　'==================================================

　　'函数名：发送邮件

　　'作用：过滤标签取所要的内容

　　'参数：Body ------要转换的变量

　　'==================================================

　　function email_send(title,body,SendTo,Email_user,Email_password,smtp)

　　Email = SendTo       ''收件人Email

　　Set jmail = Server.CreateObject("JMAIL.Message")    '建立发送邮件的对象

　　jmail.silent = false                          '屏蔽例外错误，返回FALSE跟TRUE两值

　　jmail.logging = true                          '启用邮件日志

　　jmail.Charset = "GB2312"                      '邮件的文字编码为国标

　　jmail.ContentType = "text/html"               '邮件的格式为HTML格式

　　jmail.AddRecipient Email                      '邮件收件人的地址

　　jmail.From = Email_user                 '发件人的E-MAIL地址

　　jmail.MailServerUserName = Email_user   '登录邮件服务器所需的用户名

　　jmail.MailServerPassword = Email_password             '登录邮件服务器所需的密码

　　jmail.Subject = title                   '邮件的标题

　　jmail.Body = body                  '邮件的内容

　　jmail.Priority = 1                            '邮件的紧急程序，为最快，为最慢，3 为默认值

　　jmail.Send(smtp)                  '执行邮件发送（通过邮件服务器地址）。请修改成你的邮件服务器SMTP地址

　　jmail.Close()                                 '关闭对象

　　end function

　　%>