<%
if Action="Send" then
call SendMaillist()
elseif Action="Export" then
call ExportMail()
elseif Action="DoExport" then
call DoExportMail()
else
call main()
end if
if FoundErr=True then
call WriteErrMsg()
end if
sub main()
%>
<%
end sub
sub SendMaillist()
dim Sendername,Senderemail,Subject,Content,Priority,InceptType,InceptUserType,InceptName,InceptEmail,i,j
Sendername=trim(request("sendername"))
Senderemail=trim(request("senderemail"))
Subject=trim(request("Subject"))
Content=trim(request("Content"))
Priority=trim(request("Priority"))
if Sendername="" then
FoundErr=True
ErrMsg=ErrMsg & "
发件人不能为空！
"
end if
if Senderemail="" then
FoundErr=True
ErrMsg=ErrMsg & "
发件人Email不能为空！
"
end if
if Subject="" then
FoundErr=True
ErrMsg=ErrMsg & "
邮件主题不能为空！
"
end if
if Content="" then
FoundErr=True
ErrMsg=ErrMsg & "
邮件内容不能为空！
"
end if
if Priority="" then
Priority=3
end if
InceptType=Clng(request("incepttype"))
sql="select " & db_User_Name & "," & db_User_Email & " from " & db_User_Table & " "
if InceptType=1 then
InceptUserType=request("inceptusertype")
if InceptUserType<>0 then
sql=sql & " where " & db_User_UserLevel & "=" & InceptUserType & ""
end if
elseif InceptType=2 then
InceptName=replace(replace(replace(replace(request("inceptname")," ",""),"'",""),chr(34),""),"|","','")
sql=sql & " where " & db_User_Name & " in ('" & InceptName & "')"
elseif InceptType=3 then
InceptEmail=replace(replace(replace(replace(request("inceptemail")," ",""),"'",""),chr(34),""),"|","','")
sql=sql & " where " & db_User_Email & " in ('" & InceptEmail & "')"
end if
if FoundErr=True then
exit sub
end if
set rs=server.createobject("adodb.recordset")
rs.open sql,Conn_User,1,1
if rs.bof and rs.eof then
FoundErr=true
ErrMsg=ErrMsg & "
暂时没有用户注册！
"
else
response.write "
正在发送中，请等待 "
do while not rs.eof
if IsValidEmail(rs(db_User_Email))=true then
ErrMsg=SendMail(rs(db_User_Email),rs(db_User_Name),Subject,Content,Sendername,Senderemail,Priority)
if ErrMsg<>"" then
FoundErr=True
exit sub
end if
i=i+1
response.write "."
else
j=j+1
end if
rs.movenext
loop
response.write "
成功发送邮件："&i&"封"
if j>0 then response.write "
未发送邮件："&j&"封（邮件地址错误）。" end if
end if
rs.close
set rs=nothing
call CloseConn_User()
end sub
sub ExportMail()
%>
<%
end sub
sub DoExportList()
dim ExportType,UserType,ExportFileName,strResult
ExportType=Clng(trim(Request("ExportType")))
UserType=Clng(trim(request("UserType")))
ExportFileName=trim(request("ExportFileName"))
if ExportFileName="" then
FoundErr=True
if ExportType=1 then
ErrMsg=ErrMsg & "
请输入要导出的数据库文件名！
"
else
ErrMsg=ErrMsg & "
请输入要导出的文本文件名！
"
end if
else
ExportFileName=replace(replace(ExportFileName,"'",""),chr(34),"")
end if
set rs=server.createobject("adodb.recordset")
if UserType=0 then
sql="select useremail from [user] where useremail like '%@%'"
else
sql="select useremail from [user] where useremail like '%@%' and UserLevel=" & UserType & ""
end if
rs.open sql,Conn_User,1,1
i=0
select case ExportType
case 1
dim tconn,tconnstr
Set tconn = Server.CreateObject("ADODB.Connection")
tconnstr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(ExportFileName)
tconn.Open tconnstr
do while not rs.eof
tconn.execute("insert into [user] (useremail) values ('"&rs(0)&"')")
rs.movenext
i=i+1
loop
tConn.close
Set tconn = Nothing
strResult="操作成功：共导出 "& i &" 个用户Email地址到数据库 "&tdb&"。点击这里将数据库下载回本地"
case 2
dim fso,filepath,writefile
Set fso = CreateObject("Scripting.FileSystemObject")
Application.lock
filepath=Server.MapPath(""&ExportFileName&"")
Set Writefile = fso.CreateTextFile(filepath,true)
do while not rs.eof
Writefile.WriteLine rs(0)
rs.movenext
i=i+1
loop
Writefile.close
Application.unlock
set fso=nothing
strResult="操作成功：共导出 " & i & " 个用户Email地址到"&ExportFileName&"文件。点击这里将文件下载回本地)"
end select
rs.close
set rs=nothing
%>