Code
<%
@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<!--#include file="conn.asp"-->
<html>
<head>
<title>收邮件</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<style>
#layGet {}{
position:absolute;
left:0px;
top:0px;
width:100%;
height:100%;
z-index:1;
background-color: #ffffff;
}
body,td,th {}{
font-size: 12px;
}
.STYLE1 {}{color: #0000FF}
.STYLE2 {}{color: #FF0000}
</style>
</head>
<body>
<div id="layGet">
<p> </p>
<p> </p>
<p> </p>
<p> </p>
<p> </p>
<table align="center" border="1" bordercolor="#99CCFF">
<tr>
<td>
<table width=100 border=0 align=center cellpadding=0 cellspacing=0 bgcolor=#E6F2FF>
<tr>
<td>
<p align=center><img src=images/loader.gif width=216 height=19></p>
<p align=center id="toptip">正在连接服务器，请稍候……</p>
</td>
</tr>
<tr>
<td id="nowid" align=center>
</td>
</tr>
</table>
</td>
</tr>
</table>
</div>
</body>
</html>
<%
on error resume next
Server.scriptTimeout=1500
Response.flush() '输出缓冲区内容
'---------将附件存储到本地服务器------------------
Sub getAttachments(J)
Dim Path,AT,separator,i,iPath,Att,POP,Re
Set POP = Server.CreateObject("JMail.POP3")
POP.Connect id(0),Session("mailpassword"),Session("pop")
POP.Timeout=1500
FileName=""
FileUrl=""
ReTo=""
ReCC=""
Set Att = POP.Messages.Item(J).Attachments
separator = ","
if Att.Count>0 then
For i = 0 To Att.Count-1
If i = Att.Count-1 Then
separator = ""
End If
Set AT = Att.item(i)
if AT.Name<>".msg" then
iPath=Server.Mappath("downLoadfile") & "\" & AT.Name
AT.SaveToFile(iPath)
FileUrl = FileUrl & Path & AT.Name & separator
FileName = FileName & AT.Name & separator
else
if MSGHTMLBody="" then
MSGHTMLBody=AT.data
end if
end if
Next
end if
'--------------收件人------------
Set Recipients = POP.Messages.Item(J).Recipients
separator = ","
For i = 0 To Recipients.Count - 1
If i = Recipients.Count - 1 Then
separator = ""
End If
Set Re = Recipients.item(i)
If Re.ReType = 0 Then
if ReTo<>"" then
ReTo=ReTo & ","
end if
ReTo = ReTo & Re.EMail
else
if ReCC<>"" then
ReCC=ReCC & ","
end if
ReCC = ReCC & Re.EMail
End If
Next
Set Re=Nothing
Set Recipients=Nothing
'---------------------------------
Set AT=Nothing
Set Att=Nothing
POP.Disconnect
Set POP=Nothing
End Sub
Function LongSpaceStr() ''制造一个长空字符串
LongSpaceStr = ""
For i=1 To 256
LongSpaceStr = LongSpaceStr& " "
Next
End Function
Sub StoreToMail() '保存至数据库中，以便显示
rs.addnew()
rs("SendMail")=MSGFrom
rs("SendMailName")=MSGFromName
rs("AcceptMail")=ReTo
rs("CopyMail")=ReCC
if Subject<>"" then
rs("MailTitle")=Subject
else
rs("MailTitle")="无"
end if
if MSGHTMLBody="" then
rs("MailBody")=replace(MSGBody,chr(10),"<br>")
else
rs("MailBody")=MSGHTMLBody
end if
rs("FileUrl")=FileUrl
rs("FileName")=FileName
rs("SendAcceptTime")=AcceptTime
rs("owner")=Session("user")
rs("Priority")=vPriority
rs.update()
End Sub
Sub StoreToGeted() '保存收取记录，以便下次收取时查询是否已收取
set rs1=server.createobject("adodb.recordset")
rs1.open "select * from geted",conn,1,3,1
rs1.addnew()
rs1("owner")=Session("user")
rs1("UID")=tUID
rs1.update()
rs1.close
set rs1=nothing
End Sub
Function CheckGeted(nUID) '查询已收
set rs2=server.createobject("adodb.recordset")
if nUID<>"" then
sqlStr="select * from geted where UID='" & nUID & "' and owner='" & Session("user") & "'"
rs2.open sqlStr,conn,1,1,1
if not rs2.eof then
CheckGeted = true
else
CheckGeted=false
end if
rs2.close
set rs2=nothing
end if
End Function
Sub EndGet()
rs.close
Set Attachments=Nothing
Set TheMsg=Nothing
POP3.Disconnect
Set POP3=Nothing
response.write(LongSpaceStr & "<script language=javascript>window.location.href='main.asp';</script>")
Response.flush() '输出缓冲区内容
end Sub
'------------------------------------------------------------------------------------------------------------------------------开始收取邮件
if Session("user") ="" then
response.write "请先登陆！"
else
id = split(Session("mailusername"), "@", -1, 1) '分割出帐户
Dim POP3,J
'------------------------
Set POP3 = Server.CreateObject("JMail.POP3")
POP3.Connect id(0),Session("mailpassword"),Session("pop")
POP3.Timeout=1500
set rs=server.createobject("adodb.recordset")
rs.open "select * from mail",conn,1,3,1
if pop3.count>0 then
Dim Subject,MSGBody,MSGHTMLBody,MSGFrom,MSGFromName,ReTo,ReCC,FileUrl,FileName,AcceptTime,vPriority,tUID
for J=1 to pop3.count
Set tMail = POP3.Messages.Item(J)
tUID=POP3.GetMessageUID(J)
if CheckGeted(tUID) then
Call EndGet
end if
Subject=tMail.Subject '邮件主题
MSGFrom=tMail.From '发件人邮箱
MSGFromName=tMail.FromName '发件人
MSGBody=tMail.Body '纯文本内容
MSGHTMLBody=tMail.HTMLBody '超文本内容
MSGBody=Trim(MSGBody)
MSGHTMLBody=Trim(MSGHTMLBody)
if tMail.Date<>"" then
AcceptTime=tMail.Date '接收时间
else
AcceptTime=now()
end if
vPriority=tMail.Priority
Call getAttachments(J) '存储附件
Call StoreToGeted
if MSGFromName="" then
MSGFromName=MSGFrom
end if
Call StoreToMail '存储至MAIL表
if J=pop3.count then
Call EndGet
else
response.write(LongSpaceStr & "<script>window.toptip.innerHTML = '正在收取第<span class=STYLE2>" & J & "</span>\/<span class=STYLE1>" & pop3.count & "</span>封邮件，请稍候！';</script>")
Response.flush() '输出缓冲区内容
end if
next
end if
rs.close
Set Attachments=Nothing
Set TheMsg=Nothing
'if ifdelete then
' POP3.DeleteMessages
'end if
POP3.Disconnect
Set POP3=Nothing
Response.Redirect("main.asp")
end if
if err.number<>0 then
response.write err.description
response.end
end if
%>
posted @
2008-08-24 17:53
Lewis.Liao
阅读(
242)
评论()
收藏
举报
浙公网安备 33010602011771号