邮件接受中，请稍后……

<% 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 %>