File: D:/bin/dundas/FreeLibs/AspMail/Samples/SendHtmlEmail_Process.asp
<%@ 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
%>
<HTML>
<HEAD>
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
</HEAD>
<BODY>
<%
Dim objUpload 'stores an Upload control object
Dim strTemp 'temp. string variable, used to replace carriage return/linefeed with <br> 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 <b>free</b> Dundas Upload Control 2.0 for this demo to work properly.</font><br><br>Click <a href=http://www.dundas.com/index.asp?downloads/register.asp?ProdID=22>here</a> 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 = "<Html><Head></Head>" '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 & "<body "
'loop through uploaded files to be embedded, adding the appropriate tags as needed
' NOTE: we use the Name property of the File object to let us know what file input box the file came from
For i = 0 To objUpload.Files.Count - 1
If objUpload.Files(i).TagName = "txtBGPicture" Then
'set background picture and add to the HtmlEmbeddedObjs collection, first making sure that the user uploaded a valid picture file
If instr(1,objUpload.Files(i).ContentType,"image") Then
objEmail.HTMLEmbeddedObjs.Add objUpload.Files(i).Path,Cstr(i + 1),objUpload.Files(i).OriginalPath
objEmail.HTMLBody = objEmail.HTMLBody & "background=cid:" & CStr(i + 1) & ">"
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 & "<BGSound src=cid:" & CStr(i + 1) & "></BGSOUND>"
End If
End If
Next
Else
'no embedded objects specified, so just set the body tag
objEmail.HTMLBody = objEmail.HTMLBody & "<body>"
End If
'now set message body input by user into the textarea element, replacing Cr/Lf with <br>,
' 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,"<br>")
objEmail.HTMLBody = objEmail.HTMLBody & strTemp
'finish html body by adding closing html tags
objEmail.HTMLBody = objEmail.HTMLBody & "</body></html>"
'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
%>
</BODY>
</HTML>