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

  　　文章到这里就结束了，至于邮件数据库的数据结构大家根据代码自己琢磨吧！做人要厚道，请注明转自chinazhan中国站长(www.ChinaZhan.com)。

软件：	ASP 源码 \| .NET源码 \| PHP 源码 \| JSP 源码 \| CGI 源码 \| 网页模板 \| 网页素材 \| 字体下载 \| 工具软件 \| 服务器类 \| 书籍教程
文章：	网页编程 \| 网页制作 \| 数据库区 \| 服务器区 \| 网络安全 \| 网站运营 \| 图形图象




中国站长下载	本页只接受PR>=4 IT类站点连接,申请连接,谢谢您们的支持!希望我们的下载站能够真正帮到中国的站长们！
	关于本站 - 网站帮助 - 广告合作 - 下载声明 - 友情连接 - 网站地图 Copyright © 2005-2006 ChinaZhan.Net. All Rights Reserved .