<%@ LANGUAGE="VBSCRIPT" %> <% Option Explicit %> <% 'set return page for cancel button returnPage = request("rp") if not isTextValid(returnPage) then returnPage = request.serverVariables("HTTP_REFERER") if isTextValid(returnPage) then returnPage = mid(returnPage, inStrRev(returnPage, "/") + 1) else returnPage = cms_pageName end if end if 'declare vars Dim templateID, templateCode Dim metaKeywords, metaDescription Dim contentID, contentName, contentTitle, contentHeading, contentBody, publishedDate Dim languageID, contentError, errorMsg Dim c_parentIDs, c_parentNames, c_contentID, c_i, i Dim formID, formName, formEmail, pageUseSSL, formDescription, formThankYou, formErrorText, formErrorOther, formVal Dim f_emailFromAddress formID = request.queryString("i") if not isNumberValid(formID) then redirectBrowser cms_pageName & "?r=1" ' ************************************* metaKeywords = "" metaDescription = "" contentBody = "" 'init error flag contentError = false Dim submitted:submitted = cBoolean(request.form("submitted")) if submitted then loadFormInfo() else displayForm() end if 'load template loadPageTemplate() Sub loadFormInfo() if dMode <> true then on error resume next Dim formVall, lfi_html, lfi_colorRow, lfi_fData SQLQuery = "SELECT tblForms.formName, tblForms.formEmail, tblForms_languages.formThankYou, tblForms_languages.pageTitle, tblForms_languages.pageHeading, tblForms_languages.formDescription, tblForms_languages.formErrorText, tblForms_languages.formErrorOther, tblForms_languages.templateID, tblForms_items.formItemID, tblForms_items.fieldType, tblForms_items.fieldRequired, tblForms_items_languages.fieldName, tblForms_items_languages.fieldValue, tblForms_elementTypes.elementTag FROM tblForms_elementTypes INNER JOIN (((tblForms INNER JOIN tblForms_languages ON tblForms.formID = tblForms_languages.formID) INNER JOIN tblForms_items ON tblForms.formID = tblForms_items.formID) INNER JOIN tblForms_items_languages ON tblForms_items.formItemID = tblForms_items_languages.formItemID) ON tblForms_elementTypes.elementID = tblForms_items.fieldType WHERE (((tblForms.formID)=" & formID & ") AND ((tblForms_languages.languageID)=" & session(sessionPrefix & "aCMS_languageID") & ") AND ((tblForms_items_languages.languageID)=" & session(sessionPrefix & "aCMS_languageID") & ")) AND (tblForms_items.fieldType<>10 AND tblForms_items.fieldType<>11) ORDER BY tblForms_items.fieldOrder;" Set ds = objConn.execute(SQLQuery) if not ds.BOF AND not ds.EOF then formName = ds("formName") templateID = ds("templateID") formEmail = ds("formEmail") contentTitle = ds("pageTitle") contentHeading = ds("pageHeading") formThankYou = ds("formThankYou") formErrorText = ds("formErrorText") formErrorOther = ds("formErrorOther") templateID = ds("templateID") lfi_colorRow = false do until ds.EOF ' load form field and check entries formVal = request.form("f" & ds("formItemID")) if cBoolean(ds("fieldRequired")) = true AND not isTextValid(formVal) then if ds("fieldType") = 5 OR ds("fieldType") = 7 then ' radio buttons or select menu errorMSG = errorMSG & "
  • " & prepTagName(formErrorOther, "TAGNAME", ds("fieldName")) else errorMSG = errorMSG & "
  • " & prepTagName(formErrorText, "TAGNAME", ds("fieldName")) end if end if if lfi_colorRow then lfi_html = lfi_html & "" & ds("fieldName") & "" & formVal & "" else lfi_html = lfi_html & "" & ds("fieldName") & "" & formVal & "" end if lfi_colorRow = not lfi_colorRow 'build data string lfi_fData = lfi_fData & prepFData(ds("fieldName")) & "||" & prepFData(formVal) & "][" ds.moveNext loop ds.close Set ds = nothing 'trim off end delimiter if isTextValid(lfi_fData) = true then lfi_fData = Left(lfi_fData, Len(lfi_fData)-2 ) lfi_html = "

    " & lfi_html & "
    " if not isTextValid(errorMSG) then ' Save entry to DB SQLQuery = "INSERT INTO tblForms_entries (formID, dateEntered, ipAddress, fData, viewed) VALUES (" & formID & ", " & prepDate(now()) & ", '" & prepString(request.serverVariables("REMOTE_ADDR")) & "', '" & prepString(lfi_fData) & "', " & prepBoolean("False") & ");" objConn.execute(SQLQuery) lfi_html = lfi_html if isTextValid(formEmail) then f_loadEmailDetails() sendEmail f_emailFromAddress, formEmail, "", "", "Form Submission", "A user has filled in the " & formName & " form on your website at " & now() & lfi_html, 1 end if contentBody = formThankYou & "
    " & lfi_html else displayForm() end if else ds.close Set ds = nothing redirectBrowser cms_pageName & "?r=2" end if 'error recording recordError err.number, err.description, err.source end sub Function prepFData(pf_in) if dMode <> true then on error resume next 'prepares form data for storage Dim pf_out pf_out = pf_in pf_out = replace(pf_out,"||","") pf_out = replace(pf_out,"][","") prepFData = pf_out End Function Sub displayForm() Dim tmpHTML, tmpHTML2, tmpHTML3, j, js Dim closeRow:closeRow = false ' Load Form info and build form SQLQuery = "SELECT tblForms.formEmail, tblForms.pageUseSSL, tblForms_languages.pageTitle, tblForms_languages.pageHeading, tblForms_languages.formDescription, tblForms_languages.formErrorText, tblForms_languages.formErrorOther, tblForms_languages.templateID, tblForms_items.formItemID, tblForms_items.fieldType, tblForms_items.fieldRequired, tblForms_items_languages.fieldName, tblForms_items_languages.fieldValue, tblForms_elementTypes.elementTag FROM tblForms_elementTypes INNER JOIN (((tblForms INNER JOIN tblForms_languages ON tblForms.formID = tblForms_languages.formID) INNER JOIN tblForms_items ON tblForms.formID = tblForms_items.formID) INNER JOIN tblForms_items_languages ON tblForms_items.formItemID = tblForms_items_languages.formItemID) ON tblForms_elementTypes.elementID = tblForms_items.fieldType WHERE (((tblForms.formID)=" & formID & ") AND ((tblForms_languages.languageID)=" & session(sessionPrefix & "aCMS_languageID") & ") AND ((tblForms_items_languages.languageID)=" & session(sessionPrefix & "aCMS_languageID") & ")) ORDER BY tblForms_items.fieldOrder;" Set ds = objConn.execute(SQLQuery) if not ds.BOF AND not ds.EOF then formEmail = ds("formEmail") pageUseSSL = cBoolean(ds("pageUseSSL")) ' check that the page is using SSL if required and available checkSecurePage(pageUseSSL) contentTitle = ds("pageTitle") contentHeading = ds("pageHeading") formDescription = ds("formDescription") formErrorText = ds("formErrorText"):formErrorText = replace(""&formErrorText, "'", "\'") formErrorOther = ds("formErrorOther"):formErrorOther = replace(""&formErrorOther, "'", "\'") templateID = ds("templateID") contentBody = "
    " if isTextValid(formDescription) then contentBody = contentBody & "" do until ds.EOF If ds("fieldType") = 10 OR ds("fieldType") = 11 then if closeRow = false then contentBody = contentBody & "" closeRow = false end if contentBody = contentBody & "" ds.moveNext loop contentBody = contentBody & "
    " & formDescription & "
    " else if closeRow = true then contentBody = contentBody & "
    " & ds("fieldName") & "" end if tmpHTML = ds("elementTag") tmpHTML2 = "":tmpHTML3 = "" if ds("fieldType") = 5 OR ds("fieldType") = 6 then ' ********************************************** ' Loop thru values adding radio button/checkbox items for j = 1 to countFields(ds("fieldValue"), "||") tmpHTML2 = replace(tmpHTML, "TAGNAME", "f" & ds("formItemID")) tmpHTML2 = replace(tmpHTML2, "TAGVALUE", nthField(ds("fieldValue"), "||", j)) if submitted = true AND itemChecked(nthField(ds("fieldValue"), "||", j), request.form("f" & ds("formItemID"))) = true then tmpHTML2 = replace(tmpHTML2, """>", """ checked>") tmpHTML3 = tmpHTML3 & tmpHTML2 & nthField(ds("fieldValue"), "||", j) & "   " next 'j tmpHTML = tmpHTML3 if cBoolean(ds("fieldRequired")) = true then js = js & " if (checkMultipleRadio(document.cmsf.f" & ds("formItemID") & ") == false) {" & vbcr & " alert('" & prepTagName(formErrorOther, "TAGNAME", ds("fieldName")) & "');return false;" & vbcr & " }" & vbcr elseIf ds("fieldType") = 7 then ' ********************************************** ' Loop thru values adding select menu items for j = 1 to countFields(ds("fieldValue"), "||") tmpHTML2 = replace("", "TAGVALUE", nthField(ds("fieldValue"), "||", j)) if submitted = true AND request.form("f" & ds("formItemID")) = nthField(ds("fieldValue"), "||", j) then tmpHTML2 = replace(tmpHTML2, """>", """ selected>") tmpHTML3 = tmpHTML3 & tmpHTML2 next 'j tmpHTML = replace(tmpHTML, "TAGNAME", "f" & ds("formItemID")) tmpHTML = replace(tmpHTML, "**MENU**", tmpHTML3) if cBoolean(ds("fieldRequired")) = true then js = js & " if (document.cmsf.f" & ds("formItemID") & ".selectedIndex == -1) {" & vbcr & " alert('" & prepTagName(formErrorOther, "TAGNAME", ds("fieldName")) & "');return false;" & vbcr & " }" & vbcr elseIf ds("fieldType") = 10 OR ds("fieldType") = 11 then ' ********************************************** ' Buttons tmpHTML = replace(tmpHTML, "TAGVALUE", ds("fieldValue")) closeRow = true else ' ********************************************** ' text etc tmpHTML = replace(tmpHTML, "TAGNAME", "f" & ds("formItemID")) if submitted = true then tmpHTML = replace(tmpHTML, "TAGVALUE", request.form("f" & ds("formItemID"))) else tmpHTML = replace(tmpHTML, "TAGVALUE", ds("fieldValue")) end if if cBoolean(ds("fieldRequired")) = true then js = js & " if (document.cmsf.f" & ds("formItemID") & ".value == '') {" & vbcr & " alert('" & prepTagName(formErrorText, "TAGNAME", ds("fieldName")) & "');return false;" & vbcr & " }" & vbcr end if if cBoolean(ds("fieldRequired")) = true then tmpHTML = tmpHTML & "*" contentBody = contentBody & tmpHTML if closeRow <> true then contentBody = contentBody & "
    " if isTextValid(js) then contentBody = contentBody & "" if isTextValid(errorMSG) then contentBody = "" & errorMSG & "
    " & contentBody contentBody = replace(contentBody, "**RETURNPAGE**", returnPage, 1, -1, 1) else ds.close Set ds = nothing redirectBrowser cms_pageName & "?r=3" end if ds.close 'error recording recordError err.number, err.description, err.source end sub Function itemChecked(fv, sv) if dMode <> true then on error resume next ' Test if the checkbox has been checked prior to form submission Dim ic_i, ic_j itemChecked = false if isTextValid(sv) then for ic_i = 1 to countFields(sv, ", ") if nthField(sv, ", ", ic_i) = fv then itemChecked = true exit for end if next 'ic_i end if 'error recording recordError err.number, err.description, err.source end function Function prepTagName(s, r, fn) if dMode <> true then on error resume next Dim fName fName = fn if right(fName, 1) = ":" then fName = left(fName, len(fName)-1) prepTagName = replace(s, r, fName, 1, -1, 1) 'error recording recordError err.number, err.description, err.source end function %>