<% Dim arrayemaillinks(50,2) ' for use in emailing download links Dim arrayemaillinkscount sub ExecuteMail(mailtype,My_from,myin_fromaddress,my_to,my_toaddress,my_subject,body,emailformat,Orderattachments, Orderattachmentcount) '***************************************************************************** ' Version 6.50 ' CDONTS, ASPMAIL, JMAIL, ASPEMAIL,OCXMAIL, CDOSYS, DUNDAS ' March 8, 2004 allow xemailuserid, xemailpassword ' Sept 16, 2004 chnage port to 25 for cdosys ' Dec 7, 2006 added arrayemaillinks for mailing extra info '***************************************************************************** dim mailer dim mailerror dim htmlformat dim i Dim my_fromaddress my_fromaddress=myin_fromaddress ' should we force all emails to come from merchant If getconfig("xmailfrommerchant")="Yes" then my_fromaddress=getconfig("xemail") end if ' 'my_system=getconfig("xemailsystem") htmlformat=ucase(emailformat) on error resume next If getconfig("xdebug")="Yes" then Debugwrite "to=" & my_to & "(" & my_toaddress &") from=" & my_from &"("& my_fromaddress &")" debugwrite "attachments=" & orderattachmentcount debugwrite body end if If ucase(mailtype)="CDONTS" Then Set Mailer = Server.CreateObject("CDONTS.NewMail") if err.number<> 0 then mailerror= getlang("langmailerror") & " " & mailtype HandleMailError mailerror exit sub end if Mailer.To = my_toaddress Mailer.From = my_from & " <" & my_fromaddress & ">" Mailer.Subject = my_subject Mailer.Body = body If htmlformat="HTML" then Mailer.BodyFormat = 0 Mailer.MailFormat = 0 end if If Orderattachmentcount>0 then for i = 0 to orderattachmentcount-1 Mailer.AttachFile orderattachments(i) If getconfig("xdebug")="Yes" then Debugwrite "adding " & orderattachments(i) end if next Orderattachmentcount=0 end if Mailer.Send set mailer=nothing exit sub end if if ucase(mailtype)="ASPMAIL" then Set Mailer = Server.CreateObject("SMTPsvg.Mailer") ' response.write "mail error " & err.number if err.number<> 0 then mailerror= getlang("langmailerror") & " " & mailtype HandleMailError mailerror exit sub end if Mailer.AddRecipient my_to, my_toaddress Mailer.RemoteHost = my_system Mailer.FromName = my_from Mailer.FromAddress = my_fromAddress Mailer.Subject = my_subject Mailer.BodyText=body If htmlformat="HTML" then Mailer.ContentType = "text/html" end if If Orderattachmentcount>0 then for i = 0 to orderattachmentcount-1 Mailer.AddAttachment orderattachments(i) next end if If Mailer.SendMail then set Mailer=nothing exit sub else mailerror= getlang("langmailerror") & " " & my_toaddress mailerror=mailerror & "
" & mailer.response HandleMailError mailerror Set mailer=nothing exit sub end if end if If ucase(Mailtype) = "JMAIL" Then Set Mailer = Server.CreateObject("JMail.SMTPMail") if err.number<> 0 then mailerror= getlang("langmailerror") & " " & mailtype HandleMailError mailerror exit sub end if Mailer.ServerAddress = my_system If getconfig("xemailpassword")<>"" then mailer.mailserverpassword=getconfig("xemailpassword") end if if getconfig("Xemailuserid")<>"" then mailer.mailserverusername=getconfig("xemailuserid") end if Mailer.Sender = my_fromAddress Mailer.SenderName = my_from Mailer.AddRecipient my_toaddress Mailer.Subject = my_subject If htmlformat="HTML" then Mailer.ContentType = "text/html" end if Mailer.Body = body If Orderattachmentcount>0 then for i = 0 to orderattachmentcount-1 Mailer.AddAttachment orderattachments(i) next end if If Mailer.execute then set Mailer=nothing exit sub else mailerror= getlang("langmailerror") & " " & my_toaddress HandleMailError mailerror set mailer=nothing exit sub end if end if If ucase(Mailtype) = "ASPEMAIL" Then Set Mailer = Server.CreateObject("Persits.MailSender") 'VP-ASP 6.09 - Not handling mail errors at all if err.number<> 0 then mailerror= getlang("langmailerror") & " " & mailtype HandleMailError mailerror exit sub end if Mailer.Host = my_system Mailer.From = my_fromAddress Mailer.FromName = my_from Mailer.AddAddress my_toaddress, my_to Mailer.Subject = my_subject If htmlformat="HTML" then Mailer.IsHTML = TRUE end if If Orderattachmentcount>0 then for i = 0 to orderattachmentcount-1 Mailer.AddAttachment orderattachments(i) next end if Mailer.Body = body If Mailer.Send then set Mailer=nothing exit sub else mailerror= getlang("langmailerror") & " " & my_toaddress HandleMailError mailerror set mailer=nothing exit sub end if end if If ucase(Mailtype) = "OCXMAIL" Then dim attach attach="" Set mailer = Server.CreateObject("ASPMAIL.ASPMailCtrl.1") 'VP-ASP 6.09 - Not handling mail errors at all if err.number<> 0 then mailerror= getlang("langmailerror") & " " & mailtype HandleMailError mailerror exit sub end if If htmlformat="HTML" then dim result result=Mailer.XHeader ("Content-Type", "text/html") end if If Orderattachmentcount>0 then attach=orderattachments(0) for i = 1 to orderattachmentcount-1 attach=attach & "," & orderattachments(i) next mailerror = mailer.SMAttach(my_system, my_toaddress, my_fromaddress, my_subject, body, attach) else mailerror = mailer.SendMail(my_system, my_toaddress, my_fromaddress, my_subject, body) end if If "" = mailerror Then Set mailer=nothing exit sub Else mailerror=getlang("langmailerror") & " " & my_toaddress & VbCR & mailerror HandleMailError mailerror set mailer=nothing End If exit sub End IF If ucase(Mailtype) = "DUNDAS" Then Set mailer = Server.CreateObject("Dundas.Mailer") 'Mailer object mailer.TOs.Add my_toaddress, my_to mailer.Subject = my_subject mailer.SMTPRelayServers.Add my_system mailer.FromAddress = my_fromaddress mailer.Fromname = my_from If htmlformat="HTML" then Mailer.HTMLBody = body else mailer.Body = body end if If Orderattachmentcount>0 then for i = 0 to orderattachmentcount-1 mailer.Attachments.Add orderattachments(i) next end if mailer.SendMail 'test for success/failure of the SendMail operation using VBScript's Err object If Err.Number <> 0 Then 'an error occurred so output the relevant error string mailerror= getlang("langmailerror") & " " & my_toaddress & " The following error occurred: " & Err.Description HandleMailError mailerror End if Set mailer = Nothing 'release resources exit sub End If If ucase(Mailtype) = "JMAIL43" Then Set Mailer = Server.CreateObject("JMail.Message") if err.number<> 0 then mailerror=langmailerror & " " & mailtype HandleMailError mailerror exit sub end if 'Mailer.ServerAddress = my_system Mailer.From = my_fromAddress Mailer.FromName = my_from Mailer.AddRecipient my_toaddress, my_to Mailer.Subject = my_subject If getconfig("xemailpassword")<>"" then mailer.mailserverpassword=getconfig("xemailpassword") end if if getconfig("Xemailuserid")<>"" then mailer.mailserverusername=getconfig("xemailuserid") end if If htmlformat="HTML" then Mailer.HTMLBody = body else Mailer.Body = body end if If Orderattachmentcount>0 then for i = 0 to orderattachmentcount-1 Mailer.AddAttachment orderattachments(i) next end if If Mailer.Send(my_system) then set Mailer=nothing exit sub else mailerror=langmailerror & " " & my_toaddress HandleMailError mailerror set mailer=nothing exit sub end if end if if ucase(mailtype)="SOFTART" then Set Mailer = Server.CreateObject("SoftArtisans.SMTPMail") ' response.write "mail error " & err.number if err.number<> 0 then mailerror= getlang("langmailerror") & " " & mailtype HandleMailError mailerror exit sub end if Mailer.AddRecipient my_to, my_toaddress Mailer.RemoteHost = my_system Mailer.FromName = my_from Mailer.FromAddress = my_fromAddress Mailer.Subject = my_subject If htmlformat="HTML" then Mailer.HTMLText=body else Mailer.BodyText=body end if If Orderattachmentcount>0 then for i = 0 to orderattachmentcount-1 Mailer.AddAttachment orderattachments(i) next end if If Mailer.SendMail then set Mailer=nothing exit sub else mailerror= getlang("langmailerror") & " " & my_toaddress mailerror=mailerror & "
" & mailer.response HandleMailError mailerror Set mailer=nothing exit sub end if end if If ucase(mailtype)="CDOSYS" then Dim iConf Dim Flds ' Send by connecting to port 2 of the SMTP server. Const cdoSendUsingPort = 2 set Mailer = CreateObject("CDO.Message") set iConf = CreateObject("CDO.Configuration") Set Flds = iConf.Fields ' Set the CDOSYS configuration fields to use port 25 on the SMTP server. ' With Flds flds.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") =cdoSendUsingPort 'ToDo: Enter name or IP address of remote SMTP server. flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") =my_system flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10 'VP-ASP 6.50 - add support for username and password if xmailusername > "" then flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 flds.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = xmailusername end if if xmailpassword > "" then flds.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = xmailpassword end if flds.Update ' End With ' Apply the settings to the message. ' With Mailer Set Mailer.Configuration = iConf Mailer.To = my_toaddress 'ToDo: Enter a valid email address. Mailer.From = my_from & " <" & my_fromaddress & ">" 'ToDo: Enter a valid email address. Mailer.Subject = my_subject If Orderattachmentcount>0 then for i = 0 to orderattachmentcount-1 Mailer.AddAttachment orderattachments(i) next end if If htmlformat="HTML" then Mailer.HTMLBody = body Else Mailer.TextBody = body End if Mailer.Send ' End With Set Mailer=Nothing Set iConf=Nothing exit sub end if mailerror= getlang("langmailerror") & " " & mailtype HandleMailError mailerror end sub Sub HandleMailerror (errormsg) SetSess "mailerror",errormsg If getconfig("xDebug")="Yes" then debugwrite errormsg end if end sub %>