用asp发送邮件程序

<%
Dim NewCloud_Ads
Dim Rs
Dim SQL
Dim NowStats
Dim HtmlTitle
Dim Style_CSS
Dim HtmlTempStr
Dim TempTopStr
Dim TempFootStr
Dim boardtype
Dim FoundErr
Dim ErrMsg
Dim ID
Dim SucMsg
Dim topic
Dim mailbody
Dim announce
Dim useremail
ArticlEndMail
CloseConn
Public Sub ArticlEndMail()
 On Error Resume Next
 Newasp.LoadTemplates ("")
 Set NewCloud_Ads = Server.CreateObject("NewCloudAsp.Admin_Adcolumn")
 Set Rs = Server.CreateObject("adodb.recordset")
 NowStats = "邮件打包发送"
 HtmlTitle = "邮件打包发送"
 TempTopStr = Newasp.mainhtml(0) & Newasp.mainhtml(1) & Newasp.mainhtml(2) & Newasp.mainhtml(3)
 TempFootStr = Newasp.mainhtml(4)
 Style_CSS = Replace(Replace(Newasp.Style_CSS, "{$SetupDir}", Newasp.SetupDir), "{$PicUrl}", Newasp.TempDir)
 HtmlTempStr = TempTopStr
 HtmlTempStr = Replace(HtmlTempStr, "{$NavMenu}", Newasp.SortingMenu)
 HtmlTempStr = Replace(HtmlTempStr, "{$Width}", Newasp.mainset(0))
 HtmlTempStr = Replace(HtmlTempStr, "{$Style_CSS}", Style_CSS)
 If CInt(Newasp.Setting(5)) = 0 Then
  HtmlTempStr = Replace(HtmlTempStr, "{$TopMeun}", Newasp.mainset(9))
 Else
  HtmlTempStr = Replace(HtmlTempStr, "{$TopMeun}", Newasp.mainset(10))
 End If
 HtmlTempStr = Replace(HtmlTempStr, "{$NowStats}", NowStats)
 HtmlTempStr = Replace(HtmlTempStr, "{$Title}", HtmlTitle)
 HtmlTempStr = Replace(HtmlTempStr, "{$Adcolumn(0)}", NewCloud_Ads.RunScriptAds(7))
 HtmlTempStr = Replace(HtmlTempStr, "{$Adcolumn(1)}", NewCloud_Ads.BannerAds(7))
 HtmlTempStr = Replace(HtmlTempStr, "{$Adcolumn(2)}", NewCloud_Ads.AdsColumn(7, 2))
 HtmlTempStr = Replace(HtmlTempStr, "{$Adcolumn(3)}", NewCloud_Ads.AdsColumn(7, 3))
 Response.Write HtmlTempStr
 TempFootStr = Replace(TempFootStr, "{$FootMeun}", Newasp.mainset(11))
 TempFootStr = Replace(TempFootStr, "{$Width}", Newasp.mainset(0))
 TempFootStr = Replace(TempFootStr, "{$Adcolumn(4)}", NewCloud_Ads.ScriptFloatAds(7))
 TempFootStr = Replace(TempFootStr, "{$Adcolumn(5)}", NewCloud_Ads.ScriptFixedAds(7))
 Response.Write "

 Response.Write Newasp.mainset(0)
 Response.Write """ class=TableBorder border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" class=""Border"">"
 Response.Write " "
 Response.Write " "
 Response.Write " "
 Response.Write " "
 Response.Write " "
 Response.Write " "
 Response.Write "

邮件打包发送
"  FoundErr = False  ID = CLng(Request("ID"))  If Not IsNumeric(ID) And ID<>"" then     Response.write"错误的系统参数!ID必须是数字"   Exit Sub   Response.End  End If  If ID = "" Then   FoundErr = True   ErrMsg = ErrMsg + " " + " 请指定相关文章 "   Exit Sub  End If  Set Rs = Server.CreateObject("adodb.recordset")  If FoundErr Then   Call errormsg  Else   Call showPage  End If  Response.Write " "  Response.Write "

"
 Response.Write TempFootStr
 Set NewCloud_Ads = Nothing
End Sub
Private Sub showPage()
 On Error Resume Next
 If FoundErr Then
  Call errormsg
 Else
  If Request("action") = "sendmail" Then
   If IsValidEmail(Trim(Request.Form("mail"))) = False Then
    ErrMsg = ErrMsg + "
" + "

您的Email有错误!

"
    FoundErr = True
   Else
    useremail = Trim(Request.Form("mail"))
   End If
   If SendMail = "OK" Then
    Call success
   End If
   Call announceinfo
   If FoundErr Then
    Call errormsg
   Else
    Call success
   End If
  Else
   Call pag
  End If
 End If
 If Err.Number <> 0 Then Err.Clear
End Sub
Private Sub announceinfo()
 topic = "您从" & Newasp.Setting(0) & "发来的文章资料"
 mailbody = mailbody & ""
 Rs.Open "Select title,content,infotime,writer from NC_Article where id=" & ID & "", conn, 1, 1
 If Rs.bof And Rs.Eof Then
  FoundErr = True
  ErrMsg = ErrMsg + "
" + "

没有有找到相关文章

"
 Else
  announce = announce & ""
  announce = announce & "

"   announce = announce & "--  作者：" & Rs("writer") & " "   announce = announce & "--  发布时间：" & Rs("infotime") & " "   announce = announce & "--  " & Rs("title") & " "   announce = announce & "" & Rs("content") & ""   announce = announce & "

"
 End If
 Rs.Close
 mailbody = mailbody + announce
 mailbody = mailbody & "新云网络"
 Select Case CInt(Newasp.Setting(10))
  Case 0
   SucMsg = SucMsg + "对不起!系统未开启邮件功能。"
  Case 1
   Call Jmail(useremail, topic, mailbody)
  Case 2
   Call Cdonts(useremail, topic, mailbody)
  Case 3
   Call aspemail(useremail, topic, mailbody)
  Case Else
   SucMsg = SucMsg + "系统未开启邮件功能，请记住您的注册信息。"
 End Select
 If SendMail = "OK" Then
  SucMsg = SucMsg + "恭喜您，您的打包邮递发送成功。"
 Else
  SucMsg = SucMsg + "由于系统错误，您的打包邮递发送未成功。"
 End If
End Sub
Private Sub pag()
 Response.Write ""
 Response.Write " "
 Response.Write "

"  Response.Write " "  Response.Write "  Response.Write ID  Response.Write """ method=post>"  Response.Write " "  Response.Write " "  Response.Write " "  Response.Write " "  Response.Write " "  Response.Write " "  Response.Write " "  Response.Write " "  Response.Write " 打包邮递 "  Response.Write " 把本文打包邮递。 请正确输入你要邮递的邮件地址！"  Response.Write " 邮递的 Email 地址：

"
End Sub
Private Sub success()
 Response.Write " "
 Response.Write " "
 Response.Write "

"  Response.Write " "  Response.Write " "  Response.Write " "  Response.Write " "  Response.Write " "  Response.Write " "  Response.Write " "  Response.Write " "  Response.Write " "  Response.Write " "  Response.Write " 成功：打包邮递 "  Response.Write SucMsg  Response.Write " "  Response.Write " << 返回上一页"  Response.Write "

"
End Sub
Private Sub errormsg()
 Response.Write "
"
 Response.Write " "
 Response.Write " "
 Response.Write "

"  Response.Write " "  Response.Write " "  Response.Write " "  Response.Write " "  Response.Write " "  Response.Write " "  Response.Write " "  Response.Write " "  Response.Write " "  Response.Write " "  Response.Write " 错误信息 产生错误的可能原因： "  Response.Write ErrMsg  Response.Write " "  Response.Write " << 返回上一页"  Response.Write "

"
End Sub
%>