用ASP实现支持附件的EMail系统（3）

尝试发送邮件，但是失败了，请修改错误后重试！

＜script language="javascript"＞
alert("您输入的收件组格式错误！\r正确的格式是:@#gr:001@#");
history.back();
＜/script＞
＜p＞
＜%
response.end
else
thegroup=(mid(trim(strfieldvalue),4))
end if
end if

tmpSQL="select * from t_group where owner=@#"&session("myid")&"@# and groupidowner=@#"&thegroup&"@#"
@#response.write tmpsql
set tmprs=server.CreateObject("ADODB.Recordset")
tmprs.Open tmpsql,conn
if tmprs.bof or tmprs.eof then
@#没有找到该组
%＞
尝试发送邮件，但是失败了，请修改错误后重试！
＜script language="javascript"＞
alert("您输入的收件组＜%=thegroup%＞没有找到！");
history.back();
＜/script＞
＜p＞
＜%
response.end
else
if tmprs("personnum")=0 then
@#组内没有用户
%＞
尝试发送邮件，但是失败了，请修改错误后重试！
＜script language="javascript"＞
alert("您输入的收件组＜%=thegroup%＞中目前没有任何的用户\n所以不能发送");
history.back();
＜/script＞
＜p＞
＜%
response.end
else
strFieldValue=trim(tmprs("groupempl"))
tmprs.close
set tmprs=nothing
end if
end if
end if

if instr(strfieldValue,"|") then
@#组发
allsearch=replace(trim(strfieldValue),"|","@#,@#")
allsearch="@#"&allsearch&"@#"
tmpstring=trim(strfieldValue)&"|"
tosearch=""
do while len(tmpstring)＞=5

tosearch=left(tmpstring,5)
tmpstring=mid(tmpstring,7)
if instr(tosearch,"|") then
@#格式错误
%＞
尝试发送邮件，但是失败了，请修改错误后重试！
＜script language="javascript"＞
alert("您输入的收件人格式错误!");
history.back();
＜/script＞
＜p＞
＜%
response.end
end if

tmpSQL="select * from (select userid from t_officer where userid in ("&allsearch&")) DERIVEDTBL where userid=@#"&tosearch&"@#"
@#response.write tmpsql
set tmprs=server.CreateObject("ADODB.Recordset")
tmprs.Open tmpsql,conn
if tmprs.eof or tmprs.bof then
%＞
尝试发送邮件，但是失败了，请修改错误后重试！
＜script language="javascript"＞
alert("您输入的收件人＜%=tosearch%＞没有找到!");
history.back();
＜/script＞
＜p＞
＜%
response.end
end if
tmprs.close
set tmprs=nothing
loop
strfieldValue=trim(strFieldValue)

else
if len(trim(strFieldValue))＜＞5 then
@#格式不正确
%＞
尝试发送邮件，但是失败了，请修改错误后重试！
＜script language="javascript"＞
alert("您输入的收件人＜%=trim(strFieldValue)%＞不正确!");
history.back();
＜/script＞
＜p＞
＜%
response.end
else
if isnumeric(trim(len(strFieldValue))) then


tmpSQL="select * from t_officer where userid=@#"&trim(strFieldValue)&"@#"

set tmprs=server.CreateObject("ADODB.Recordset")
tmprs.Open tmpsql,conn
if tmprs.eof or tmprs.bof then
%＞
尝试发送邮件，但是失败了，请修改错误后重试！
＜script language="javascript"＞
alert("您输入的收件人＜%=trim(strFieldValue)%＞没有找到\r该员工可能还没有注册!");
history.back();
＜/script＞
＜p＞
＜%
response.end
end if
tmprs.close
set tmprs=nothing


strfieldValue=trim(strFieldValue)
else
%＞
尝试发送邮件，但是失败了，请修改错误后重试！
＜script language="javascript"＞
alert("您输入的收件人＜%=trim(strFieldValue)%＞不正确!");
history.back();
＜/script＞

＜p＞ ＜%
response.end
end if
end if
end if

end if
strFieldValue=replace(strFieldValue,"＜","＜")
@#response.write strfieldname
rs(STRFIELDNAME)=replace(strFieldValue,"＞","＞")

binHTTPHeader=MIDB(binHTTPHeader,INSTRB( DataStart + 1, binHTTPHeader, divider ))

loop
@#开始处理文件数据


titem=0
rs("filesize_1")=0
rs("filesize_2")=0
rs("filesize_3")=0



Do while lenB(binHTTPHeader)＞46

if INSTRB( binHTTPHeader, bnCRLF & bnCRLF )＜＞0 then
binHeaderData = LeftB(binHTTPHeader,INSTRB( binHTTPHeader, bnCRLF & bnCRLF )-1)
else
exit do
end if
strHeaderData=bin2str(binHeaderData)


@#读取上传文件的Content-Type
lngFileContentTypeStart=Instr(strHeaderData,"Content-Type:")+Len("Content-Type:")
strFileContentType=Trim(Mid(strHeaderData,lngFileContentTypeStart))
strFileContentType=Replace(strFileContentType,vbCRLF,vbNullString)

