sendmail.asp

3000首FLASH源程序

<%PageName="sendmail.asp"%>
<!--#include file="top.asp"-->
<%
	dim rs,sql
	dim boardtype
    dim foundErr 
    dim ErrMsg
	dim topic
	dim mailbody
	dim email
	dim id,typelist
    	foundErr = false
    	ErrMsg = ""
    	Call getInput()
    	call chkInput()
		
    	if foundErr then
		call Error()
	else
		call showPage()
	end if

	sub showPage()
		'on error resume next
		if foundErr then
			call Error()
		else
			if request("action")="sendmail" then
				if IsValidEmail(trim(Request.Form("mail")))=false then
   					errmsg=errmsg+"<br>"+"<li>您的Email有错误!</li>"
   					founderr=true
				else
					email=trim(Request.Form("mail"))
				end if
				call announceinfo()
				if founderr then
					call Error()
				else
					call cmail(email)
					call success()
				end if
			else
				call pag()
			end if
		end if
		if err.number<>0 then err.clear
	end sub

	sub announceinfo()
	topic="从"&WebName&"发来的资料"
	mailbody=mailbody &"<style>A:visited {	TEXT-DECORATION: none	}"
	mailbody=mailbody &"A:active  {	TEXT-DECORATION: none	}"
	mailbody=mailbody &"A:hover   {	TEXT-DECORATION: underline overline	}"
	mailbody=mailbody &"A:link 	  {	text-decoration: none;}"
	mailbody=mailbody &"A:visited {	text-decoration: none;}"
	mailbody=mailbody &"A:active  {	TEXT-DECORATION: none;}"
	mailbody=mailbody &"A:hover   {	TEXT-DECORATION: underline overline}"
	mailbody=mailbody &"BODY   {	FONT-FAMILY: 宋体; FONT-SIZE: 9pt;}"
	mailbody=mailbody &"TD	   {	FONT-FAMILY: 宋体; FONT-SIZE: 9pt	}</style>"

	Rs.open "Select "&typelist&".title,"&typelist&".content,author.author from "&typelist&",author where "&typelist&".id="&id&" and "&typelist&".authorid=author.authorid",conn,1,1
	httpurl=replace(request.ServerVariables("HTTP_REFERER"),"sendmail",typelist&"list")
	announce=announce &"<TABLE border=0 width='95%' align=center><TBODY><TR>"
	announce=announce &"<TD valign=middle align=top>"
	announce=announce &"--&nbsp;&nbsp;作者："&rs("author")&"<br>"
	announce=announce &"--&nbsp;&nbsp;<a href="&httpurl&" target=_blank>"&rs("title")&"</a><br>"
	announce=announce &rs("content")&""
	announce=announce &"<hr></TD></TR></TBODY></TABLE>"

	rs.close
	mailbody=mailbody+announce
	mailbody=mailbody &"<center>"&WebName
	end sub

	sub pag()
%>
<table cellpadding=0 cellspacing=0 border=0 width=770 bgcolor=<%=Tablebackcolor%> align=center>
  <tr>
        <td>
        
      <table cellpadding=6 cellspacing=1 border=0 width=100%>
        <form action="sendmail.asp?action=sendmail&id=<%=id%>&typeor=<%=request("typeor")%>" method=post>
          <tr bgcolor="<%=Tablebodycolor%>"> 
            <td valign=middle colspan=2 align=center> <b>发送到信箱</b></td>
          </tr>
          <tr align="center"> 
            <td bgcolor=#FFFFFF valign=middle colspan=2> 请正确输入你要邮递的邮件地址</td>
          </tr>
          <tr bgcolor="<%=Tablebodycolor%>"> 
            <td><b>邮递的 Email 地址：</b></td>
            <td> 
              <input type=text size=40 name="mail"></td>
    </tr>
          <tr bgcolor="<%=Tablebodycolor%>"> 
            <td colspan=2 align=center> 
              <input type=submit value="发 送" name="Submit"></td></tr></form></table></td></tr></table>
