模板
教程
环境
性能
功能
管理
以前收集的一些资料---一个使用CDO的邮件列表ASP程序(用户端)
发表于：2007-06-30来源：作者：点击数：
标签：
这是用户使用的页面和实现的asp 用户页面：subscrib.html BODY BGCOLOR=#ffffff CENTER P table WIDTH=125 BORDER=0 CELLSPACING=0 tr td width=100% valign=top align=middle bgcolor=#0066cc height=20strongfont color=#ffffff size=2 face=Verdana, Arial
这是用户使用的页面和实现的asp用户页面：subscrib.html
<BODY BGCOLOR="#ffffff">
<CENTER>
<P>
<table WIDTH=125 BORDER=0 CELLSPACING=0>
<tr>
<td width="100%" valign="top" align="middle" bgcolor="#0066clearcase/" target="_blank" >cc"
height="20"><strong><font color="#ffffff" size="2" face="Verdana, Arial">
<A NAME="NEWSLETTER">
信件</font></strong></A></td>
</tr>
<tr>
<td valign="top" bgcolor="#99ccff" width="100%" >
<font face="Arial, Helvetica" size="1"><font color="#000000">
<FORM ACTION="subscribe.asp" METHOD="post">
<INPUT TYPE="radio" NAME="action" VALUE="subscribe" checked>订阅邮件<BR>
<INPUT TYPE="radio" NAME="action" VALUE="unsubscribe">取消订阅<BR>
<CENTER>
<INPUT NAME="email" VALUE="your-email" SIZE=10 MAXLENGTH=100 ><BR>
<INPUT TYPE="hidden" NAME="datafile" VALUE="subscribe">
<INPUT TYPE="submit" VALUE="DO IT!"><BR>
快来加入邮件列表。
</CENTER></FORM>
</font>
</font>
</td>
</tr>
</table>
</BODY></HTML>
文件名为subscrib.asp
<%
BASEDIR= Server.MapPath("/tmp/maillist")
Forreading = 1
Forwriting = 2
Forappending = 8
delimiter = "|"
linedelimiter = vbCrlf
valid_page
return_to = Request.ServerVariables("HTTP_REFERER")
the_date = date()
ip_addr = Request.ServerVariables("REMOTE_ADDR")
datafile = Request.Form("datafile") & ".lst"
email = Request.Form("email")
action = Request.Form("action")
if datafile = "" then
Response.Write "配置出错: 没有选择数据文件<br>"
Response.End
end if
if action = "" then
Response.Write "配置出错<br>"
Response.End
end if
if not mailpattern(email) then
bad_email
end if
write_data
thank_you
%>
<%
sub thank_you ()
if action = "unsubscribe" then
whichaction = "移走"
else
whichaction = "添加到"
end if
%>
<CENTER>
<P>
<P>
<TABLE WIDTH="510" BORDER="1" CELLPADDING="3" BGCOLOR="@#0066cc">
<TR>
<TD>
<TABLE WIDTH="500" BORDER="1" CELLPADDING="5" BGCOLOR="@#99CCFF">
<TR>
<TD>
<CENTER>
<FONT FACE="ARIAL">
<P>
<H1>谢谢 -)</H1>
<B>你的电子邮件地址已经被 <%= whichaction %> 邮件列表.<BR>
请选择下面的连接返回上一个页面。 <BR>
<P>
<A HREF="<%= return_to%>"><B><%= return_to %></B></A></B>
<P>
</TD>
</TR>
</TABLE>
</TD>
</TR>
</TABLE>
</CENTER>
<%
end sub
@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#
sub write_data ()
Dim current, fso, f, maillist, singlemail, found, last, i, j, start
on error resume next
Set fso = Server.CreateObject("Scripting.FilesystemObject")
Set f = fso.OpenTextFile(BASEDIR & "\" & datafile, ForReading, true)
maillist = split(f.readall, linedelimiter, -1, vbtextcompare)
f.close
if not isarray(maillist) then
if action = "subscribe" then
Set f = fso.OpenTextFile(BASEDIR & "\" & datafile, ForAppending, true)
f.write email & delimiter & ip_addr & delimiter & formatdatetime(date(), 1) & vbCrlf
f.close
end if
else
Application.Lock
Set f = fso.OpenTextFile(BASEDIR & "\" & datafile, ForWriting, true)
last = Ubound(maillist) - 1
for i = 0 to last
singlemail = split(maillist(i), delimiter, -1, vbtextcompare)
if strcomp(email, singlemail(0), vbBinaryCompare) <> 0 then
f.write maillist(i) & vbCrlf
end if
next
if action = "subscribe" then
f.write email & delimiter & ip_addr & delimiter & formatdatetime(date(), 1) & vbCrlf
end if
f.close
Application.UnLock
end if
Set f = nothing
Set fso = nothing
end sub
@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#@#
sub bad_email ()
%>
<FONT SIZE="+1">
<B>
抱歉，你还有一些重要的信息没有填写，请返回重新填写。
</B>
</FONT>
<%
end sub
function mailpattern(email)
Dim i,j, first, last, char
i = instr(1, email, "@", vbtextcompare)
if i > 0 and i < len(email) then
first = left(email, i - 1)
last = mid(email, i+1, len(email))
else
mailpattern = false
exit function
end if
i = 0
do until i = len(first)
i = i + 1
char = mid(first, i, 1)
if asc(char) <> 46 and (asc(46) < 48 or asc(char) > 57) and _
(asc(char) < 65 or asc(char) > 90) and (asc(char) < 97 or asc(char) > 122) then
mailpattern = false
exit function
end if
loop
i = 0
do until i = len(last)
i = i + 1
char = mid(last, i, 1)
if asc(char) <> 46 and (asc(46) < 48 or asc(char) > 57) and _
(asc(char) < 65 or asc(char) > 90) and (asc(char) < 97 or asc(char) > 122) then
mailpattern = false
exit function
end if
loop
mailpattern = true
end function
sub valid_page ()
dim i, j, start, finish
if not isarray(okdomain) then
exit sub
end if
domain_ok = false
RF = Request.ServerVariables("HTTP_REFERER")
for i = 0 to Ubound(okdomain)
if instr(1, RF, okdomain(i), vbtextcompare) > 0 then
domain_ok = true
end if
next
if not domain_ok then
Response.Write "对不起，不能够在这运行。<br>"
Response.End
end if
end sub
%>
