<%
'==================================  V-Jmail 在线发送邮件系统  ========================================
'         基于 Dimac w3 Jmail4.3 组件的网页邮件发送系统，主要是通过邮件代发送，从而能为邮件发送者实现
'     免密码登陆或者直接匿名发送等功能。
'         本程序只要目的是为了方便某些情况下能直接进行邮件发送，请不要胡乱利用本程序进行匿名邮件或者
'     垃圾邮件的发送。本程序只是提供邮件发送功能的实现，邮件发送者的具体内容与本程序开发作者Duclika
'     以及[维安达工作室]无任何关系。
'
'         程序编写：Duclika
'         版权所有：[维安达工作室]
'         电子邮件：Duclika@hotmail.com
'         OICQ号码：5183219    58858309
'         官方网站：http://www.anysecond.net/
'                   http://www.micromai.com/
'                   http://www.yzbizone.com/
'                   http://www.cnbiz114.com/
'                   http://www.dgcnd.com/
'         技术论坛：http://bbs.anysecond.net/
'
'         感谢 Veranda 小姐一直以来对在下的支持与鼓励，才能完成 V-Jmail （QQ：22083493）
'         请支持我们的美女 Veranda 以及她的网站【ヾ猫儿居ヾ】http://veranda.anysecond.net/
'------------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------------
option explicit							'强制变量定义开关，建议保留此项
'------------------------------------------------------------------------------------------------------
'----------------------------------     V-Jmail 1.0 用户配置接口      ---------------------------------
'----------------------------------         请按照提示进行设置        ---------------------------------
'------------------------------------------------------------------------------------------------------
Sub V_JMail_Config()
sSMTPServer="mail.melyysoft.com"					'SMTP服务器，可以直接输入SMTP的IP地址或者网址
sMailUser="edu@melyysoft.com"					'代发送邮件的帐号，如果是不含@的帐号，就不能写@
sSenderPassword="4119433"					'邮件服务器的登陆密码
sSysTitle="V-Jmail 在线邮件代发系统"				'本系统的名称
sVersion="1.0"							'版本号，建议只能是数值格式
lShowSMTPSvr=1							'是否允许发送者查看SMTP服务信息。允许为1，禁止为0
End Sub
'------------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------------
'
'                     以下为程序核心，如果对VBScript不熟悉的朋友请不要擅自修改
'
'------------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------------
dim JmailMsg									'JMail.Message COM对象
dim sMailUser									'邮件服务器的登陆帐号，如果是不含@的帐号，就不能写@
dim sSenderPassword								'邮件服务器的登陆密码
dim sSMTPServer									'SMTP服务器
dim sRecMail									'收件人Email
dim sRecMailArr									'收件人Email数组
dim sFromName									'在对方接收人中显示的发信人名称
dim sFromMail									'在对方接收人中显示的发信人地址
dim sMailSubject								'邮件主题
dim sMailBody									'邮件主体
dim lAnonymous									'是否匿名
dim lHTML									'是否HTML发送
dim sSysTitle									'系统标题
dim sVersion									'版本
dim sErrorMsg									'错误消息文本
dim RecMail_i									'收件人数组索引
dim lShowSMTPSvr								'是否显示SMTP服务器(代发邮件信息)
'------------------------------------------------------------------------------------------------------
Call VJMail_Config()
sErrorMsg="" %>
<html>

<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<meta name="GENERATOR" content="Microsoft FrontPage 6.0">
<meta name="ProgId" content="FrontPage.Editor.Document">
<title><%=sSysTitle%></title>
<style>
A:link {
	COLOR: #000000; TEXT-DECORATION: none
}
A:visited {
	COLOR: #000000; TEXT-DECORATION: none
}
A:active {
	COLOR: #FF0000; TEXT-DECORATION: none
}
A:hover {
	COLOR: #FF0000; TEXT-DECORATION: underline
}
body    {
	font-family: Arial; style; font-size: 12px; color: #111111; letter-spacing:0px;
	SCROLLBAR-HIGHLIGHT-COLOR: buttonface; SCROLLBAR-SHADOW-COLOR: buttonface; SCROLLBAR-3DLIGHT-COLOR: buttonhighlight; SCROLLBAR-TRACK-COLOR: #eeeeee; SCROLLBAR-DARKSHADOW-COLOR: buttonshadow;
}
td	{
	font-family: "宋体"; font-size: 12px; color: #111111; letter-spacing:0px; word-break:break-all
}
.bigfont1 {
	FONT-SIZE: 20px; font-weight:bold
}
</style>
</head>