@#读取上传的文件名
if instr(strheaderdata,"filename=")＞0 then
lngFileNameStart=Instr(strHeaderData,"filename="&chr(34))+Len("filename="&chr(34))
lngFileNameEnd=Instr(lngFileNameStart,strHeaderData,chr(34))
strFileName=Mid(strHeaderData,lngFileNameStart,lngFileNameEnd-lngFileNameStart)
strFileName=Trim(strFileName)
strFileName=Replace(strFileName,vbCRLF,vbNullString)
else
strfilename=""
end if

@#读取上传文件数据
DataStart = INSTRB( binHTTPHeader, bnCRLF & bnCRLF ) + 4
DataEnd = INSTRB( DataStart + 1, binHTTPHeader, divider ) - DataStart

If strFileName＜＞"" Then
if dataend＞0 then
binFieldValue=MIDB( binHTTPHeader, DataStart, DataEnd )
@#将上传的文件写入数据库
titem=titem+1
@#response.write "titem:"&titem
rs("FileContentType_"&titem)=strFileContentType
rs("FileContent_"&titem).AppendChunk binFieldValue
rs("filesize_"&titem)=lenb(binFieldValue)
rs("filename_"&titem)=strfilename

else
binfieldvalue=binhttpheader
end if

End if

if INSTRB( DataStart + 1, binHTTPHeader, divider )＞0 then
binHTTPHeader=MIDB(binHTTPHeader,INSTRB( DataStart + 1, binHTTPHeader, divider ))
else
binhttpheader=""
end if

loop
rs("sizetotal")=csng(rs("filesize_1"))+csng(rs("filesize_2"))+csng(rs("filesize_3"))+csng(len(rs("body")))+csng(len(rs("emailtitle")))+csng(len(rs("emailshowname")))+csng(len("geterempl"))
if csng(rs("sizetotal"))＞=csng(2*1024*1024) then
response.write "对不起,文件太大，请保证每封邮件的总大小不超过2M!"
response.end
end if
rs("mailtime")=now
rs("readerempl")=""
if rs("receempl")＜＞"" then
rs("receempl")=session("myid")
rs("readerempl")=session("myid")
end if
rs("deleempl")=""
rs("deleverempl")=""
rs("sendmac")=strmac
rs.update
rs.close
set rs=Nothing
conn.Close
set conn=Nothing

%＞
＜script language=javascript＞
window.open("mailok.asp",target="_self")
＜/script＞
＜/body＞＜/html＞

　　最后，我们来讲讲如何把内容从数据库中读出来，内容有这么几类，一类是浏览器上可以显示的，例如*.htm，一类是需要下载的，例如*.exe，还有一种是浏览器可以显示但是不能够让他显示的，例如*.asp，请看代码：

＜%
Response.Buffer= true
Response.Clear

function getname(oriname)
thename=oriname
do while instr(thename,"/")＞0
thename=mid(thename,instr(thename,"/")+1)
loop
do while instr(thename,"\")＞0
thename=mid(thename,instr(thename,"\")+1)
loop
getname=thename

end function

function canexec(thechar)
if instr(thechar,".asp")＞0 then
canexec=false
exit function
end if
if instr(thechar,".asa")＞0 then
canexec=false
exit function
end if
if instr(thechar,".aspx")＞0 then
canexec=false
exit function
end if
if instr(thechar,".asax")＞0 then
canexec=false
exit function
end if
canexec=true
end function
mailID=request("mailID")
se=request("se")
if se＜＞1 and se＜＞2 and se＜＞3 then
response.end
end if
Set conn=server.createobject("adodb.connection")
set rs=server.createobject("adodb.recordset")
conn.open "DSN=;UID=;PWD="
sql="select * from t_mail where ((geterempl like @#%"&session("myid")&"%@# or deleempl like @#%"&session("myid")&"%@# or receempl like @#%"&session("myid")&"%@# ) and (not deleverempl like @#%"&session("myid")&"%@#)) and mailid=@#"&mailid&"@# "
rs.open sql,conn,3,3
if rs.eof or rs.bof then
response.end
end if
if rs("filecontenttype_"&trim(se))＜＞"text/plain" or (not canexec(getname(trim(rs("filename_"&trim(se)))))) then
Response.ContentType = rs("FileContentType_"&trim(se))
end if



@#Response.AddHeader "content-type","application/x-msdownload"

if instr(response.contenttype,"application")＞0 then
response.AddHeader "Content-Disposition","attachment;filename="&getname(trim(rs("filename_"&trim(se))))
end if
Response.BinaryWrite rs("FileContent_"&trim(se))
rs.close
set rs=Nothing
conn.close
set conn=nothing
%＞

　　文章到这里就结束了，至于邮件数据库的数据结构大家根据代码自己琢磨吧！

原文转自：http://www.ltesting.net