<%
	end sub

	Sub getInput()
        	ID = Request("ID")
			typelist=request("typeor")
    	End Sub
    
    	sub chkInput
		if ID="" then
			foundErr = true
			ErrMsg=ErrMsg+"<li>请指定相关作品</li>"
		end if
		if typelist="" then
			foundErr = true
			ErrMsg=ErrMsg+"<li>请指定相关类型</li>"
		end if
    	end sub

sub success()
%>
    
<table cellpadding=0 cellspacing=0 border=0 width=770 bgcolor=<%=Tablebackcolor%> align=center>
  <tr>
            <td>
                
      <table cellpadding=3 cellspacing=1 border=0 width=100% bgcolor="<%=Tablebackcolor%>">
        <tr align="center"> 
          <td width="100%" bgcolor=<%=Tablebodycolor%>>成功：打包邮递</td>
    </tr>
    <tr> 
          <td width="100%" bgcolor=#FFFFFF align="center">恭喜您，您的邮递发送成功。 </td>
    </tr>
    <tr align="center"> 
          <td width="100%" bgcolor=<%=Tablebodycolor%>> <a href="javascript:history.go(-1)"><< 返回上一页</a> </td>
    </tr>  
    </table>
	</td></tr></table>
<%
end sub

sub error()
%>   
<table cellpadding=0 cellspacing=0 border=0 width=770 bgcolor=#777777 align=center>
  <tr>
    <td>     
      <table cellpadding=3 cellspacing=1 border=0 width=100% bgcolor="<%=Tablebackcolor%>">
        <tr align="center"> 
          <td width="100%" bgcolor=<%=Tablebodycolor%>>错误信息</td>
    </tr>
    <tr> 
      <td width="100%" bgcolor=#FFFFFF><b>产生错误的可能原因：</b><br><br>
<%=errmsg%>
      </td>
    </tr>
    <tr align="center"> 
          <td width="100%" bgcolor=<%=Tablebodycolor%>> <a href="javascript:history.go(-1)"> 
            << 返回上一页</a> </td>
    </tr>  
    </table>   </td></tr></table>
<%
end sub

	sub  cmail(email)
	dim  objCDOMail
	Set objCDOMail = Server.CreateObject("CDONTS.NewMail")
	objCDOMail.MailFormat = cdoMailFormatMime
	objCDOMail.BodyFormat = cdoBodyFormatHTML
	objCDOMail.From ="[e-mail]"
	objCDOMail.To =email
	objCDOMail.Subject =topic
	objCDOMail.Body =mailbody
	objCDOMail.Send
	Set objCDOMail = Nothing
	if err then 
	SendMail=err.description
	else
	SendMail="OK"
	end if
	end sub

function IsValidEmail(email)

dim names, name, i, c

'Check for valid syntax in an email address.

IsValidEmail = true
names = Split(email, "@")
if UBound(names) <> 1 then
   IsValidEmail = false
   exit function
end if
for each name in names
   if Len(name) <= 0 then
     IsValidEmail = false
     exit function
   end if
   for i = 1 to Len(name)
     c = Lcase(Mid(name, i, 1))
     if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
       IsValidEmail = false
       exit function
     end if
   next
   if Left(name, 1) = "." or Right(name, 1) = "." then
      IsValidEmail = false
      exit function
   end if
next
if InStr(names(1), ".") <= 0 then
   IsValidEmail = false
   exit function
end if
i = Len(names(1)) - InStrRev(names(1), ".")
if i <> 2 and i <> 3 then
   IsValidEmail = false
   exit function
end if
if InStr(email, "..") > 0 then
   IsValidEmail = false
end if

end function
	set rs=nothing
	conn.close
	set conn=nothing
%>
<!--#include file=copyright.asp-->
</BODY>
</HTML>