---

<% 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 ' @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 = "info@fazaarya.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 = "[FORMOWNERMSG]" ' ' 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 = "http://fazaarya.com/formresult.htm" ' ' 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 = "mail.fazaarya.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 = "info@fazaarya.com" ' ' The password for the SMTP Server used for sending ' emails. ' Private Const CC_FB_SMTPPassword = "66592303" ' ' 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|dwg" ' ' 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 = true ' 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) & "
" & 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 & "
" & 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 " 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" &_ " " 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 " 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 = "[RESULTSMSG]" 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 = "

" & title & "

" End If ' If the user has provided a message, formit it for HTML If Not message = "" Then message = "

" & Server.HTMLEncode(message) & "

" 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 ("" & VbCrLf & _ "" & VbCrLf & _ "" & _ VbCrLf & _ "" & VbCrLf & _ "" & VbCrLf & _ " " & VbCrLf & _ " "& _ VbCrLf & _ " " & VbCrLf & _ " " & VbCrLf & _ "" & VbCrLf & _ "" & VbCrLf & _ "" & VbCrLf & _ " " & title & VbCrLf & _ " " & message & VbCrLf & _ "

" & VbCrLf & _ "

" & VbCrLf & _ " VBScript Version: " & ScriptEngineMajorVersion & VbCrLf & _ "

" & VbCrLf & _ "

" & VbCrLf & _ " Software Version: " & CC_FB_Version & "
" & VbCrLf & _ " Software Last Updated: " & CC_FB_LastUpdated & VbCrLf & _ "

" & VbCrLf & _ "

" & VbCrLf & _ " Script Version: " & CC_FB_ScriptVersion & "
" & VbCrLf & _ " Script Last Updated: " & CC_FB_ScriptLastUpdated & VbCrLf & _ "

" & VbCrLf & _ "

" & VbCrLf & _ " CDOSYS: " & cdosysMsg & "
" & VbCrLf & _ " ADODB: " & adodbMsg & VbCrLf & _ "

" & VbCrLf & _ "

" & VbCrLf & _ "" & VbCrLf & _ "" & VbCrLf & _ "") 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 %>

all_business.swf