<%@ Language=VBScript %> <% Option Explicit On Error Resume Next Response.contentType = "text/html" Dim xmldoc, xmlfound xmlfound = False Err.Clear Set xmldoc = Server.CreateObject("MSXML.DOMDocument") If Not Err Then xmlfound = True Err.Clear Set xmldoc = Server.CreateObject("MSXML2.DOMDocument") If Not Err Then xmlfound = True Err.Clear Set xmldoc = Server.CreateObject("MSXML3.DOMDocument") If Not Err Then xmlfound = True Err.Clear If Not xmlfound Then Response.Write "Cannot create XML component." Response.End End If Dim g_mail_mode, g_mail_cmdline, g_mail_smtpgateway, g_mail_fromAddr, g_mail_toAddr, g_mail_subject Dim g_strResultsPath GetSentVar g_mail_mode, "mode" GetSentVar g_mail_cmdline, "cmdline" GetSentVar g_mail_smtpgateway, "smtpgateway" GetSentVar g_mail_toAddr, "email" g_mail_subject = "Quask Email Configuration Test" g_mail_fromAddr = "support@quask.com" g_strResultsPath = "quaskemailtest.txt" If (g_mail_mode = 0) Then SendEMailsCDONTS g_mail_subject, "test" Else SendEMailsCDOSYS g_mail_subject, "test" End If Response.Write "OK" Response.End Function SendEMailsCDONTS(strBody, strAttach) Dim strEMails Dim objMail Dim fso, f, strAttachPath, i Dim intLoop Randomize Err.Clear Set fso = Server.CreateObject("Scripting.FileSystemObject") For i = 1 To 5 strAttachPath = Server.MapPath(g_strResultsPath & Request.ServerVariables("REMOTE_ADDR") & "_" & CLng(Rnd * 1000000) & ".pvw") Set f = fso.CreateTextFile(strAttachPath, True) If (Not Err) Then f.Write strAttach f.Close Set f = Nothing Exit For End If Set f = Nothing Next If Err Then Response.Write "Cannot write attachment to file (" & Err.description & ")." Response.End End If strEMails = Split(g_mail_toAddr, ";", -1, 1) For intLoop = 0 To UBound(strEMails) Set objMail = Server.CreateObject("CDONTS.NewMail") If (Not Err) Then objMail.From = g_mail_fromAddr objMail.To = strEMails(intLoop) objMail.Subject = g_mail_subject objMail.BodyFormat = 0 objMail.MailFormat = 0 objMail.Body = strBody objMail.AttachFile strAttachPath, "View Form.qrd", 1 objMail.Send Else Response.Write "CDONTS component failed (" & Err.description & ")." Response.End End If Set objMail = Nothing Next fso.DeleteFile strAttachPath Set fso = Nothing ReDim strEMails(0) End Function Function SendEMailsCDOSYS(strBody, strAttach) Dim strEMails Dim objMail Dim fso, f, strAttachPath Dim iFlds, iMsg, Flds, iConf, iBPF, iBP, intLoop, i Randomize Err.Clear Set fso = Server.CreateObject("Scripting.FileSystemObject") For i = 1 To 5 strAttachPath = Server.MapPath(g_strResultsPath & Request.ServerVariables("REMOTE_ADDR") & "_" & CLng(Rnd * 1000000) & ".pvw") Set f = fso.CreateTextFile(strAttachPath, True) If (Not Err) Then f.Write strAttach f.Close Set f = Nothing Exit For End If Set f = Nothing Next If Err Then Response.Write "Cannot write attachment to file (" & Err.description & ")." Response.End End If strEMails = Split(g_mail_toAddr, ";", -1, 1) Set iMsg = CreateObject("CDO.Message") Set iConf = CreateObject("CDO.Configuration") Set Flds = iConf.Fields If (Err) Then Response.Write "CDO component failed (" & Err.description & ")." Response.End Else For intLoop = 0 To UBound(strEMails) Set iMsg = Nothing Set iConf = Nothing Set Flds = Nothing Set iMsg = CreateObject("CDO.Message") Set iConf = CreateObject("CDO.Configuration") Set Flds = iConf.Fields Flds.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 Flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = g_mail_smtpgateway Flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 Flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10 Flds.Update Set iMsg.Configuration = iConf iMsg.To = strEMails(intLoop) iMsg.From = g_mail_fromAddr iMsg.Subject = g_mail_subject iMsg.HTMLBody = strBody Set iBP = iMsg.AddAttachment(strAttachPath) Set iBPF = iBP.Fields iBPF.Item("urn:schemas:mailheader:content-type") = "text/xml; name=View Form.qrd;" iBPF.Update iMsg.Send Set iBP = Nothing Set iBPF = Nothing Set iFlds = Nothing Set iConf = Nothing Set iMsg = Nothing Next End If fso.DeleteFile strAttachPath Set fso = Nothing ReDim strEMails(0) End Function Sub GetSentVar(var, varName) If ((Request.QueryString.Count > 0) And (Request.QueryString(varName) <> "")) Then var = Request.QueryString(varName) End If If ((Request.Form.Count > 0) And (Request.Form(varName) <> "")) Then var = Request.Form(varName) End If End Sub %>