<% function showerror(errorname,errordesc) conn.close set conn=nothing '/// Load and parse error template Set Fs=createobject("scripting.filesystemobject") Set a=fs.opentextfile(server.mappath("template-errors.htm")) errortemplate=a.readall a.close set a=nothing set fs=nothing errortemplate=replace(errortemplate,"$$error$$",errorname,1,-1,1) errortemplate=replace(errortemplate,"$$description$$",errordesc,1,-1,1) response.write errortemplate response.end end function '/// retrieve form ID, Page Referer, IP formid=request("formid") pagereferer=request.ServerVariables("HTTP_REFERER") ip=request.ServerVariables("REMOTE_ADDR") if not(isnumeric(formid)) then call showerror("Missing parameter (FORMID)","The application could not find the information for processing this form.
Make sure to provide the FORMID parameter in the form's action property") if formprotection<>"any" and instr(1,pagereferer,applicationurl,1)=0 then hasparameters=instr(pagereferer,"?") if hasparameters>0 then pagereferer=left(pagereferer,hasparameters-1) specialurls=split(lcase(specialurls),";") for x=0 to ubound(specialurls) if instr(1,pagereferer,specialurls(x),1)<>0 then takeaction=true exit for end if next if formprotection="restricted" and takeaction=false then response.end if formprotection="banned" and takeaction=true then response.end end if set conn=server.createobject("ADODB.Connection") conn.open connection '/// Get form information from database psql="select * from xlaAFPforms where formid=" & formid set rs=conn.execute(psql) if not(rs.eof) then savetodb=rs("savetodb") forwardtoemails=rs("forwardtoemails") forwardtousers=rs("forwardtousers") forwardtofield=rs("forwardtofield") ignorefields=vbcrlf & rs("ignorefields") & vbcrlf fieldvalidation=rs("fieldvalidation") displayhtml=rs("displayhtml") promptmessage=rs("promptmessage") redirecttopage=rs("redirecttopage") uniquesubmits=rs("uniquesubmits") formname=rs("formname") replytofield=rs("replytofield") autoresponse=rs("autoresponse") sendcopy=rs("sendcopy") stopby=rs("stopby") encryptfields=vbcrlf & rs("encryptfields") & vbcrlf hidefields=vbcrlf & rs("hidefields") & vbcrlf encryptpwd=rs("encryptpwd") & "" dopreview=rs("dopreview") else rs.close set rs=nothing call showerror("Unknown Form","The form could not be submitted.
This form is not registered in the form processing system
Please contact the system administrator
") end if '/// Do or not preview ///' if request.querystring("_preview")<>"" then pagereferer=request.querystring("_referer") dopreview="" end if '/// Check if the form has expired if isdate(stopby) then if todaydate>stopby then if expiredmsg="" then expiredmsg="The form cannot be submitted\nThis form expired on " & stopby if expiredmsgprompt<>"" then conn.close set conn=nothing response.write "alert('" & preparemsg(expiredmsg) & "');history.back(-1)" response.end else call showerror("Expired Form",replace(expiredmsg,"\n","
")) end if end if end if '/// Check if it's a unique submit if uniquesubmits<>"" then psql="select ip from xlaAFPsubmissions where ip='" & ip & "' and formid=" & formid set rs=conn.execute(psql) wasfound=false if not(rs.eof) then wasfound=true rs.close set rs=nothing if wasfound then if notuniqueprompt<>"" then conn.close set conn=nothing response.write "alert('" & preparemsg(notuniquemsg) & "');history.back(-1)" response.end elseif notuniquemsg<>"" then call showerror("Form Already Taken",notuniquemsg) else call showerror("Form Already Taken","The form could not be submitted.
This form has already been submitted by you") end if end if end if '/// Retrieve Fields to build collection (fields, values) and ignore ignored fields set d=Server.CreateObject("Scripting.Dictionary") for each formfield in request.QueryString '/// Retrieve Only if it is not an ignored value if instr(1,ignorefields,vbcrlf & formfield & vbcrlf,1)=0 and formfield<>"formid" and formfield<>"_preview" and formfield<>"_referer" then fieldvalue=request.form(formfield) '/// If encrypted field, encrypted if instr(1,encryptfields,vbcrlf & formfield & vbcrlf,1)<>0 and dopreview="" then fieldvalue=rc4(fieldvalue,encryptpwd) d.add formfield,fieldvalue end if next '/// This ensures that the fields are in the same order as the form For ix = 1 to Request.Form.Count formfield = Request.Form.Key(ix) fieldvalue = Request.Form.Item(ix) '/// Retrieve Only if it is not an ignored value if instr(1,ignorefields,vbcrlf & formfield & vbcrlf,1)=0 and formfield<>"formid" and formfield<>"_preview" and formfield<>"_referer" then fieldvalue=request.form(formfield) d.add formfield,fieldvalue end if next '/// Perform Server-Side validation if fieldvalidation<>"" then errormsg="" '/// Set RegEx Object Set regex = New RegExp '/// get each line of code lines=split(fieldvalidation,vbcrlf) '/// Translate each line into the proper code for x=0 to ubound(lines) if instr(lines(x),":")>0 then statements=split(lines(x),":") fieldname=trim(statements(0)) rules=trim(statements(1)) '/// Process each rule : rule=split(rules," ") ruletext="" for y=0 to ubound(rule) '/// If the field exists, process the rule fieldvalue="" if d.exists(fieldname) then fieldvalue=d.item(fieldname) '/// Is a comparison rule ? trule=lcase(rule(y)) if instr(trule,"=")<>0 then parts=split(trule,"=") if ubound(parts)=1 then tvalue=parts(1) '/// Rule Value tcompare=parts(0) '/// Comparison '/// If the value is numeric then the comparison can be made if isnumeric(tvalue) then if tcompare="maxlen" and not(ismaxlen(fieldvalue,tvalue)) then errormsg = errormsg & "- Field '" & fieldname & "' cannot contain more than " & tvalue & " characters." & vbcrlf if tcompare="minlen" and not(isminlen(fieldvalue,tvalue)) then errormsg = errormsg & "- Field '" & fieldname & "' cannot contain less than " & tvalue & " characters." & vbcrlf if tcompare="lt" and not(lt(fieldvalue,tvalue)) then errormsg = errormsg & "- Field '" & fieldname & "' should be numeric and lesser than " & tvalue & vbcrlf if tcompare="gt" and not(gt(fieldvalue,tvalue)) then errormsg = errormsg & "- Field '" & fieldname & "' should be numeric and greater than " & tvalue & vbcrlf end if end if else if (trule="req" or trule="required") and fieldvalue="" then errormsg=errormsg & "- Field '" & fieldname & "' is required." & vbcrlf if (trule="num" or trule="numeric") and not(isnumeric(fieldvalue)) then errormsg=errormsg & "- Field '" & fieldname & "' is not numeric." & vbcrlf if (trule="int" or trule="integer") and not(isinteger(fieldvalue)) then errormsg=errormsg & "- Field '" & fieldname & "' is not integer." & vbcrlf if (trule="nspc" or trule="nospaces") and instr(fieldvalue," ")<>0 then errormsg=errormsg & "- Field '" & fieldname & "' cannot contain spaces." & vbcrlf if (trule="alnum" or trule="alphanumeric") and not(isalphanumeric(fieldvalue)) then errormsg=errormsg & "- Field '" & fieldname & "' can only contain alphanumeric characters." & vbcrlf if (trule="alpha" or trule="alphabetic") and not(isalphabetic(fieldvalue)) then errormsg=errormsg & "- Field '" & fieldname & "' is can only contain alphabetic characters." & vbcrlf if trule="email" and not(isemail(fieldvalue)) then errormsg=errormsg & "- Field '" & fieldname & "' does not contain a valid e-mail address." & vbcrlf if (trule="cc" or trule="creditcard") and not(isCC(fieldvalue)) then errormsg=errormsg & "- Field '" & fieldname & "' contains a non valid credit card number." & vbcrlf end if next 'y end if next 'x set regex=nothing '/// Any Errors ? /// if errormsg<>"" then if promptvalidationerrors<>"" then conn.close set conn=nothing response.write "alert('The form could not be submitted :\n" & preparemsg(errormsg) & "');history.back();" response.end else call showerror("Invalid Fields",replace(errormsg,vbcrlf,"
")) end if end if end if '//// Do Preview ///' if dopreview<>"" then conn.close() set conn=nothing%> <% response.end() end if '/// Prepare Collected data for database / e-mailing for each fieldname in d.keys '/// If encrypted field, encrypt it fieldvalue=d.item(fieldname) isencrypted=false if instr(1,encryptfields,vbcrlf & fieldname & vbcrlf,1)<>0 then fieldvalue=rc4(fieldvalue,encryptpwd) isencrypted=true end if submissionform=submissionform & fieldname & divider submissiondata=submissiondata & fieldvalue & divider '/// Field should be hidden ? ///' if instr(1,hidefields,vbcrlf & fieldname & vbcrlf,1)=0 then message=message & replace(fieldname,"_"," ") & " : " if isencrypted then fieldvalue="[*** ENCRYPTED ***]" if len(fieldvalue)>100 or instr(fieldvalue,vbcrlf)>0 then message=message & vbcrlf & fieldvalue & vbcrlf & vbcrlf else message=message & fieldvalue & vbcrlf end if next '//// Save Form To Database if savetodb<>"" then submissionform=replace(submissionform,"'","''") & "" submissiondata=replace(submissiondata,"'","''") & "" thisdate=todaydate & " " & time '//// Insert into database conn.execute("insert into xlaAFPsubmissions (formid,dateposted,ip,submissionform,submissiondata) values (" & formid & ",'" & thisdate & "','" & ip & "','" & submissionform & "','" & submissiondata & "')") submissionid=conn.execute("select @@IDENTITY as submissionid").Fields("submissionid").value end if '/// Send By E-mail if forwardtoemails<>"" or forwardtousers<>"" or forwardtofield<>"" then if forwardtoemails<>"" then emails=formatrequest(forwardtoemails) & vbcrlf if forwardtousers<>"" then psql="select email from xlaAFPusers where userid in (select userid from xlaAFPiUsersForms where formid=" & formid & ") and email like '%@%.%'" set rs=conn.execute(psql) if not(rs.eof) then emails=emails & rs.getstring(,,,vbcrlf,"") & vbcrlf rs.close set rs=nothing end if if forwardtofield<>"" then whichfields=formatrequest(forwardtofield) eachfield=split(whichfields,vbcrlf) for x=0 to ubound(eachfield) emails=emails & d.item(eachfield(x)) & vbcrlf next end if message="Received : " & now & vbcrlf & "Form : " & formname & vbcrlf & "Submission ID : " & submissionid & vbcrlf & "User IP : " & ip & vbcrlf & "______________________" & vbcrlf & message subject=formname if submissionid<>"" and includesubjectid<>"" then subject=subject & " (" & submissionid & ")" if replytofield<>"" then replyto=d.item(replytofield) '/// Send E-mail 'call sendmail(emails,replyto,subject,message) 'emails = "freecd@shareislam.com" call sendmail(emails,replyto,subject,message) '/// Send Autoresponse if replyto<>"" and (autoresponse<>"" or sendcopy<>"") then if sendcopy<>"" then autoresponse=autoresponse & vbcrlf & vbcrlf & message call sendmail(replyto,mailadmin,formname,autoresponse) end if end if '/// Close Database Connection conn.close set conn=nothing '/// Select Redirection Page 'pagereferer = "http://www.designedwithfaith.com/oscommerce/catalog/free_confirmation.php" pagereferer = request.form("confirmation_url") if redirecttopage="" then redirecttopage=pagereferer '/// Thank you message & redirect if promptmessage<>"" then response.write "alert('" & preparemsg(promptmessage) & "');" if redirecttopage<>"none" then response.write "self.location.href='" & redirecttopage & "';" response.write "" response.end elseif displayhtml<>"" then response.write displayhtml if redirecttopage<>"none" then response.write "" response.end else if redirecttopage="" then redirecttopage=siteurl response.write "

" For Each item In Request.Form Response.Write "" Next response.write "

" %> <% response.write "" 'response.redirect redirecttopage end if %>