troubleshooting Question
"Unable To Send E-Mail" error when pressing submit button in web form from CoffeeCup Web Form software.
asked on
Unable To Send E-Mail
We're sorry but we were unable to send your e-mail. If you are sure that you entered all your email addresses properly, you should contact your server administrator.
VBScript Version: 5
Software Version: 8.0
Software Last Updated: 08/31/2007
Script Version: 5.0
Script Last Updated: 02/25/2009
CDOSYS: Available
ADODB: Available
I get this error when i submit the form.
You can view the page here:
http://www.platinumsoundproductions.com/booknow.aspx
I am running windows server 2003
IIS7
Microsoft Exchange 2003.
My SMTP settings for authentication are.
Anonymous access is unchecked.
basic authentication is also unchecked ( i have tried both ways)
Integrated Windows Authentication is checked ( with Authenticated users allowing permission for both submit and relay permissions.)
I have tested SMTP with these settings and they work successfully using test tools and other web apps. this is the only one I am having problems with. I have been through the forums finding similar problems but nothing I have tried has helped.
We're sorry but we were unable to send your e-mail. If you are sure that you entered all your email addresses properly, you should contact your server administrator.
VBScript Version: 5
Software Version: 8.0
Software Last Updated: 08/31/2007
Script Version: 5.0
Script Last Updated: 02/25/2009
CDOSYS: Available
ADODB: Available
I get this error when i submit the form.
You can view the page here:
http://www.platinumsoundproductions.com/booknow.aspx
I am running windows server 2003
IIS7
Microsoft Exchange 2003.
My SMTP settings for authentication are.
Anonymous access is unchecked.
basic authentication is also unchecked ( i have tried both ways)
Integrated Windows Authentication is checked ( with Authenticated users allowing permission for both submit and relay permissions.)
I have tested SMTP with these settings and they work successfully using test tools and other web apps. this is the only one I am having problems with. I have been through the forums finding similar problems but nothing I have tried has helped.
<%@ Language="VBScript" %>
<% Option Explicit %>
<% On Error Resume Next
' CoffeeCup Flash Form Builder: Form Results Handler
'
' This file is in charge of handling the form results
' posted from the CoffeeCup Flash Form Builder SWF.
' It has several primary functions:
'
' - Assure that the user is running the proper version of
' VBScript and has properly configured their server for
' CoffeeCup Flash Form Builder by uploading the provided
' files and assigning the appropriate server settings
' and permissions.
' - Upload a file if the 'Request.Form("Filedata")' variable is
' populated
' - If the Request.Form collection has been populated,
' process the form by:
' - Reading the config file provided in the 'Request.Form("xmlfile")'
' variable.
' - Saving the form data to a file if the 'CC_FB_SaveFile' constant
' has been populated.
' - Saving the form data to the database provided in 'CC_FB_DBAddress'
' if the 'CC_FB_DBAddress' constant is populated.
' - Emailing the form data to the form owner via the address provided
' in the 'Request.Form("_ALT_EMAIL")' variable or the
' Request.Form("mailto")' variable if the 'Request.Form("_ALT_EMAIL")'
' variable is not populated.
' - Emailing the form data to the form user via the address provided in
' the 'Request.Form("eM")' variable if the 'Request.Form("eM")' variable
' has been populated and the 'emailuser' config option is set to 'true'.
' - Taking the form user to the landing page provided in the
' 'Request.Form("thankyoupage")' variable or to a default landing page
' if the 'Request.Form("thankyoupage")' is empty.
' - Prints out an informational page with version numbers and release
' dates if an error occurs or if this script is called without
' the 'Request.Form' Collection variable being set.
'
' @license http://www.coffeecup.com/legal/eula.html
' @author Jeff Welch <jw@coffeecup.com>
' @version 4.0
' @package CC_FB
'
'
' The version of CoffeeCup Flash Form Builder that
' generated this script.
'
Private Const CC_FB_Version = "8.0"
'
' The release date of the version of CoffeeCup Flash Form
' Builder that generated this script.
'
Private Const CC_FB_LastUpdated = "08/31/2007"
'
' The version of this script.
'
Private Const CC_FB_ScriptVersion = "5.0"
'
' The release date of this script.
'
Private Const CC_FB_ScriptLastUpdated = "02/25/2009"
'
' The required VBScript version for this script.
'
Private Const CC_FB_VBScriptVersion = 5
'
' Will the owner of this form be emailed the
' form data
'
Private Const CC_FB_DoEmail = true
'
' To default To address.
'
Private Const CC_FB_ToEmail = "web-relay@joedinobile.com"
'
' The default CC address.
'
Private Const CC_FB_CCEmail = ""
'
' The default BCC address.
'
Private Const CC_FB_BCCEmail = ""
'
' The message to send to the form owner
'
Private Const CC_FB_OwnerMessage = "Hello, My name is [tbFname] [tbLname]. I would like to request more information for our [ddlEvent] on[tbDate] at [tbTime]. The following is my contact information: [tbFname] [tbLname] [tbAddress] [tbCity], [ddlstate] [tbZip] Phone #: [tbPhone] Mobile #: [tbMobile] E-Mail : [tbEmail] The following is any additional information that I have entered in the form request. [taComment] Services requested: [cboxDJ] [cboxPhoto] [cboxLimo] [cboxOther] [tbOther] DJ Choice is [ddlDJ] Photographer Choice is: [ddlPhoto] I also have a facebook account and you can add me: [tbFacebook] My IM account is: [ddlIM] You can check out my website at: [tbWebsite] Thanks for your response. I look forward to hearing from you."
'
' If we should send a message back to the user.
'
Private Const CC_FB_AutoReply = false
'
' The subject of the message to be sent to the user.
'
Private Const CC_FB_AutoReplySubject = ""
'
' If we should include the form results
' in the message we send to the user.
'
Private Const CC_FB_AutoReplyFormResults = false
'
' The position of the auto-reply message
' in the email.
'
Private Const CC_FB_AutoReplyPosition = "bottom"
'
' The page to redirect to after the form is submitted.
'
Private Const CC_FB_ResultsRedirect = "[RESULTSREDIRECT]"
'
' The address of the database where the form results
' will be saved.
'
Private Const CC_FB_DBAddress = "[ADDRESS]"
'
' The port number of the database where the form results
' will be saved.
'
Private Const CC_FB_DBPort = "[DBPORT]"
'
' The username for the database where the form results
' will be saved.
'
Private Const CC_FB_DBUsername = "[DBUSER]"
'
' The password for the database where the form results
' will be saved.
'
Private Const CC_FB_DBPassword = "[DBPASS]"
'
' The name of the database where the form results
' will be saved.
'
Private Const CC_FB_DBName = "[DBNAME]"
'
' The name of the database table where the form results
' will be saved.
'
Private Const CC_FB_DBTable = "[DBTABLE]"
'
' The address of the SMTP Server used for sending
' emails.
'
Private Const CC_FB_SMTPAddress = "joedinobile.com"
'
' The port for the SMTP Server used for sending
' emails.
'
Private Const CC_FB_SMTPPort = "25"
'
' The user for the SMTP Server used for sending
' emails.
'
Private Const CC_FB_SMTPUsername = "web-relay"
'
' The password for the SMTP Server used for sending
' emails.
'
Private Const CC_FB_SMTPPassword = "U93zjoe!"
'
' The file to log the form results to if necessary.
'
Private Const CC_FB_SaveFile = "[FILENAME]"
'
' The filetypes that are acceptable for file uploads.
'
Private Const CC_FB_AcceptableFileTypes = "txt|gif|jpg|jpeg|zip|doc|png|pdf|rtf|html|docx|xslx"
'
' The directory where files are uploaded
'
Private Const CC_FB_UploadsFolder = "files"
'
' The extension that gets added to file uploads
'
Private Const CC_FB_UploadsExtension = "_fbu"
'
' Will we save the file uploads to the server
'
Private Const CC_FB_AttachmentSaveToServer = true
'
' Will we save the file uploads to the db
'
Private Const CC_FB_AttachmentSaveToDB = false
'
' Will we send the file upload as an attachment
'
Private Const CC_FB_AttachmentAddToEmail = false
' Makes sure that the user is using the required version
' of VBScript as specified by {@link CC_FB_VBScriptVersion}.
If ScriptEngineMajorVersion < CC_FB_VBscriptVersion Then
printMessage "Invalid VBScript Version",_
"We're sorry but CoffeeCup Flash Form Builder requires VBScript " & _
" version " & CC_FB_VBscriptVersion & " or greater. Please " & _
"contact your server administrator."
End If
' If the content type is mutipart, process the file upload
Dim contentType
contentType = Request.ServerVariables("HTTP_Content_Type")
If len(contentType) = 0 Then
contentType = Request.ServerVariables("CONTENT_TYPE")
End If
If LCase(Left(contentType, 19)) = "multipart/form-data" Then
processFileUpload
' If the Request.Form collection is populated, process the
' form results.
ElseIf Request.Form.Count > 0 Then
' we need this since asp wont let us override request.form("Uploaded_File")
dim uploadedFile
processMailForm
' If all else fails, print out a blank page with version
' numbers and release dates.
End If
printMessage "",""
'
' Process the mail form results.
'
' This method is in charge of processing the mail form which
' is posted from the CoffeeCup Flash Form Builder SWF. This
' process includes:
'
' - Retrieving the preferences from the included CoffeeCup Flash
' Form Builder XML preferences file.
' - Formats output for file output as well as for an email to
' the form user and the form owner as necesarry.
' - Writes output to a file and sends it to the form user and
' the form owner as necessary.
' - Writes form results to a database if necesarry.
'
Private Sub processMailForm()
On Error Resume Next
Dim ownerEmailResponse, userEmailResponse, formResponse, txtFile, _
item, preferences, FSO
fixUploadedFileName
Set preferences = getPreferences()
For Each item In preferences("formFields")
If Trim(Request.Form(item)) <> "" Then
ownerEmailResponse = ownerEmailResponse & item & ": " & _
Request.Form(item) & VbCrLf & VbCrLf
txtFile = txtFile & item & ": " & Request.Form(item) & "|"
' Make sure we aren't displaying hidden fields
' to end-users
If preferences(item)("type") <> "hiddenfield" Then
userEmailResponse = userEmailResponse & item & ": " & _
Request.Form(item) & VbCrLf & VbCrLf
formResponse = formResponse & item & ": " & _
Request.Form(item) & "<br />" & VbCrLf
End If
End If
Next
' If a file was uploaded, add the appropriate data to the response
' fields
If uploadedFile <> "" Then
ownerEmailResponse = ownerEmailResponse & "Uploaded File: " & _
uploadedFile
userEmailResponse = userEmailResponse & "Uploaded File: " & _
uploadedFile
formResponse = formResponse & " Uploaded File: " & _
uploadedFile & "<br />" & VbCrLf
txtFile = txtFile & "Uploaded File: " & _
uploadedFile & "|"
End If
sendResponseEmails ownerEmailResponse, userEmailResponse, preferences
writeResponseToFile txtFile
writeResponseToDatabase preferences
' Make sure we delete the file from the server if the user doesn't
' want it
If Not CC_FB_AttachmentSaveToServer And _
uploadedFile <> "" Then
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
FSO.DeleteFile Server.MapPath(CC_FB_UploadsFolder) & "\" & _
uploadedFile, true
End If
printResponsePage formResponse, preferences
Set preferences = Nothing
Set FSO = nothing
End Sub
'
' Send response emails to the appropriate recipients.
'
' Sends an email to the scripts owner as well as the end-user
' if appropriate. If the sending of mail fails, an error
' message will be printed out to the screen.
'
' @param string ownerEmailResponse the message to mail to the owner.
' @param string userEmailResponse the message to mail to the user.
' @param dictionary preferences the CoffeeCup Flash Form Builder Preferences.
'
Private Sub sendResponseEmails(ByRef ownerEmailResponse, _
ByRef userEmailResponse, ByRef preferences)
On Error Resume Next
Dim mail, unreg
Set mail = Server.CreateObject("CDO.Message")
' If we could not create a CDO.Message object, they are lacking
' CDOSYS which is required for e-mail functionality.
If Err.Number <> 0 Then
Err.Clear
printMessage "Unable to Send E-Mail.", _
"We're sorry but we were unable to send an email. " & _
"Sending email requires CDOSYS, which we were unable to " & _
"locate on your server. Please contact your server " & _
"administrator "
End If
' If the program is unregistered, add the unregistered message.
If Request.Form("unreg") <> "" Then
unreg = "------------------------" & VbCrLf & VbCrLf & _
"This Form was sent to you using CoffeeCup " & _
"Flash Form Builder." & VbCrLf & "Please tell a friend about " & _
"us: http://www.coffeecup.com/form-builder/" & VbCrLf
End If
' Make sure the mail is unicode for internationality.
mail.Bodypart.ContentMediaType = "text/plain"
mail.Bodypart.ContentTransferEncoding = "7bit"
mail.Bodypart.Charset = "utf-8"
' Configure SMTP options if provided
If CC_FB_SMTPAddress <> "[SMTPADDRESS]" Then
mail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" & _
"configuration/sendusing") = 2
mail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" & _
"configuration/smtpserver") = CC_FB_SMTPAddress
If CC_FB_SMTPPort <> "[SMTPPORT]" Then
mail.Configuration.Fields.Item("http://schemas.microsoft.com/" & _
"cdo/configuration/smtpserverport") = CC_FB_SMTPPort
End If
If CC_FB_SMTPUsername <> "[SMTPUSER]" Then
mail.Configuration.Fields.Item("http://schemas.microsoft.com/" & _
"cdo/configuration/smtpauthenticate") = 1
mail.Configuration.Fields.Item("http://schemas.microsoft.com/" & _
"cdo/configuration/sendusername") = CC_FB_SMTPUsername
mail.Configuration.Fields.Item("http://schemas.microsoft.com/" & _
"cdo/configuration/sendpassword") = CC_FB_SMTPPassword
End If
mail.Configuration.Fields.Update
End If
' Add an attachment is required
If CC_FB_AttachmentAddToEmail And _
uploadedFile <> "" Then
mail.AddAttachment Server.MapPath(CC_FB_UploadsFolder) & "\" & _
uploadedFile
End If
' Use the alternative email if one is provided.
If Request.Form("_ALT_EMAIL") <> "" Then
mail.To = Request.Form("_ALT_EMAIL")
Else
mail.To = CC_FB_ToEmail
End If
' Set a default subject if one is not provided.
If Request.Form("subject") <> "" Then
mail.Subject = parseMessage(Request.Form("subject"), preferences)
Else
mail.Subject = "Form Submission"
End If
' Set a default message if one is not provided.
If CC_FB_OwnerMessage <> "[FORMOWNERMSG]" Then
mail.TextBody = parseMessage(CC_FB_OwnerMessage, preferences)
Else
mail.TextBody = "Here is the information submitted to " & _
Request.ServerVariables("SERVER_NAME") & _
Request.ServerVariables("SCRIPT_NAME") & " from " & _
Request.ServerVariables("REMOTE_ADDR") & " on " & _
FormatDateTime(Date, 1) & " at " & Time & _
VbCrLf & "------------------------" & VbCrLf & _
ownerEmailResponse & unreg
End If
' If we collected the end-user's email
If Request.Form("eM") <> "" Then
' Send a message to the form's owner with the end-user's email
' as the reply-to address.
If CC_FB_DoEmail Then
mail.From = Request.Form("eM")
mail.Cc = CC_FB_CCEmail
mail.Bcc = CC_FB_BCCEmail
mail.Send
End If
' If mail.Send threw an error, hault the script and notify
' the user.
If Err.Number <> 0 Then
Err.Clear
mail.From = "CoffeeCup Flash Form Builder <formbuilder@" & _
Request.ServerVariables("SERVER_NAME") & ">"
mail.Send
If Err.Number <> 0 Then
Err.Clear
printMessage "Unable To Send E-Mail", _
"We're sorry but we were unable to send your e-mail. " & _
"If you are sure that you entered all your email " & _
"addresses properly, you should contact your server " & _
"administrator."
End If
End If
' If necesarry, send a message to the end-user as well.
If CC_FB_AutoReply Then
Dim formUserResponse
formUserResponse = parseMessage("", preferences)
If CC_FB_AutoReplyFormResults Then
If CC_FB_AutoReplyPosition = "top" Then
formUserResponse = formUserResponse & _
VbCrLf & VbCrLf & userEmailResponse
Else
formUserResponse = userEmailResponse & _
VbCrLf & VbCrLf & formUserResponse
End If
End If
mail.Attachments.DeleteAll
mail.Subject = parseMessage(CC_FB_AutoReplySubject, preferences)
mail.TextBody = formUserResponse & unreg
mail.From = mail.To
mail.To = Request.Form("eM")
mail.Cc = ""
mail.Bcc = ""
mail.Send
' If mail.Send threw an error, try to send with different
' From: address
If Err.Number <> 0 Then
Err.Clear
mail.From = Request.ServerVariables("SERVER_NAME") & " Form" &_
" <forms@" & Request.ServerVariables("SERVER_NAME") & ">"
mail.Send
If Err.Number <> 0 Then
Err.Clear
End If
End If
End If
' Send a message to the form's owner.
ElseIf CC_FB_DoEmail Then
mail.From = "CoffeeCup Flash Form Builder <formbuilder@" & _
Request.ServerVariables("SERVER_NAME") & ">"
mail.Cc = CC_FB_CCEmail
mail.Bcc = CC_FB_BCCEmail
mail.Send
' If mail.Send threw an error, hault the script and notify
' the user.
If Err.Number <> 0 Then
Err.Clear
printMessage "Unable To Send E-Mail", _
"We're sorry but we were unable to send your e-mail. " & _
"If you are sure that you entered all your email " & _
"addresses properly, you should contact your server " & _
"administrator."
End If
End If
Set mail = Nothing
End Sub
'
' Gets the real name of the file that was uploaded.
'
' Since the file upload occurs in a different request,
' this method helps us resolve what the name of the
' uploaded file was in case it was renamed.
'
Private Function parseMessage(ByRef message, ByRef preferences)
On Error Resume Next
Dim item
parseMessage = message
For Each item In preferences("formFields")
parseMessage = Replace(parseMessage, "[" & item & "]", _
Request.Form(item))
Next
End Function
'
' Gets the real name of the file that was uploaded.
'
' Since the file upload occurs in a different request,
' this method helps us resolve what the name of the
' uploaded file was in case it was renamed.
'
Private Sub fixUploadedFileName()
On Error Resume Next
Dim newUploadName, FSO, extension, basename, folder, i
If Request.Form("Uploaded File") <> "" Then
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
folder = Server.MapPath(CC_FB_UploadsFolder)
basename = FSO.GetBaseName(Request.Form("Uploaded File"))
extension = "." & FSO.GetExtensionName(Request.Form("Uploaded File"))
While FSO.FileExists(folder & "\" & basename & _
CC_FB_UploadsExtension & i & extension)
newUploadName = basename & CC_FB_UploadsExtension & i & extension
i = i + 1
Wend
End If
uploadedFile = newUploadName
Set FSO = Nothing
End Sub
'
' Write form response to a database.
'
' Writes the form response to the database specified at 'CC_FB_DBAddress'
' if appropriate. If the database doesn't it exist, the 'CC_FB_DBTable'
' table doesn't exist or if the 'CC_FB_DBTable' table doesn't comply with
' the structure of the current form then the database will be restructured
' accordingly.
'
' @param dictionary preferences the CoffeeCup Flash Form Builder Preferences.
'
Private Sub writeResponseToDatabase(ByRef preferences)
On Error Resume Next
Dim connection, command, results
Dim result, columns, column, query, field, i, parameters, bound
' If the CC_FB_DbAddress constant has been populated, then
' the user wants to write their data to a database.
If CC_FB_DBAddress <> "[ADDRESS]" Then
' Firstly, lets make sure we can access ADODB.
Set connection = Server.CreateObject("ADODB.Connection")
If Err.Number <> 0 Then
Err.Clear
printMessage "Unable to Connect to Database Server.", _
"We're sorry but we were unable to connect to your " & _
"database server. Saving to a database requires ADODB, " & _
"which we were unable to locate on your server. " & _
"Please contact your server administrator."
End If
connection.Open "Driver={MySQL ODBC 3.51 Driver};" & _
"Server=" & CC_FB_DBAddress & ";" & _
"Port=" & CC_FB_DBPort & ";" & _
"Uid=" & CC_FB_DBUsername & ";" & _
"Pwd=" & CC_FB_DBPassword & ";"
If Err.Number <> 0 Then
' If the error description mentions a driver, let the user
' know they are missing the mysql driver
If InStr(Err.Description, "driver") Then
Err.Clear
printMessage "Unable to Connect to Database Server.", _
"We're sorry but we were unable to connect to your " & _
"database server. Saving to a database requires " & _
"the ""MySQL ODBC 3.51 Driver"" which we were unable " & _
"to locate on your server. Please contact your " & _
"administrator."
' Otherwise Let the user know they have entered incorrect
' credentials
Else
Err.Clear
printMessage "Unable to Connect to Database Server.", _
"We're sorry but we were unable to connect to your " & _
"database server. Please be sure you have entered " &_
"your database settings correctly."
End If
End If
' Attempt to make a connection to the specified DB
Set command = Server.CreateObject("ADODB.Command")
command.ActiveConnection = connection
command.CommandText = "USE `" & CC_FB_DBName & "`"
command.Execute
' If we can't select their DB, lets try to create our own.
If Err.Number <> 0 Then
Err.Clear
command.CommandText = "CREATE DATABASE `" & CC_FB_DBName & "`"
command.Execute
' If we can't create or own, let the user know
If Err.Number <> 0 Then
connection.Close
Err.Clear
printMessage "Unable to Create Database.", _
"We're sorry but we were unable to create your database. " & _
"If you believe the database already exists, please " & _
"be sure that you have the proper permissions to " & _
"select it. Otherwise, please be sure that you " & _
"have permissions to create databases. If you " & _
"are still experiencing troubles, please contact " & _
"your server administrator."
' If we could create our own, try selecting it now
Else
command.CommandText = "USE `" & CC_FB_DBName & "`"
command.Execute
' If we still can't select the DB, let the user know
If Err.Number <> 0 Then
connection.Close
Err.Clear
printMessage "Unable to select Database.", _
"We're sorry but we were unable to select your " & _
"database. Please be sure that you have the proper " & _
"permissions to select it. If you are still " & _
"experiencing trouble, please contact your " & _
"server administrator."
End If
End If
End If
command.CommandText = "SHOW TABLES LIKE '" & CC_FB_DBTable & "'"
Set results = command.Execute
' If a form_results table exists, make sure it is in the
' proper format.
If Not (results.EOF Or results.BOF) Then
results.Close
command.CommandText = "SHOW COLUMNS FROM `" & CC_FB_DBTable & "`"
Set results = command.Execute
' If for some reason we can't querty the DB, let the user know
If results.EOF And results.BOF Then
results.Close
connection.Close
printMessage "Unable to Query Database.", _
"We're sorry but we were unable to query your database " & _
"table. Please be sure that you have the proper " & _
"permissions to select from the " & CC_FB_DBTable & _
" table. If you are still experiencing trouble, " & _
"please contact your server administrator."
End If
Set columns = Server.CreateObject("Scripting.Dictionary")
' Populate the columns collection with the columns of the
' 'CC_FB_DBTable' table
Do Until results.EOF
If results.Fields.Item("Field") <> "id" And _
results.Fields.Item("Field") <> "created_at" Then
Set column = Server.CreateObject("Scripting.Dictionary")
column.Add "Field", CStr(results.Fields.Item("Field"))
column.Add "Type", CStr(results.Fields.Item("Type"))
columns.Add CStr(results.Fields.Item("Field")), column
End If
results.MoveNext
Loop
results.Close
' If the fields from our form don't match the fields from
' the 'CC_FB_DBTable' table, archive the old table and
' create a new one corresponding to the current form
If Not formFieldsEqualsTableFields(preferences("formFields"), _
columns) Then
archiveOldTable command
createTableFromFormFields preferences("formFields"), command
End If
' Otherwise create the 'CC_FB_DBTable' table in the proper format.
Else
createTableFromFormFields preferences("formFields"), command
End If
parameters = Array()
' If all went well, lets attempt to write the form results to
' the database.
For Each field In preferences("formFields")
query = query & "`" & field & "` = ?, "
bound = UBound(parameters) + 1
Redim Preserve parameters(bound)
If request.form(field) = "" Then
parameters(bound) = ""
Else
parameters(bound) = Request.Form(field)
End If
Next
' Add the uploaded file to the query if necessary
If CC_FB_AttachmentSaveToDB Then
If uploadedFile <> "" Then
Dim textStream, filepath, contents
filepath = Server.MapPath(CC_FB_UploadsFolder) & "\" & _
uploadedFile
Set textStream = Server.CreateObject("ADODB.Stream")
textStream.Open
textStream.Type = 1
textStream.LoadFromFile filepath
If Err.Number <> 0 Then
printMessage "Unable To Open Attachment File", _
"We're sorry but we were unable to open your uploaded " & _
"file to attatch it for email. Please be sure that " & _
"you have the proper permissions."
End If
query = query & "`uploaded_file_name` = ?,`uploaded_file` = ?,"
bound = UBound(parameters) + 2
Redim Preserve parameters(bound)
parameters(bound - 1) = uploadedFile
parameters(bound) = textStream.read
textStream.Close
Set textStream = Nothing
Else
query = query & "`uploaded_file_name` = '',`uploaded_file` = '',"
End If
End If
command.CommandText = "INSERT INTO `" & CC_FB_DBTable & "` SET " & _
query & "`created_at` = NOW()"
command.Execute ,parameters
' If we couldn't write to the database, notify the user.
If Err.Number <> 0 Then
connection.Close
Err.Clear
printMessage "Unable to Insert Into Database Table.", _
"We're sorry but we were unable to insert the form results " & _
"into your database table. Please be sure that you have " & _
"the proper permissions to insert data into the " & _
CC_FB_DBTable & " table. If you are still experiencing " & _
"trouble, please contact your server administrator."
End If
connection.Close
End If
Set connection = Nothing
Set command = Nothing
Set results = Nothing
Set columns = Nothing
End Sub
'
' Archives an old 'CC_FB_DBTable' table.
'
' Renames a form results table to 'CC_FB_DBTable'_old or
' 'CC_FB_DBTable'_old with a numerical value on the end of it
' if appropriate.
'
' @param ADO Command Object command a database abstraction
'
Private Sub archiveOldTable(ByRef command)
On Error Resume Next
Dim i, results
command.CommandText = "SHOW TABLES LIKE '" & CC_FB_DBTable & "_old'"
set results = command.Execute
Do Until results.EOF And results.BOF
i = i + 1
command.CommandText = "SHOW TABLES LIKE '" & CC_FB_DBTable & _
"_old" & i & "'"
set results = command.Execute
Loop
command.CommandText = "RENAME TABLE `" & CC_FB_DBTable & "` TO `" & _
CC_FB_DBTable & "_old" & i & "`"
command.Execute()
If Err.Number <> 0 Then
Err.Clear
printMessage "Unable to Rename Database Table.", _
"We're sorry but we were unable to rename your database " & _
"table. Please be sure that you have the proper " & _
"permissions to rename the " & CC_FB_DBTable & " table. If " & _
"you are still experiencing trouble, please contact your " & _
"server administrator."
End If
Set results = Nothing
End Sub
'
' Checks if the columns from a table match the the structure
' of the fields from a form.
'
' @param array form_fields the structure from the form
' @param array table_fields the structure from the table
' @return boolean value, true if the structures are the same,
' false if the structures are not.
'
Private Function formFieldsEqualsTableFields(ByRef formFields, _
ByRef tableFields)
On Error Resume Next
Dim Field, f
' Make sure we have the proper fields for saving uploaded
' files to the database if the user has requested we do so
If CC_FB_AttachmentSaveToDB Then
If tableFields.Exists("uploaded_file") And _
tableFields.Exists("uploaded_file_name") Then
tableFields.Remove("uploaded_file")
tableFields.Remove("uploaded_file_name")
Else
formFieldsEqualsTableFields = False
Exit Function
End If
End If
If formFields.Count <> tableFields.Count Then
formFieldsEqualsTableFields = False
Exit Function
End If
For Each field In formFields
If Not tableFields.Exists(field) OR _
Not ((formFields(field)("type") = "textarea" AND _
tableFields(field)("Type") = "text") OR _
tableFields(field)("Type") = "varchar(255)") Then
formFieldsEqualsTableFields = False
Exit Function
End If
Next
formFieldsEqualsTableFields = True
End Function
'
' Create a MySQL table from the form structure.
'
' Uses the structure of the form, pulled from the XML preferences
' file to create a database table to store the form results.
'
' @param dictionary formFields the structure of the form
' @param ADO Command Object command a database abstraction
'
Private Sub createTableFromFormFields(ByRef formFields, ByRef command)
On Error Resume Next
Dim field
command.CommandText = "DROP TABLE IF EXISTS `" & CC_FB_DBTable & "`"
command.Execute()
command.CommandText = "CREATE TABLE `" & CC_FB_DBTable & "` (" & _
"`id` int(11) NOT NULL auto_increment," & _
"`created_at` DATETIME NOT NULL"
If CC_FB_AttachmentSaveToDB Then
command.CommandText = command.CommandText & _
",`uploaded_file_name` varchar(255) NOT NULL DEFAULT ''" & _
",`uploaded_file` MEDIUMBLOB NOT NULL"
End If
For Each field In formFields
' Make sure we don't try to create a table with column names
' that exceed the MySQL maximum column identifier length.
If Len(field) > 64 Then
printMessage "Unable to Create Table.", "We're sorry but we " & _
"were unable to create a database table for your form " & _
"results. Unfortunately, MySQL does not permit field " & _
"names longer than 64 characters. In order to utilize " & _
"MySQL for this form, you will first have to limit the " & _
"""" & field & """ field to 64 characters."
End If
command.CommandText = command.CommandText & ", `" & field & "` "
If formFields(field)("type") = "textarea" Then
command.CommandText = command.CommandText & "text"
Else
command.CommandText = command.CommandText & "varchar(255) " & _
"DEFAULT ''"
End If
command.CommandText = command.CommandText & " NOT NULL "
Next
command.CommandText = command.CommandText & ", PRIMARY KEY(`id`))"
command.Execute()
If Err.Number <> 0 Then
Err.Clear
printMessage "Unable to Create Table.", "We're sorry but we were " & _
"unable to create a database table for your form results. " & _
"Please be sure that you have the proper permissions to " & _
"create tables. If you are still experiencing trouble, " & _
"please contact your server administrator."
End If
End Sub
'
' Write form response to a log file.
'
' Writes the form response to the log file specified at 'CC_FB_SaveFile'
' if appropriate. If the file writing fails, an error message will be
' printed out to the screen.
'
' @param string txtFile the response to write to the log file.
'
Private Sub writeResponseToFile(ByRef txtFile)
On Error Resume Next
Dim FSO, filePath, textStream
txtFile = Request.ServerVariables("SERVER_NAME") & _
Request.ServerVariables("SCRIPT_NAME") & "|" & _
FormatDateTime(Now) & "|" &_
Request.ServerVariables("REMOTE_ADDR") & "|" & _
txtFile & VbCrLf
' If a log file location has been set
If CC_FB_SaveFile <> "[FILENAME]" Then
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
filePath = Server.MapPath(CC_FB_SaveFile)
Set textStream = FSO.OpenTextFile(filePath, 8, True)
If Err.Number <> 0 Then
Err.Clear
printMessage "Unable To Open File", _
"We're sorry but we were unable to open " & filePath & _
". Please contact your server administrator to be sure " & _
"that you have the proper permissions."
End If
textStream.Write(txtFile)
If Err.Number <> 0 Then
Err.Clear
printMessage "Unable To Write To File", _
"We're sorry but we were unable to write to " & _
filePath & ". Please contact your server " & _
"administrator to be sure that you have the proper " & _
"permissions."
End If
textStream.Close
Set textStream = Nothing
Set FSO = Nothing
End If
End Sub
'
' Prints the HTML-formatted, form response page for the end-user.
'
' Writes the form response to an HTML-formatted page for the end-user
' or redirects the user to a thank you page if specified.
'
' @param string form_response the response to write to the page.
' @param array preferences the CoffeeCup Flash Form Builder Preferences.
'
Private Sub printResponsePage(ByRef formResponse, ByRef preferences)
On Error Resume Next
' Redirect to a thank you page if the user has created one.
If CC_FB_ResultsRedirect <> "[RESULTSREDIRECT]" Then
Response.Redirect CC_FB_ResultsRedirect
' Otherwise create a thank you page.
Else
Dim resultsMsg
resultsMsg = "<?xml version=""1.0"" encoding=""utf-8""?>" & VbCrLf & "<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Strict//EN""" & VbCrLf & " ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"">" & VbCrLf & "<html xmlns=""http://www.w3.org/1999/xhtml"" xml:lang=""en"" lang=""en"">" & VbCrLf & "" & VbCrLf & "<head>" & VbCrLf & " <title>Form Submitted</title>" & VbCrLf & " <meta http-equiv=""Content-Type"" content=""text/html; charset=utf-8"" />" & VbCrLf & " <meta name=""robots"" content=""noindex,nofollow"" />" & VbCrLf & " <style type=""text/css"">" & VbCrLf & " <!--" & VbCrLf & " body" & VbCrLf & " {" & VbCrLf & " text-align: center;" & VbCrLf & " }" & VbCrLf & " #message" & VbCrLf & " {" & VbCrLf & " width: 720px;" & VbCrLf & " margin: 0 auto;" & VbCrLf & " }" & VbCrLf & " -->" & VbCrLf & " </style>" & VbCrLf & "</head>" & VbCrLf & "" & VbCrLf & "<body>" & VbCrLf & " <h2>Thank you for your form submission!</h2>" & VbCrLf & "</body>"
Response.Write(Replace(resultsMsg, _
"$form_results", formResponse))
End If
' End Transmission
Response.End
END Sub
'
' Returns the CoffeeCup Flash Form Builder Preferences.
'
' Opens the CoffeeeCup Flash Form Builder XML preferences file
' and retrieves the preferences and form fields from it. If
' the preferences file is not found or can not be opened, an
' error message is printed to the screen.
'
' @return dictionary preferences a dictionary of preferences specified
' in the CoffeeCup Flash Form Builder XML preferences file.
'
Private Function getPreferences()
On Error Resume Next
Dim FSO, filePath, textStream, contents, preferences, formFields
' Initialize the preferences dictionary
Set preferences = Server.CreateObject("Scripting.Dictionary")
Set formFields = Server.CreateObject("Scripting.Dictionary")
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
filePath = Server.MapPath(Request.Form("xmlfile"))
' If the specified preferences file doesn't exist, let the user
' know
If Not FSO.FileExists(filePath) Then
printMessage "Unable To Locate XML File", "We're sorry but we " & _
"were unable to locate your XML file. Please be sure that " & _
"the '" & Request.Form("xmlfile") & "' is on your server in " & _
"the same directory as your other form builder files."
End If
' Read in the text from the specified preferences file
Set textStream = FSO.OpenTextFile(filePath, 1, False, -2)
' If we were unable to open the specified xml file, let the suer
' know
If Err.Number <> 0 Then
Err.Clear
printMessage "Unable To Open XML File","We're sorry but we were " & _
"unable to open your XML file. Please be sure that you have " & _
"the proper permissions to read '" & Request.Form("xmlfile") & _
"'. If you are still experiencing problems, please contact " & _
"your server administrator."
End If
contents = textStream.ReadAll
textStream.Close
' If for some reason the text from the preferences file is empty
' let the user know
If contents = "" Then
printMessage "Unable To Read XML File","We're sorry but we were " & _
"unable to read your XML file. Please be sure that you have " & _
"the proper permissions to read '" & Request.Form("xmlfile") & _
"'. If you are still experiencing problems, please contact " & _
"your server administrator."
End If
' Strips out all the XML nodes from the preferences file.
Dim contentsRegexp, nodes, node
Set contentsRegexp = New RegExp
contentsRegexp.Pattern = "<([a-z]+?)\s+([^>]*?)>"
contentsRegexp.IgnoreCase = True
contentsRegexp.Global = True
contentsRegexp.Multiline = True
Set nodes = contentsRegexp.Execute(contents)
For Each node In nodes
' Skip over item, hidden, button and label nodes, as we're not
' interested in them.
If node.SubMatches(0) <> "item" And _
node.SubMatches(0) <> "hidden" And _
node.SubMatches(0) <> "submitbutton" And _
node.SubMatches(0) <> "resetbutton" And _
node.SubMatches(0) <> "browsebutton" And _
node.SubMatches(0) <> "label" Then
' For each node, we will strip out all of the attributes
Dim nodeDictionary, nodeRegexp, attributes, attribute, name
Set nodeRegexp = New RegExp
nodeRegexp.Pattern = "([a-z0-9]+?)=""([^""]*?)"""
nodeRegexp.IgnoreCase = True
nodeRegexp.Global = True
nodeRegexp.Multiline = True
Set nodeDictionary = Server.CreateObject("Scripting.Dictionary")
Set attributes = nodeRegexp.Execute(node.SubMatches(1))
For each attribute In attributes
nodeDictionary.Add attribute.SubMatches(0), _
HTMLDecode(attribute.SubMatches(1))
Next
' If the node has an attribute called 'name', it is a form field.
If nodeDictionary.Exists("name") Then
name = nodeDictionary("name")
If nodeDictionary.Exists("label") Then
name = name & " - " & nodeDictionary("label")
End If
nodeDictionary.Add "type", node.SubMatches(0)
formFields.Add name, nodeDictionary
' If the node type is 'form', it is the form preferences
ElseIf node.SubMatches(0) = "form" Then
preferences.Add "formPreferences", nodeDictionary
' otherwise just dump everything into a general array depending
' on its node type.
Else
If Not preferences.Exists(node.SubMatches(0)) Then
preferences.Add node.SubMatches(0), Array(nodeDictionary)
Else
Dim nodeDictionaries, bound
nodeDictionaries = preferences(node.SubMatches(0))
bound = UBound(nodeDictionaries) + 1
Redim Preserve nodeDictionaries(bound)
Set nodeDictionaries(bound) = nodeDictionary
preferences(node.SubMatches(0)) = nodeDictionaries
End If
End If
End If
Next
preferences.Add "formFields", formFields
Set getPreferences = preferences
Set FSO = Nothing
Set textStream = Nothing
Set preferences = Nothing
End Function
'
' Uploads a user-submitted file.
'
Private Sub processFileUpload()
On Error Resume Next
Dim data, position, separator
Dim folder, filedata, filename, basename, extension, filenameRegexp, i
Dim binaryString, FSO, filePath, textStream
data = Request.BinaryRead(Request.TotalBytes)
' If we couldn't retrieve the binary request, it's most likely
' because the file exceeded the servers maximum post size
If Err.Number <> 0 Then
Err.Clear
printMessage "Unable to Upload File.", _
"We're sorry but we were unable to upload your file because " & _
"it exceeded the maximum file upload size."
End If
' Get the mime boundry
separator = MidB(data, 1, InstrB(data, ChrB("10")) - LenB(ChrB("10")) - 1)
' The position where filedata is first mentioned
position = InstrB(data, StringToBinary("Filedata"))
' If filedata is found
If position > 0 Then
' Get filename
binaryString = StringToBinary("filename=""")
position = InstrB(position, data, binaryString) + LenB(binaryString)
filename = BinaryToString(MidB(data, position, _
InstrB(position, data, ChrB("34")) - position))
' Get filedata
position = InstrB(position, data, ChrB("10") & ChrB("13")) _
+ LenB(ChrB("10") & ChrB("13") & ChrB("10"))
filedata = BinaryToString(MidB(data, position, _
InstrB(position, data, separator) - position - _
LenB(ChrB("10") & ChrB("13"))))
' Make sure the file upload is of an acceptable file type
If CC_FB_AcceptableFileTypes <> "" Then
Set filenameRegexp = New RegExp
filenameRegexp.Pattern = "\.(" & CC_FB_AcceptableFileTypes & ")$"
filenameRegexp.IgnoreCase = True
If Not filenameRegexp.Test(filename) Then
printMessage "Invalid File Type", _
"We're sorry but we were unable to upload your file " & _
"because the file type is not acceptable."
End If
End If
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
' Create the files folder if it doesn't already exist
folder = Server.MapPath(CC_FB_UploadsFolder)
If Not FSO.FolderExists(folder) Then
FSO.CreateFolder(folder)
If Err.Number <> 0 Then
Err.Clear
printMessage "Folder Creation Failed", _
"We're sorry but we were unable to create a folder for " & _
"your file uploads. Please contact your server " & _
"administrator."
End If
End If
basename = FSO.GetBaseName(filename)
extension = "." & FSO.GetExtensionName(filename)
filePath = folder & "\" & basename & CC_FB_UploadsExtension & extension
' If the file already exists, append a version number
While FSO.FileExists(filePath)
i = i + 1
filePath = folder & "\" & basename & CC_FB_UploadsExtension & _
i & extension
Wend
Set textStream = FSO.CreateTextFile(filePath, True)
' Let the user know if we can't create the file
If Err.Number <> 0 Then
Err.Clear
printMessage "Unable To Create File", _
"We're sorry but we were unable to create " & filePath & _
". Please contact your server administrator to be sure " & _
"that you have the proper permissions."
End If
textStream.Write(filedata)
' Let the user know if we can't save the file
If Err.Number <> 0 Then
Err.Clear
printMessage "Unable To Write To File", _
"We're sorry but we were unable to write to " & _
filePath & ". Please contact your server " & _
"administrator to be sure that you have the proper " & _
"permissions."
End If
textStream.Close
Set filenameRegexp = Nothing
Set FSO = Nothing
Set textStream = Nothing
End If
End Sub
'
' Prints a message to the screen.
'
' Prints an HTML-formatted message to the screen that also contains
' the current PHP version number the server is running, the current
' version number and release date of this script as well as the
' current version number and release date of the version of CoffeeCup
' Flash Form Builder that generated this script.
'
' NOTE: This function stops execution of the script.
'
' @param string title the title of the page
' @param string message the message to print to the screen
'
Private Sub printMessage(ByRef title, ByRef message)
On Error Resume Next
' The title of the html-formatted page.
Dim pageTitle, cdosysMsg, adodbMsg
' If the user has provided a title, format it for HTML
If Not title = "" Then
title = Server.HTMLEncode(title)
pageTitle = title & " - "
title = "<h1>" & title & "</h1>"
End If
' If the user has provided a message, formit it for HTML
If Not message = "" Then
message = "<p>" & Server.HTMLEncode(message) & "</p>"
End If
' Check if CDOSYS is available
Server.CreateObject("CDO.Message")
If Err.Number <> 0 Then
Err.Clear
cdosysMsg = "Not Available"
Else
cdosysMsg = "Available"
End If
' Check if ADODB is available
Server.CreateObject("ADODB.Connection")
If Err.Number <> 0 Then
Err.Clear
adodbMsg = "Not Available"
Else
adodbMsg = "Available"
End If
Response.Write ("<?xml version=""1.0"" encoding=""utf-8""?>" & VbCrLf & _
"<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Strict//EN""" & VbCrLf & _
" ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"">" & VbCrLf & _
"<html xmlns=""http://www.w3.org/1999/xhtml"" xml:lang=""en"" lang=""en"">" & _
VbCrLf & _
"" & VbCrLf & _
"<head>" & VbCrLf & _
" <title>" & pageTitle & "CoffeeCup Form Builder</title>" & VbCrLf & _
" <meta http-equiv=""Content-Type"" content=""text/html; charset=utf-8"" />"& _
VbCrLf & _
" <meta name=""robots"" content=""noindex,nofollow"" />" & VbCrLf & _
" <style type=""text/css"">" & VbCrLf & _
" <!--" & VbCrLf & _
" div#script_info" & VbCrLf & _
" {" & VbCrLf & _
" border-top: 1px solid #666;" & VbCrLf & _
" font-size: .85em;" & VbCrLf & _
" }" & VbCrLf & _
" -->" & VbCrLf & _
" </style>" & VbCrLf & _
"</head>" & VbCrLf & _
"" & VbCrLf & _
"<body>" & VbCrLf & _
" " & title & VbCrLf & _
" " & message & VbCrLf & _
" <div id=""script_info"">" & VbCrLf & _
" <p>" & VbCrLf & _
" VBScript Version: " & ScriptEngineMajorVersion & VbCrLf & _
" </p>" & VbCrLf & _
" <p>" & VbCrLf & _
" Software Version: " & CC_FB_Version & "<br />" & VbCrLf & _
" Software Last Updated: " & CC_FB_LastUpdated & VbCrLf & _
" </p>" & VbCrLf & _
" <p>" & VbCrLf & _
" Script Version: " & CC_FB_ScriptVersion & "<br />" & VbCrLf & _
" Script Last Updated: " & CC_FB_ScriptLastUpdated & VbCrLf & _
" </p>" & VbCrLf & _
" <p>" & VbCrLf & _
" CDOSYS: " & cdosysMsg & "<br />" & VbCrLf & _
" ADODB: " & adodbMsg & VbCrLf & _
" </p>" & VbCrLf & _
" </div>" & VbCrLf & _
"</body>" & VbCrLf & _
"" & VbCrLf & _
"</html>")
Response.End
End Sub
'
' Decodes html entities in text
'
' @param text the text to decode
' @return html decoded text
'
Function HTMLDecode(text)
On Error Resume Next
Dim i
text = Replace(text, """, """")
text = Replace(text, "<" , "<")
text = Replace(text, ">" , ">")
text = Replace(text, "&" , "&")
text = Replace(text, " ", " ")
For i = 1 To 255
text = Replace(text, "&#" & i & ";", Chr(i))
Next
HTMLDecode = text
End Function
'
' Converts a C-style string to binary
'
' @param cstring the string to be converted
' @return binary text
'
Function StringToBinary(cstring)
On Error Resume Next
Dim i
For i=1 To Len(cstring)
StringToBinary = StringToBinary & ChrB(Asc(Mid(cstring,i,1)))
Next
End Function
'
' Converts a binary string to C-style
'
' @param binary string to be converted
' @return C-style text
'
Function BinaryToString(binaryString)
On Error Resume Next
Dim i
For i=1 To LenB(binaryString)
BinaryToString = BinaryToString & Chr(AscB(MidB(binaryString,i,1)))
Next
End Function
%>
Learn from the best
Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.
Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 1 Comment.
Try for 7 days”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.
Our community of experts have been thoroughly vetted for their expertise and industry experience.