<body>
<% if lcase(trim(request("action")))="smtp" then %>
<table border="0" width="250" bgcolor="#000000" cellspacing="1" cellpadding="3" align="center">
  <tr>
    <td colspan="2" bgcolor="#CCCCCC" width="238" align="center"><b><%=sSysTitle%></b></td>
  </tr>
  <tr>
    <td bgcolor="#FFFFFF" align="right" width="88">SMTP服务器：</td>
    <td bgcolor="#FFFFFF" width="140"><u><%=sSMTPServer%></u></td>
  </tr>
  <tr>
    <td bgcolor="#FFFFFF" align="right" width="88">SMTP帐号：</td>
    <td bgcolor="#FFFFFF" width="140"><u><%=sMailUser%></u></td>
  </tr>
  <tr>
    <td bgcolor="#FFFFFF" colspan="2" width="238" align="center">[<a href="javascript:window.close();">关闭</a>]</td>
  </tr>
</table><%
response.write "</body></html>"
response.end
end if
if lcase(trim(request("action")))="preview" then %>
<table border="0" width="380" bgcolor="#000000" cellspacing="1" cellpadding="3" align="center">
  <tr>
    <td width="368" colspan="2" align="center" bgcolor="#CCCCCC"><b><%=sSysTitle%></b><br>邮件预览</td>
  </tr>
  <tr>
    <td width="61" bgcolor="#E7E7E7" align="right">收件人：</td>
    <td width="297" bgcolor="#E7E7E7" id="sRecMail"></td>
  </tr>
  <tr>
    <td width="61" bgcolor="#E7E7E7" align="right">发件人：</td>
    <td width="297" bgcolor="#E7E7E7" id="sSender"></td>
  </tr>
  <tr>
    <td width="61" bgcolor="#E7E7E7" align="right">主　题：</td>
    <td width="297" bgcolor="#E7E7E7" id="sTitle"></td>
  </tr>
  <tr>
    <td width="358" bgcolor="#FFFFFF" colspan="2" height="120" valign="top" id="sContent"></td>
  </tr>
  <tr>
    <td width="358" bgcolor="#FFFFFF" align="center" colspan="2">[<a href="javascript:window.close();">关闭</a>]</td>
  </tr>
</table>
<script language="vbscript">
dim sStrTmp
sStrTmp=trim(window.opener.document.send_mail_form.sEMail.value)
sRecMail.innerHTML="<u>" & sStrTmp & "</u>"
sStrTmp=trim(window.opener.document.send_mail_form.sSender.value)
if sStrTmp="" then sStrTmp="<%=Request.ServerVariables("REMOTE_ADDR")%>"
if trim(window.opener.document.send_mail_form.sFrom.value)="" then
    sStrTmp=sStrTmp & " &lt;Anonymous@anysecond.net&gt;"
   else
    sStrTmp=sStrTmp & " &lt;" & window.opener.document.send_mail_form.sFrom.value & "&gt;"
end if
sSender.innerHTML="<u>" & sStrTmp & "</u>"
sStrTmp=trim(window.opener.document.send_mail_form.sTitle.value)
sTitle.innerHTML="<u>" & sStrTmp & "</u>"
sStrTmp=trim(window.opener.document.send_mail_form.sContent.value)
if window.opener.document.send_mail_form.lHTML.checked then
    sContent.innerHTML=sStrTmp
   else
    sStrTmp=replace(sStrTmp,vbCrLf,"<br>")
    sStrTmp=replace(sStrTmp,Chr(32),"&nbsp;")
    sContent.innerHTML=sStrTmp
end if
</script><%
response.write "</body></html>"
response.end
end if %>
<table border="0" width="500" bgcolor="#000000" cellspacing="1" cellpadding="3" align="center">
  <tr>
    <td width="100%" bgcolor="#E7E7E7" height="80" align="center">
      <table border="0" width="100%" cellspacing="0" cellpadding="0">
        <tr>
          <td width="100%" align="center" class="bigfont1"><%=sSysTitle%></td>
        </tr>
        <tr>
          <td width="100%" align="center">Version<%=sVersion%></td>
        </tr>
      </table>
    </td>
  </tr>
  <tr>
    <td width="100%" bgcolor="#FFFFFF" align="center">
