📄 一个使用cdo的邮件列表asp程序(管理端).txt
字号:
一个使用CDO的邮件列表ASP程序(管理端)
--------------------------------------------------------------------------------
【batman】 于 99-8-7 下午 02:44:54 加贴在 Joy ASP ↑：
这是整个邮件列表程序服务端，由管理者运行：
文件名mailadmin.asp:
<%
'使用这段代码时，请将所有的邮件列表（后缀为lst）文件和
'信件文件(后缀为ltr)都放到根目录basedir中，并保证对给目录有写的权限
Dim debug
debug = false
BASEDIR = Server.MapPath("/tmp/maillist")
Forreading = 1
Forwriting = 2
Forappending = 8
'分隔字符
delimiter = "|"
' 本代码的URL注意不是路径
SCRIPT_URL="mailadmin.asp"
' 代码中使用了CDO NTS来发送邮件
' $DEFAULT_EMAIL是来保存默认的寄信人地址的变量（可根据自己情况进行修改）
DEFAULT_EMAIL="YourName@YourMailServer"
cpr = ""
if strcomp(Request.ServerVariables("REQUEST_METHOD"), "POST", vbtextcompare) <> 0 and _
strcomp(Request.ServerVariables("QUERY_STRING"), "", vbtextcompare) = 0 then
query_form
Response.End
end if
if strcomp(Request.ServerVariables("REQUEST_METHOD"), "POST", vbtextcompare) = 0 and _
Request.Form("action") = "LIST" then
get_list
Response.End
end if
if strcomp(Request.ServerVariables("REQUEST_METHOD"), "POST", vbtextcompare) = 0 and _
Request.Form("action") = "SENDMAIL" then
send_mail
Response.End
end if
if strcomp(Request.ServerVariables("REQUEST_METHOD"), "POST", vbtextcompare) = 0 and _
Request.Form("action") = "POSTLETTER" then
post_letter
Response.End
end if
if strcomp(Request.ServerVariables("REQUEST_METHOD"), "POST", vbtextcompare) = 0 and _
Request.Form("action") = "EDIT" then
ltr_editor
Response.End
end if
if strcomp(Request.ServerVariables("REQUEST_METHOD"), "POST", vbtextcompare) = 0 and _
Request.Form("action") = "PURGE" then
purge_names
Response.End
end if
error_report("没有设置正确参数。")
sub msginfo(str)
if debug then
Response.Write str & "<br>" & vbCrlf
end if
end sub
sub query_form ()
fileselect = get_files("filename","lst")
ltrselect = get_files("lfilename","ltr")
%>
<CENTER>
<TABLE WIDTH=550 CELLPADDING=2 BORDER=1 BGCOLOR="FFFF00">
<TR>
<TD ALIGN=CENTER>
<H2>邮件列表管理界面</H2>
<TABLE WIDTH=500 BORDER=1 CELLPADDING=5 CELLSPACING=0>
<TR>
<TD BGCOLOR="99FF99">
 <BR>
