邮件接受中，请稍后……

<%
response.Flush
Dim EmailUserName,EmailUserPass,EmailUserPOP,IfDelete
set rs=conn.execute("select * from MyDesktop_IMAccount where AccountCode='"&request("code")&"' and UserID='"&session("userid")&"'")
EmailUserName=rs("Account")
EmailUserPass=rs("Password")
EmailUserPOP=rs("Pop3Server")
IfDelete=rs("ifdelete")
rs.close
if EmailUserPass="" then
EmailUserPass=request("password")
if EmailUserPass="" then
response.write ""
response.end
end if
end if
Dim POP3,J '下载并阅读邮件。
'------------------------
Set POP3 = Server.CreateObject("JMail.POP3")
POP3.Connect EmailUserName,EmailUserPass,EmailUserPOP
POP3.DownloadHeaders
set rs=server.createobject("adodb.recordset")
rs.open "select * from MyDesktop_IM",conn,1,3,1
if pop3.count>0 then
for J=1 to pop3.count

Dim Subject,MSGBody,MSGHTMLBody,MSGFrom,MSGFromName,ReTo,ReCC,FileUrl,FileName,AcceptTime

Subject=POP3.Messages.Item(J).Subject '邮件主题
MSGFrom=POP3.Messages.Item(J).From '发件人邮箱
MSGFromName=POP3.Messages.Item(J).FromName '发件人

Call getAttachments(J) '存储附件

response.write "
"&Subject

rs.addnew()
rs("AccountCode")=Request("code")
rs("SendMail")=MSGFrom
rs("SendMailName")=MSGFromName
rs("AcceptMail")=ReTo
rs("CopyMail")=ReCC
rs("ClassCode")=1
rs("MailTitle")=Subject
if MSGHTMLBody="" then
rs("MailBody")=replace(MSGBody,chr(10),"
")
else
rs("MailBody")=MSGHTMLBody
end if
rs("FileUrl")=FileUrl
rs("FileName")=FileName
rs("SendAcceptTime")=AcceptTime
rs("MailState")=1
rs.update()
next
end if
rs.close
Set Attachments=Nothing
Set TheMsg=Nothing
if ifdelete then
POP3.DeleteMessages
end if
POP3.Disconnect
Set POP3=Nothing
endconn()
Response.write "" '转到收件箱

'---------将附件存储到本地服务器------------------
Sub getAttachments(J)
Dim Path,AT,separator,i,iPath,Att,POP,Re
Set POP = Server.CreateObject("JMail.POP3")
POP.Connect EmailUserName,EmailUserPass,EmailUserPOP

MSGBody=POP.Messages.Item(J).Body '纯文本内容
MSGHTMLBody=POP.Messages.Item(J).HTMLBody '超文本内容
MSGBody=Trim(MSGBody)
MSGHTMLBody=Trim(MSGHTMLBody)
AcceptTime=POP.Messages.Item(J).Date '接收时间

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
Path="/EMail/attachments/" & iRandom & "/"
Call CreateAFolder(Server.Mappath(Path))
iPath=Server.Mappath(Path) & "\" & 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 iRandom()
Randomize
iRandom=Session("UserID")&month(date())&day(date())&Minute(time())&Second(time)&CLng(10000 * Rnd)
end Function
'--------创建新文件夹--------------
Sub CreateAFolder(Path)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CreateFolder(Path)
Set fso=Nothing
End Sub
%>