<% if lcase(trim(request("action")))="" then %>
<script language="vbscript">
Sub ConfirmSend()
if ChkInputData() then 
    document.send_mail_form.btn_send.disabled=true
    document.send_mail_form.btn_reset.disabled=true
    document.send_mail_form.action="?action=sendmail"
    document.send_mail_form.submit
end if
End Sub

Sub DoPreview()
if ChkInputData() then 
    window.open "?action=preview","SHOW_PREVIEW","menubar=no,toolbar=no,location=no,directories=no,status=no,resizable=0,scrollbars=1,width=420,height=300"
end if
End Sub

Sub ConfirmRet()
If MsgBox("是否清空当前数据？", vbYesNo + vbQuestion + vbDefaultButton2, "<%=sSysTitle%>") = vbYes Then document.send_mail_form.reset
End Sub

Sub ShowSMTPSvr()
    window.open "?action=smtp","SHOW_SMTP","menubar=no,toolbar=no,location=no,directories=no,status=no,resizable=0,scrollbars=0,width=280,height=120"
End Sub

Function ChkInputData()
if trim(document.send_mail_form.sEMail.value)="" then
    MsgBox "邮件发送失败：收件人地址不能为空！", vbOKOnly + vbCritical, "<%=sSysTitle%>"
    document.send_mail_form.sEMail.focus
    ChkInputData=False
    exit function
end if
if CHKMail(trim(document.send_mail_form.sEMail.value))=False then
    MsgBox "邮件发送失败：收件人地址格式错误！", vbOKOnly + vbCritical, "<%=sSysTitle%>"
    document.send_mail_form.sEMail.focus
    document.send_mail_form.sEMail.select
    ChkInputData=False
    exit function
end if
if document.send_mail_form.lAnonymous.checked=false then
    if trim(document.send_mail_form.sSender.value)="" then
         MsgBox "邮件发送失败：因为您选择了非匿名发送，因此发件人名称不能为空！", vbOKOnly + vbCritical, "<%=sSysTitle%>"
         document.send_mail_form.sSender.focus
         ChkInputData=False
         exit function
    end if
    if trim(document.send_mail_form.sFrom.value)="" then
         MsgBox "邮件发送失败：因为您选择了非匿名发送，因此发件人邮件地址不能为空！", vbOKOnly + vbCritical, "<%=sSysTitle%>"
         document.send_mail_form.sFrom.focus
         ChkInputData=False
         exit function
    end if
    
    if CHKMail(trim(document.send_mail_form.sFrom.value))=False then
         MsgBox "邮件发送失败：发件人邮件地址格式错误！", vbOKOnly + vbCritical, "<%=sSysTitle%>"
         document.send_mail_form.sFrom.focus
         document.send_mail_form.sFrom.select
         ChkInputData=False
         exit function
    end if
end if
if trim(document.send_mail_form.sTitle.value)="" then
    MsgBox "邮件发送失败：邮件主题不能为空！", vbOKOnly + vbCritical, "<%=sSysTitle%>"
    document.send_mail_form.sTitle.focus
    ChkInputData=False
    exit function
end if
if Len(trim(document.send_mail_form.sTitle.value))>50 then
    MsgBox "邮件发送失败：邮件主题长度不能大于50字节！", vbOKOnly + vbCritical, "<%=sSysTitle%>"
    document.send_mail_form.sTitle.focus
    document.send_mail_form.sTitle.select
    ChkInputData=False
    exit function
end if
if trim(document.send_mail_form.sContent.value)="" then
    MsgBox "邮件发送失败：邮件主体不能为空！", vbOKOnly + vbCritical, "<%=sSysTitle%>"
    document.send_mail_form.sContent.focus
    ChkInputData=False
    exit function
end if
if Len(trim(document.send_mail_form.sContent.value))>16384 then
    MsgBox "邮件发送失败：邮件主体长度不能大于16K！", vbOKOnly + vbCritical, "<%=sSysTitle%>"
    document.send_mail_form.sContent.focus
    document.send_mail_form.sContent.select
    ChkInputData=False
    exit function
end if
ChkInputData=True
End Function