<FONT FACE="ARIAL">
欢迎来到邮件列表示例，使用它可以给你的列表用户发送信件。
<BR> 
</FONT>
</TD>
</TR>
<TR>
<TD>
<FORM ACTION="<%= SCRIPT_URL %>" METHOD="POST">
<TABLE WIDTH=500 BGCOLOR="CCCCCC" BORDER=1 CELLPADDING=5 CELLSPACING=0>
<TR>
<TD COLSPAN=2 BGCOLOR="CCCCCC">
<CENTER><FONT SIZE=+1><B>维护邮件列表</B></FONT></CENTER>
<FONT SIZE=-1 FACE="ARIAL">
这个form是用来维护你的邮件列表的
</FONT>
</TD>
<TR>
<TD BGCOLOR="CCE6FF">
<B>请选择一个邮件列表文件</B>
</TD>
<TD BGCOLOR="CCE6FF">
<%= fileselect %>
</TD>
</TR>
<TR>
<TD BGCOLOR="CCE6FF">
<B>根据邮件地址查找</B>
</TD>
<TD BGCOLOR="CCE6FF">
<INPUT TYPE="TEXT" NAME="search" SIZE=30 MAXLENGTH=100 VALUE="">
</TD>
</TR>
<TR>
<TD BGCOLOR="CCE6FF"><B>确定</B>
</TD>
<TD BGCOLOR="CCE6FF">
<INPUT TYPE="submit" VALUE="GO GETEM!">
<INPUT NAME="action" TYPE="hidden" VALUE="LIST">
</TD>
</TR>
</TABLE>
</FORM>
<FORM ACTION="<%=SCRIPT_URL%>" METHOD="POST">
<TABLE WIDTH=500 BGCOLOR="CCCCCC" BORDER=1 CELLPADDING=5 CELLSPACING=0>
<TR>
<TD COLSPAN=2 BGCOLOR="CCCCCC">
<CENTER><FONT SIZE=+1><B>维护信件</B></FONT></CENTER>
<FONT SIZE=-1 FACE="ARIAL">
如果要新建一个信件，请选择“是”。
<I>是</I>. 如果是选择一个已经存在的信件请从下拉框中选择
</FONT>
</TD>
<TR>
<TD BGCOLOR="CCE6FF">
<B>请选择信件</B>
</TD>
<TD BGCOLOR="CCE6FF">
<%= ltrselect %>
</TD>
</TR>
<TR>
<TD BGCOLOR="CCE6FF"><B>新建一封信？</B>
</TD>
<TD BGCOLOR="CCE6FF">
<INPUT TYPE="radio" NAME="newfile" VALUE="NO" checked>否
<INPUT TYPE="radio" NAME="newfile" VALUE="YES">是
</TD>
</TR>
<TR>
<TD BGCOLOR="CCE6FF"><B>确定</B>
</TD>
<TD BGCOLOR="CCE6FF">
<INPUT TYPE="submit" VALUE="DO IT!">
<INPUT NAME="action" TYPE="hidden" VALUE="EDIT">
</TD>
</TR>
</TABLE>
</FORM>
<FORM ACTION="<%=SCRIPT_URL%>" METHOD="POST">
<TABLE WIDTH=500 BGCOLOR="CCCCCC" BORDER=1 CELLPADDING=5 CELLSPACING=0>
<TR>
<TD COLSPAN=2 BGCOLOR="CCCCCC">
<CENTER><FONT SIZE=+1><B>发送邮件</B></FONT></CENTER>
<FONT SIZE=-1 FACE="ARIAL">
千万小心，在选择了正确的信件后再发送哦。
</FONT>
</TD>
<TR>
<TD BGCOLOR="CCE6FF">
<B>请选择要发送的邮件列表</B>
</TD>
<TD BGCOLOR="CCE6FF">
<%= fileselect %>
</TD>
</TR>
<TR>
<TD BGCOLOR="CCE6FF">
<B>请选择要发送的信件</B>
</TD>
<TD BGCOLOR="CCE6FF">
<%=ltrselect%>
</TD>
</TR>
<TR>
<TD BGCOLOR="CCE6FF">
<B>从</B>
</TD>
<TD BGCOLOR="CCE6FF">
<INPUT TYPE="TEXT" NAME="from" SIZE=25 MAXLENGTH=100 VALUE="<%=DEFAULT_EMAIL%>">
</TD>
</TR>
<TR>
<TD BGCOLOR="CCE6FF">
<B>标题</B>
</TD>
<TD BGCOLOR="CCE6FF">
<INPUT TYPE="TEXT" NAME="subject" SIZE=25 MAXLENGTH=100 VALUE="">
</TD>
</TR>
<TR>
<TD BGCOLOR="CCE6FF"><B>确定</B>
</TD>
<TD BGCOLOR="CCE6FF">
<INPUT TYPE="submit" VALUE="MAILEM!">
<INPUT NAME="action" TYPE="hidden" VALUE="SENDMAIL">
</TD>
</TR>
</TABLE>
</FORM>
</TD>
</TR>
</TABLE>
<%= cpr %>
</TD>
</TR>
</TABLE>
</CENTER>
<%
end sub
sub send_mail ()
on error resume next
Dim i, j, maillist, toList, start, finish, last, total, mailresult
Dim f, fso, lettext
if Request.Form("filename") = "" or Request.Form("lfilename") = "" then
error_report("没有选择邮件或则邮件列表文件。")
end if
if Request.Form("from") = "" or Request.Form("from") = "" then
error_report("发信人地址错误。")
end if
lettext=""
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(BASEDIR & "\" & Request.Form("lfilename"), ForReading, false)
lettext = f.readall
'打开邮件列表
f.close
Set f = fso.OpenTextFile(BASEDIR & "\" & Request.Form("filename"), ForReading, false)
maillist = split(f.readall, vbCrlf, -1, vbtextcompare)
Set f = nothing
Set fso = nothing
on error goto 0
if not isarray(maillist) then
exit sub
end if
last = Ubound(maillist) - 1
Response.Write "<PRE>邮件正在发送给下列成员" & Request.Form("filename") & vbCrlf
Response.Write "使用的邮件是 " & Request.Form("lfilename") & vbCrlf & vbCrlf
for i = 0 to last
singlemail = split(maillist(i), delimiter, -1, vbtextcompare)
if mailpattern(singlemail(0)) then
mailresult = SendMail(Request.Form("from"), singlemail(0), _
Request.Form("subject"), lettext, "", "", 1)
if mailresult then
Response.Write singlemail(0) & ": 已经发送成功" & vbCrlf
else
Response.Write singlemail(0) & ": 发送失败"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -