home *** CD-ROM | disk | FTP | other *** search
/ bombers.k12.ar.us / bombers.k12.ar.us.tar / bombers.k12.ar.us / survey / SendEmailMessageAction.asp < prev    next >
Text File  |  2006-11-29  |  12KB  |  308 lines
  1. <!--#Include File="Include/Top_inc.asp"-->
  2. <%
  3. '***********************************************************************
  4. '   Application: SelectSurveyASP Advanced v8.1.5
  5. '   Author: Aaron Baril for ClassApps.com
  6. '   Page Description: This page is called from SendEmailMessage2.asp and sends the emails
  7. '                      for the data input on the SendEmailMessage2.asp and
  8. '                      SendEmailMessage2.asp pages.
  9. '
  10. '   COPYRIGHT NOTICE
  11. '
  12. '   See attached Software License Agreement
  13. '
  14. '   (c) Copyright 2002 - 2006 by ClassApps.com.  All rights reserved.
  15. '***********************************************************************
  16.  
  17. 'Buffering must be on for sending emails
  18. Response.Buffer = True
  19. Server.ScriptTimeout = 1500
  20.  
  21. 'If the user does not have "Create" or "Admin" permission, redirect to the access denied page.
  22. If lngUserSecurityLevel <> SUR_SECURITY_LEVEL_CREATE And lngUserSecurityLevel <> SUR_SECURITY_LEVEL_ADMIN Then
  23.     Response.Redirect "AccessDenied.asp?Reason=" & SUR_ACCESS_DENIED_NOT_ADMIN_SECURITY_LEVEL
  24. End If
  25. %>
  26. <!--#Include File="Include/SurveyUtility_inc.asp"-->
  27. <!--#Include File="Include/Utility_inc.asp"-->
  28. <!--#Include File="Include/Constants_inc.asp"-->
  29. <!--#Include File="Include/Config_inc.asp"-->
  30. <!--#Include File="Include/ID_inc.asp"-->
  31. <!--#Include File="Include/Email_inc.asp"-->
  32. <!--#Include File="Include/adovbs_inc.asp"-->
  33. <!--#Include File="Include/CurrentUser_inc.asp"-->
  34. <!--#Include File="Include/SurveySecurity_inc.asp"-->
  35. <!--#Include File="Include/Encryption_inc.asp"-->
  36.  
  37. <html>
  38. <head>
  39.     <title>Send Email Message Confirmation</title>
  40.     <link rel="stylesheet" href="Resources/StyleSheet/SurveyStyle.css">
  41. </head>
  42.  
  43. <body class="MainBodyStyle">
  44.  
  45. <!--#Include File="Include/FrameworkTop_inc.asp"-->
  46.  
  47. <table border="0" cellspacing="0" cellpadding="0" width="754" class="MediumBlueBackgroundColor">
  48.     <tr>
  49.         <td height="36" valign="center">
  50.               <span class="H1HeadingStyle"><a name="skipnav" tabindex="1">Send Email Message</a></span> <img style="cursor:hand" alt="Help" onClick="javascript:window.open('Help/Help.htm#EmailMessages', null, 'menubar=no,toolbar=no,titlebar=no,status=no,left=10,top=10,scrollbars=yes,resizable=yes,height=550,width=770');" border="0" src="Resources/Images/Help.gif">
  51.         </td>
  52.     </tr>
  53. </table>
  54.  
  55. <!--#Include File="Include/FrameworkTop2_inc.asp"-->
  56.  
  57. <table width="740" border="0" cellpadding="0" cellspacing="6" class="LightGrayBackgroundColor">
  58.     <tr>
  59.         <td width="1"></td>
  60.             <td height="36" valign="center">
  61.             <span class="H2HeadingStyle">Email Message Sent</span>
  62.         </td>
  63.         <td width="1"> </td>
  64.     </tr>
  65. </table>
  66. <table border="0" cellpadding="0" cellspacing="0" width="100%"><tr><td height="1" background="Resources/Images/ThinDivider.gif"></td></tr>
  67. <table border="0" cellpadding="0" cellspacing="6" width="740" class="WhiteBackgroundColor">
  68.     <tr>
  69.         <td width="1" rowspan="10"></td>
  70.         <td>
  71.             <br>
  72.             <span class="Normal">The following emails were sent:</span>
  73.         </td>
  74.         <td width="1" rowspan="10"> </td>
  75.     </tr>
  76.     <tr>
  77.         <td width="730" valign="top" height="80">
  78.             <span class="Normal">
  79. <%
  80.                 Dim strBody
  81.                 Dim strEmailAddress
  82.                 Dim strFirstName
  83.                 Dim strLastName
  84.                 Dim strCustomData1
  85.                 Dim strCustomData2
  86.                 Dim strCustomData3
  87.                 Dim strSQL
  88.                 Dim rsEmailList
  89.                 Dim strDisplay
  90.                 Dim flgEmailInHTMLFormat
  91.                 Dim lngEmailMessageID
  92.                 Dim conEmailMessage
  93.                 Dim lngEmailSentCount
  94.                 Dim strURLUniqueID
  95.                 Dim strTempURL
  96.  
  97.                 'Initialization
  98.                 Set rsEmailList = Server.CreateObject("ADODB.Recordset")
  99.                 Set conEmailMessage = Server.CreateObject("ADODB.Connection")
  100.                 conEmailMessage.Open SURVEY_APP_CONNECTION
  101.                 lngEmailMessageID = ID_GetNextAvailableID("SurveyGenerationEmailMessage")
  102.                 If Request.Form("chkHTMLFormat") = "on" Then
  103.                     flgEmailInHTMLFormat = True
  104.                 Else
  105.                     flgEmailInHTMLFormat = False
  106.                 End If
  107.                 lngEmailSentCount = 0
  108.  
  109.                 'Insert a record into the email message table for this message
  110.                 strSQL = "INSERT INTO sur_email_message(email_message_id, email_list_id, email_subject, email_body, " & _
  111.                          "email_cc_addresses, email_bcc_addresses, email_from_address, html_yn, survey_id, " & _
  112.                          "sent_date, email_sent_count, email_response_count) VALUES(" & _
  113.                          lngEmailMessageID & ", " & _
  114.                          Request.Form("EmailListID") & ", " & _
  115.                          SQLEncode(Request.Form("txtSubject")) & ", " & _
  116.                          SQLEncode(Request.Form("txtEmailText")) & ", " & _
  117.                          SQLEncode(Request.Form("txtCCAddress")) & ", " & _
  118.                          SQLEncode(Request.Form("txtBCCAddress")) & ", " & _
  119.                          SQLEncode(Request.Form("txtFromAddress")) & ", "
  120.                 If flgEmailInHTMLFormat = True Then
  121.                     strSQL = strSQL & SQLEncode(SUR_BOOLEAN_POSITIVE) & ", "
  122.                 Else
  123.                     strSQL = strSQL & SQLEncode(SUR_BOOLEAN_NEGATIVE) & ", "
  124.                 End If
  125.                 strSQL = strSQL & Request.Form("cboSurvey") & ", GETDATE(), 0, 0)"
  126.                 conEmailMessage.Execute ConvertSQL(strSQL), , adCmdText
  127.  
  128.                 'Get the list of email addresses for the email list
  129.                 strSQL = "SELECT email_address_id, email_address, first_name, last_name, custom_data_1, " & _
  130.                             "custom_data_2, custom_data_3 " & _
  131.                             "FROM sur_email_address " & _
  132.                             "WHERE email_list_id = " & Request.Form("EmailListID") & _
  133.                             " AND deleted_yn = " & SQLEncode(SUR_BOOLEAN_NEGATIVE)
  134.  
  135.                 'If the user is filtering the email addresses, add a filter to the query
  136.                 If CStr(Request.Form("FilterType")) = CStr(SUR_EMAIL_LIST_WITH_FILTER) Then
  137.                     'Add the filter for the active flag
  138.                     If Request.Form("Active") <> SUR_COMBO_ALL Then
  139.                         strSQL = strSQL & " AND active_yn = " & SQLEncode(Request.Form("Active"))
  140.                     End If
  141.  
  142.                     'Add the filter for the email address
  143.                     If Len(Trim(Request.Form("EmailAddress"))) > 0 Then
  144.                         strSQL = strSQL & " AND email_address LIKE " & SQLEncodeContains(Request.Form("EmailAddress"))
  145.                     End If
  146.  
  147.                     'Add the filter for the first custom data field
  148.                     If Len(Trim(Request.Form("CustomData1"))) > 0 Then
  149.                         strSQL = strSQL & " AND custom_data_1 LIKE " & SQLEncodeContains(Request.Form("CustomData1"))
  150.                     End If
  151.  
  152.                     'Add the filter for the second custom data field
  153.                     If Len(Trim(Request.Form("CustomData2"))) > 0 Then
  154.                         strSQL = strSQL & " AND custom_data_2 LIKE " & SQLEncodeContains(Request.Form("CustomData2"))
  155.                     End If
  156.  
  157.                     'Add the filter for the third custom data field
  158.                     If Len(Trim(Request.Form("CustomData3"))) > 0 Then
  159.                         strSQL = strSQL & " AND custom_data_3 LIKE " & SQLEncodeContains(Request.Form("CustomData3"))
  160.                     End If
  161.                 End If
  162.  
  163.                 'Open the list of email addresses
  164.                 rsEmailList.Open ConvertSQL(strSQL), SURVEY_APP_CONNECTION, adOpenForwardOnly, adLockReadOnly, adCmdText
  165.  
  166.                 'Loop through the email addresses
  167.                 'rsEmailList.MoveFirst
  168.                 Do While Not rsEmailList.EOF
  169.                     'Get the text of the email, with tokens.
  170.                     strBody = Request.Form("txtEmailText")
  171.  
  172.                     'Get the email address
  173.                     strEmailAddress = rsEmailList("email_address")
  174.  
  175.                     'Set the first name, if provided, to be used in replacing the token in the email, below
  176.                     If Len(rsEmailList("first_name")) > 0 Then
  177.                         strFirstName = Trim(rsEmailList("first_name"))
  178.                     Else
  179.                         strFirstName = ""
  180.                     End If
  181.  
  182.                     'Set the last name, if provided, to be used in replacing the token in the email, below
  183.                     If Len(rsEmailList("last_name")) > 0 Then
  184.                         strLastName = Trim(rsEmailList("last_name"))
  185.                     Else
  186.                         strLastName = ""
  187.                     End If
  188.  
  189.                     'Set the first custom data fields, if provided, to be used in replacing the token in the email, below
  190.                     If Len(rsEmailList("custom_data_1")) > 0 Then
  191.                         strCustomData1 = Trim(rsEmailList("custom_data_1"))
  192.                     Else
  193.                         strCustomData1 = ""
  194.                     End If
  195.  
  196.                     'Set the second custom data fields, if provided, to be used in replacing the token in the email, below
  197.                     If Len(rsEmailList("custom_data_2")) > 0 Then
  198.                         strCustomData2 = Trim(rsEmailList("custom_data_2"))
  199.                     Else
  200.                         strCustomData2 = ""
  201.                     End If
  202.  
  203.                     'Set the third custom data fields, if provided, to be used in replacing the token in the email, below
  204.                     If Len(rsEmailList("custom_data_3")) > 0 Then
  205.                         strCustomData3 = Trim(rsEmailList("custom_data_3"))
  206.                     Else
  207.                         strCustomData3 = ""
  208.                     End If
  209.  
  210.                     'Generate a string to be encrypted as a unique identifier for this email
  211.                     strURLUniqueID = Encrypt(SUR_ENCRYPTION_EMAIL_PART_1 & Request.Form("cboSurvey") & SUR_ENCRYPTION_EMAIL_PART_2 & rsEmailList("email_address_id") & SUR_ENCRYPTION_EMAIL_PART_3 & lngEmailMessageID & SUR_ENCRYPTION_EMAIL_PART_4)
  212.  
  213.                     'Replace all of the tokens
  214.                     strBody = Replace(strBody, "#FirstName#", strFirstName)
  215.                     strBody = Replace(strBody, "#LastName#", strLastName)
  216.                     strBody = Replace(strBody, "#CustomData1#", strCustomData1)
  217.                     strBody = Replace(strBody, "#CustomData2#", strCustomData2)
  218.                     strBody = Replace(strBody, "#CustomData3#", strCustomData3)
  219.                     strTempURL = SUR_APPLICATION_ROOT_URL & "/TakeSurvey.asp?EID=" & strURLUniqueID
  220.                     If flgEmailInHTMLFormat = True Then
  221.                         strTempURL = "<a href=""" & strTempURL & """>" & strTempURL & "</a>"
  222.                     End If
  223.                     strBody = Replace(strBody, "#SurveyLink#", strTempURL)
  224.                     strTempURL = SUR_APPLICATION_ROOT_URL & "/DeclineSurvey.asp?EID=" & strURLUniqueID
  225.                     If flgEmailInHTMLFormat = True Then
  226.                         strTempURL = "<a href=""" & strTempURL & """>" & strTempURL & "</a>"
  227.                     End If
  228.                     strBody = Replace(strBody, "#DeclineLink#", strTempURL)
  229.  
  230.                     'Make sure the email address is valid before sending the email
  231.                     If IsValidEmailAddress(strEmailAddress) = True Then
  232.                         'Send the email
  233.                         SendMail strEmailAddress, Request.Form("txtFromAddress"), Request.Form("txtCCAddress"), Request.Form("txtBCCAddress"), strBody, Request.Form("txtSubject"), flgEmailInHTMLFormat
  234.  
  235.                         'Track the number of emails sent
  236.                         lngEmailSentCount = lngEmailSentCount + 1
  237.  
  238.                         'Insert a record into the database recording the sent email
  239.                         strSQL = "INSERT INTO sur_email_sent_history(email_address_id, email_message_id, " & _
  240.                                  "url_unique_id, response_date, response_id, current_status) VALUES(" & _
  241.                                  rsEmailList("email_address_id") & ", " & _
  242.                                  lngEmailMessageID & ", " & _
  243.                                  SQLEncode(strURLUniqueID) & ", " & _
  244.                                  "Null, " & _
  245.                                  "Null, " & _
  246.                                  SQLEncode(SUR_EMAIL_STATUS_NO_RESPONSE) & ")"
  247.                         conEmailMessage.Execute ConvertSQL(strSQL), , adCmdText
  248.  
  249.                         strDisplay = Now() & ": Sent to " & strEmailAddress
  250.                         If Len(strFirstName) > 0 Or Len(strLastName) > 0 Then
  251.                             strDisplay = strDisplay & " ("
  252.                         End If
  253.                         If Len(strFirstName) > 0 Then
  254.                             strDisplay = strDisplay & strFirstName & " "
  255.                         End If
  256.                         If Len(strLastName) > 0 Then
  257.                             strDisplay = LTrim(strDisplay) & strLastName
  258.                         End If
  259.                         If Len(strFirstName) > 0 Or Len(strLastName) > 0 Then
  260.                             strDisplay = Trim(strDisplay) & ")"
  261.                         End If
  262.                         Response.Write strDisplay & "<br>"
  263.                     Else 'Email address in not valid
  264.                         If Len(Trim(strEmailAddress)) > 0 And Trim(strEmailAddress) <> vbCrLf Then
  265.                             Response.Write Now() & ": INVALID EMAIL ADDRESS: " & strEmailAddress & "<br>"
  266.                         End If
  267.                     End If
  268.  
  269.                     'Flush after each email so the progress can be seen on the page
  270.                     Response.Flush
  271.  
  272.                     rsEmailList.MoveNext
  273.                 Loop
  274.  
  275.                 'After sending all of the emails, update the email message table with the number of emails sent
  276.                 strSQL = "UPDATE sur_email_message " & _
  277.                          "SET email_sent_count = " & lngEmailSentCount & _
  278.                          " WHERE email_message_id = " & lngEmailMessageID
  279.                 conEmailMessage.Execute ConvertSQL(strSQL), , adCmdText
  280.  
  281.                 'Clean up
  282.                 conEmailMessage.Close
  283.                 Set conEmailMessage = Nothing
  284.                 rsEmailList.Close
  285.                 Set rsEmailList = Nothing
  286. %>
  287.             </span>
  288.             <br>
  289.         </td>
  290.     </tr>
  291.     <tr>
  292.         <td align="right">
  293.             <a href="EmailListList.asp"><img border="0" alt="Click to return to the list of email lists" src="Resources/Buttons/OK.gif" name="btnOK"></a>
  294.             <br>
  295.         </td>
  296.     </tr>
  297. </table>
  298.  
  299. <!--#Include File="Include/FrameworkBottom_inc.asp"-->
  300.  
  301. </body>
  302. </html>
  303.  
  304. <%
  305.     'Ensure that the web server returns the page
  306.     Response.Flush
  307. %>
  308.