Function CHKMail(byval sMail)
Dim sMailStr
dim lFoundError
lFoundError=0
sMailStr=sMail
if instr(sMailStr,"@")=0 or instr(sMailStr,".")=0 then lFoundError=1
if lFoundError=1 then
    CHKMail=False
   else
    CHKMail=True
end if    
End Function

Sub SendToDuclika()
if trim(document.send_mail_form.sEMail.value)<>"" or trim(document.send_mail_form.sContent.value)<>"" then
    If MsgBox("系统检测到您好象正在编写邮件，是否清空当前数据？", vbYesNo + vbQuestion + vbDefaultButton1, "<%=sSysTitle%>") = vbNo Then
         Exit Sub
    End If
end if
document.send_mail_form.sEMail.value="Duclika@hotmail.com"
document.send_mail_form.sTitle.value="V-Jmail<%=sVersion%> 发送程序反馈"
document.send_mail_form.sContent.value="请在这里输入您的反馈信息"
document.send_mail_form.sContent.focus
document.send_mail_form.sContent.select
End Sub
</script>
      <form method="post" action="" name="send_mail_form">
      <table border="0" width="100%" bgcolor="#C0C0C0" cellspacing="1" cellpadding="3">
        <tr>
          <td width="19%" bgcolor="#FFFFFF" align="right">收件人地址：</td>
          <td width="81%" bgcolor="#FFFFFF"><input type="text" name="sEMail" size="20">(如:<a href="#" onClick="vbscript:call SendToDuclika()" title="联系作者：Duclika@hotmail.com">Duclika@hotmail.com</a>，多帐号用,分隔)</td>
        </tr>
        <tr>
          <td width="19%" bgcolor="#FFFFFF" align="right">发信人名称：</td>
          <td width="81%" bgcolor="#FFFFFF"><input type="text" name="sSender" size="20">(使用匿名发送时此项没效)</td>
        </tr>
        <tr>
          <td width="19%" bgcolor="#FFFFFF" align="right">发信人地址：</td>
          <td width="81%" bgcolor="#FFFFFF"><input type="text" name="sFrom" size="20">(使用匿名发送时此项没效)</td>
        </tr>
        <tr>
          <td width="19%" bgcolor="#FFFFFF" align="right">邮件主题：</td>
          <td width="81%" bgcolor="#FFFFFF"><input type="text" name="sTitle" size="47"></td>
        </tr>
        <tr>
          <td width="19%" bgcolor="#FFFFFF" align="right">邮件主体：</td>
          <td width="81%" bgcolor="#FFFFFF"><textarea rows="7" name="sContent" cols="46"></textarea></td>
        </tr>
        <tr>
          <td width="19%" bgcolor="#FFFFFF" align="right">邮件选项：</td>
          <td width="81%" bgcolor="#FFFFFF">
              <input type="checkbox" name="lAnonymous" value="1">匿名发送(使用系统默认名称)                                                                                                                         
              <input type="checkbox" name="lHTML" value="1">使用HTML正文                                                                                                                         
              [<a href="#" onClick="vbscript:call DoPreview()">预览</a>]
          </td>
        </tr>
        <tr>
          <td width="19%" bgcolor="#FFFFFF" align="right">　</td>
          <td width="81%" bgcolor="#FFFFFF">
              <input type="button" value="立即发送" name="btn_send" onClick="vbscript:call ConfirmSend()">
              <input type="button" value="重写" name="btn_reset" onClick="vbscript:call ConfirmRet()">
              <input type="button" value="SMTP服务器" onClick="vbscript:call ShowSMTPSvr()" <%if lShowSMTPSvr=0 then response.write "disabled"%>>
              <input type="button" value="官方网站" onClick="javascript:window.open('http://www.anysecond.net/');">
          </td>
        </tr>
      </table>
      </form><%
   else
      response.write "<script language=vbscript>" & vbCrLf & "Sub SendToDuclika()" & vbCrLf & "End Sub" & vbCrLf & "</script>"
end if
Sub VJMail_Config()
Call V_JMail_Config()
if sMailUser="" or sSenderPassword="" or sSMTPServer="" or (Not IsNumeric(lShowSMTPSvr)) then
   response.write "系统初始化错误，请联系管理员"
   response.end
end if
if sSysTitle="" then sSysTitle="V-Jmail 在线邮件代发系统"
if sVersion="" then sVersion="1.0"
End Sub
if lcase(trim(request("action")))="sendmail" then
if len(request("lAnonymous"))=0 then
    lAnonymous=0
   else
    lAnonymous=clng(request("lAnonymous"))
