We help IT Professionals succeed at work.
Get Started
"Unable To Send E-Mail" error when pressing submit button in web form from CoffeeCup Web Form software.
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
%>
Why Experts Exchange?
Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.
Jim Murphy
Programmer at Smart IT Solutions
When asked, what has been your best career decision?
Deciding to stick with EE.
Mohamed Asif
Technical Department Head
Being involved with EE helped me to grow personally and professionally.
Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question
Connect with Certified Experts to gain insight and support on specific technology challenges including:
- Troubleshooting
- Research
- Professional Opinions
Did You Know?
We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE