Jmail邮件发送程序...
sub SendMaillist()
dim Sendername,Senderemail,Subject,Content,Priority,InceptType,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 & "<br><li>发件人不能为空!</li>"
end if
if Senderemail="" then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>发件人Email不能为空!</li>"
end if
if Subject="" then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>邮件主题不能为空!</li>"
end if
if Content="" then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>邮件内容不能为空!</li>"
end if
if Priority="" then
Priority=3
end if
InceptType=Clng(request("incepttype"))
sql="select UserName,Email from [User] "
if InceptType=1 then
sql=sql & " where Email like '%@%'"
elseif InceptType=2 then
InceptName=replace(replace(replace(replace(request("inceptname")," ",""),"'",""),chr(34),""),"|","','")
sql=sql & " where UserName in ('" & InceptName & "') and Email like '%@%'"
elseif InceptType=3 then
InceptEmail=replace(replace(replace(replace(request("inceptemail")," ",""),"'",""),chr(34),""),"|","','")
sql=sql & " where Email in ('" & InceptEmail & "')"
end if
if FoundErr=True then
exit sub
end if
set rs=server.createobject("adodb.recordset")
rs.open sql,conn,1,1
if rs.bof and rs.eof then
FoundErr=true
ErrMsg=ErrMsg & "<br><li>暂时没有用户注册!</li>"
else
response.write "<li>正在发送中,请等待 "
do while not rs.eof
if IsValidEmail(rs("Email"))=True then
ErrMsg=SendMail(rs("Email"),rs("UserName"),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 "<BR><li>成功发送邮件:"&i&"封"
if j>0 then response.write "<BR><li>未发送邮件:"&j&"封(邮件地址错误)。" end if
end if
rs.close
set rs=nothing
call CloseConn()
end sub