IDC资讯中心
这是用户使用的页面和实现的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="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
%>