end if
if len(request("lHTML"))=0 then
    lHTML=0
   else
    lHTML=clng(request("lHTML"))
end if
sRecMail=lcase(trim(request("sEMail")))
if instr(sRecMail,"@")=0 or instr(sRecMail,".")=0 then sErrorMsg=sErrorMsg & "·收件人邮件格式错误<br>"
sFromName=trim(request("sSender"))
if sFromName="" then
   if lAnonymous=1 then
      sFromName=Request.ServerVariables("REMOTE_ADDR")
     else
      sErrorMsg=sErrorMsg & "·发件人名称为空<br>"
   end if
end if
sFromMail=trim(request("sFrom"))
if sFromMail="" then
   if lAnonymous=1 then
      sFromMail="Anonymous@anysecond.net"
     else
      sErrorMsg=sErrorMsg & "·发件人邮件为空<br>"
   end if
  else
   if instr(sFromMail,"@")=0 or instr(sFromMail,".")=0 then sErrorMsg=sErrorMsg & "·发件人邮件格式错误<br>"
end if
sMailSubject=trim(request("sTitle"))
if sMailSubject="" then sErrorMsg=sErrorMsg & "·邮件主题为空<br>"
sMailBody=request("sContent")
if trim(sMailBody)="" then
    sErrorMsg=sErrorMsg & "·邮件主体为空<br>"
  else
    if lHTML=0 then
        sMailBody=sMailBody
      else
        sMailBody=Trim(sMailBody)
    end if
end if

if sErrorMsg<>"" then
    response.write "邮件发送失败，可能有如下的原因：<br><br>" & sErrorMsg & "<br><a href=javascript:history.back()>·返回</a>"
    response.end
end if

Set JmailMsg = Server.CreateObject("JMail.Message")
JmailMsg.silent = true
JmailMsg.Logging = true
JmailMsg.Charset = "gb2312"
if lHTML=1 then
   JmailMsg.ContentType="text/html"
   sMailBody=sMailBody & "<br><br><p>此邮件是由 V-Jmail 邮件代发程序进行发送。<br>所发送的内容与本程序作者以及[维安达工作室]无关。<br>V-Jmail 支持网页免密码登陆直接发送邮件、匿名邮件<br>详细情况请访问V-Jmail官方网站：<a href=http://www.anysecond.net/ target=_blank>http://www.anysecond.net/</a></p>"
  else
   JmailMsg.ContentType="text/plain"
   sMailBody=sMailBody & vbCrLf & vbCrLf & "此邮件是由 V-Jmail 邮件代发程序进行发送。" & vbCrLf & "所发送的内容与本程序作者以及[维安达工作室]无关。" & vbCrLf & "V-Jmail 支持网页免密码登陆直接发送邮件、匿名邮件" & vbCrLf & "详细情况请访问V-Jmail官方网站：http://www.anysecond.net/"
end if
JmailMsg.MailServerUserName = sMailUser
JmailMsg.MailServerPassword = sSenderPassword
JmailMsg.From = sFromMail
JmailMsg.FromName = sFromName
if instr(sRecMail,",")>0 then
    sRecMailArr=split(sRecMail,",")
    for RecMail_i=0 to UBound(sRecMailArr)
         JmailMsg.AddRecipient sRecMailArr(RecMail_i)
    next
  else
    JmailMsg.AddRecipient sRecMail
end if
JmailMsg.Subject = sMailSubject
JmailMsg.Body = sMailBody & vbCrLf
JmailMsg.Send sSMTPServer

if JmailMsg.ErrorCode>0 then
   response.write "邮件发送失败：" & JmailMsg.ErrorMessage & "<br><br>可能错误来源：" & JmailMsg.ErrorSource & "<br><br><a href=javascript:history.back()>返回</a>"
  else
   response.write "== 邮件已成功发送到以下地址 ==<br><br>"
   if instr(sRecMail,",")>0 then
      for RecMail_i=0 to UBound(sRecMailArr)
         response.write sRecMailArr(RecMail_i) & "<br>"
      next
     else
      response.write sRecMail & "<br>"
   end if
   response.write "<br><a href=?>返回</a>"
end if
JmailMsg.close
set JmailMsg = nothing
end if %>
    </td>
  </tr>
</table>
</body>

</html>