%@ Language=VBScript %>
<% Response.Buffer = True 'enable html buffering so we can use a redirect anywhere in the page %>
<%
'*********************************** IMPORTANT ***********************************
' A folder with the name "4AA80F25-21E4-11D4-9985-0050BAD44BCD"
' will be created at the root of your c:\ drive. If you want to
' delete files uploaded by users then give the default web account
' Full Control permissions for this folder only. Then remove the
' commenting from the "objUpload.Files(j).Delete" line below.
'*********************************** IMPORTANT ***********************************
'*********************************************************************************
'Copyright Dundas Software Ltd. 2000. All Rights Reserved.
'
'PURPOSE: Processes the information POSTED by SendHtmlEmail.asp, and then
' attempts to send the email to the specified address(es) along
' with the specified objects (if any) embedded into the email's body.
'
'CONTROLS USED: Dundas Upload and Mailer controls.
'
'COMMENTS: Maximum amount of posted data is 1 Meg.
' Form values are sent back to the main page using a Querystring.
' A maximum of 1 Megabytes of form data is allowed to be uploaded
' to the server (the sum of the posted form data and all uploaded
' files).
'
'Dundas Software Contact Information:
' Email: sales@dundas.com
' Phone: (800) 463-1492
' (416) 467-5100
' Fax: (416) 422-4801
'*********************************************************************************
Sub DeleteUploads
'removes any files user uploaded to server in temp directory (see section at top of page)
Dim j 'counter variable
For j = 0 To objUpload.Files.Count - 1
'objUpload.Files(j).Delete
Next
End Sub
%>
<%
Dim objUpload 'stores an Upload control object
Dim strTemp 'temp. string variable, used to replace carriage return/linefeed with
in HtmlBody property
Dim objEmail 'stores a Mailer control object
Dim strCurPath 'set to "c:\4AA80F25-21E4-11D4-9985-0050BAD44BCD", it is the path of the storage folder
Dim i 'counter variable
'functions will throw an exception if the operation is unsuccessful, so on error resume next is used
On Error Resume Next
Set objUpload = Server.CreateObject("Dundas.Upload.2") 'Upload object
'trap for Uplaod control creation, if an error occurred provide an appropriate error msg
' with a hyperlink to Uplaod control download
If Err.Number <> 0 Then
Response.Redirect "Error.asp?Error=" & server.URLEncode("You must first install and register the free Dundas Upload Control 2.0 for this demo to work properly.
Click here to download the Upload control.")
End If
Set objEmail = Server.CreateObject("Dundas.Mailer") 'Mailer object
strCurPath = "c:\4AA80F25-21E4-11D4-9985-0050BAD44BCD"
objUpload.DirectoryCreate strCurPath 'create temp directory if it doesn't exist
'before saving data we will make sure that the sum of the form data and all uploaded
' files does not exceed 1 Meg.
objUpload.MaxUploadSize = 1000000
'save the uploaded files to the temp directory. This populates the Upload control's collections!
objUpload.Save strCurPath
'error trap for success/failure
If Err.Number <> 0 Then
Response.Redirect "Error.asp?Error=" & server.URLEncode(Err.Description)
End If
'add specified To field to collection, if user did not enter a value redirect to the error page
If objUpload.Form("txtTo") <> "" Then
objEmail.TOs.Add objUpload.Form("txtTo")
Else
'user has to enter TO field, if he/she hasn't then redirect to the error page
Response.Redirect "Error.asp?Error=" & server.URLEncode("You must enter a value for the TO field.")
End If
'set FromAddress property
If objUpload.Form("txtFrom") <> "" Then
objEmail.FromAddress = objUpload.Form("txtFrom")
End If
'set the Subject property
objEmail.Subject = objUpload.Form("txtSubject")
'add specified Cc field to collection
If objUpload.Form("txtCc") <> "" Then
objEmail.CCs.Add objUpload.Form("txtCc")
End If
'add specified Bcc field to collection
If objUpload.Form("txtBcc") <> "" Then
objEmail.BCCs.Add objUpload.Form("txtBcc")
End If
'check to see if SMTP relay server has been specified, if so add to collection
If objUpload.Form("txtSMTP") <> "" Then
objEmail.SMTPRelayServers.Add objUpload.Form("txtSMTP")
End If
objEmail.HTMLBody = "" 'initialize html body of message
If objUpload.Files.Count > 0 Then 'there is a background picture or sound specified so set the HtmlBody property
'initialize the Body tag
objEmail.HTMLBody = objEmail.HTMLBody & ""
Else
objEmail.HTMLBody = objEmail.HTMLBody & ">" 'close body tag if user uploaded an invalid picture
End If
ElseIf objUpload.Files(i).TagName = "txtBGSound" Then
'check to see if user uploaded a background image, if not then we need to close the body tag
If objUpload.Files(0).TagName = "txtBGSound" Then
objEmail.HTMLBody = objEmail.HTMLBody & ">"
End If
If instr(1,objUpload.Files(i).ContentType,"audio") Then
'set background sound and add to the HtmlEmbeddedObjs collection, making sure user has uploaded a valid audio file
objEmail.HTMLEmbeddedObjs.Add objUpload.Files(i).Path, Cstr(i + 1),objUpload.Files(i).OriginalPath
objEmail.HTMLBody = objEmail.HTMLBody & ""
End If
End If
Next
Else
'no embedded objects specified, so just set the body tag
objEmail.HTMLBody = objEmail.HTMLBody & ""
End If
'now set message body input by user into the textarea element, replacing Cr/Lf with
,
' and also replacing html characters with escape characters
' NOTE: ALTERNATIVELY YOU CAN LEAVE ANY HTML CHARACTERS AS IS, SO THAT THE BODY OF THE EMAIL
' CAN BE FORMATTED WITH HTML TAGS. HOWEVER, CARE MUST THEN BE TAKEN SO THAT DUPLICATE TAGS DO NOT OCCUR
' IF YOU ARE ALSO ADDING TAGS TO THE HTMLBODY PROPERTY PROGRAMMATICALLY
strTemp = server.HTMLEncode(objUpload.Form("txtBody"))
strTemp = Replace(strTemp,vbCrLf,"
")
objEmail.HTMLBody = objEmail.HTMLBody & strTemp
'finish html body by adding closing html tags
objEmail.HTMLBody = objEmail.HTMLBody & ""
'send the email
objEmail.SendMail
'test for success/failure
If Err.Number <> 0 Then
'an error occurred so redirect user to the error page
Dim ErrString
ErrString = Err.Description
Call DeleteUploads 'deletes any files uploaded by user
Set objEmail = Nothing 'release resources
Set objUpload = Nothing
Response.Redirect "Error.asp?Error=" & server.URLEncode(ErrString)
Else
'successful, so redirect back to main page, and set the QueryString variables to store form values to be sent back to main page
Dim item2(5)
item2(0) = objUpload.Form("txtSMTP")
item2(1) = objUpload.Form("txtFrom")
item2(2) = objUpload.Form("txtTo")
item2(3) = objUpload.Form("txtCc")
item2(4) = objUpload.Form("txtBcc")
item2(5) = objUpload.Form("txtSubject")
Call DeleteUploads 'deletes any files uploaded by user
Set objEmail = nothing 'release resources
Set objUpload = nothing
Response.Redirect "SendHtmlEmail.asp?Success=TRUE&Value1=" & server.URLEncode(item2(0)) & "&Value2=" & server.URLEncode(item2(1)) & "&Value3=" & server.URLEncode(item2(2)) & "&Value4=" & server.URLEncode(item2(3)) & "&Value5=" & server.URLEncode(item2(4)) & "&Value6=" & server.URLEncode(item2(5))
End If
%>