<% '/// Get Data pollid=request("p") '/Poll ID zoneid=request("z") '/Zone ID font=request("font") fontsize=request("fontsize") fontcolor=request("fontcolor") css=request("css") nostyle=request("nostyle") xlaparsing=request("xlaparsing") nocache=request("nocache") if pollid="" and zoneid="" then response.end if xlaparsing<>"" then response.buffer=true response.flush else response.ContentType="application/x-javascript" end if '/// Generate Unique ID for the poll randomize uid="_"&zoneid '/// Check Protection /// callingurl=Request.ServerVariables("HTTP_REFERER") if zoneprotection<>"any" and instr(1,callingurl,applicationurl,1)=0 and callingurl<>"" then hasparameters=instr(callingurl,"?") if hasparameters>0 then callingurl=left(callingurl,hasparameters-1) specialurls=split(lcase(specialurls),";") for x=0 to ubound(specialurls) if instr(1,callingurl,specialurls(x),1)<>0 then takeaction=true exit for end if next if zoneprotection="restricted" and takeaction=false then response.end if zoneprotection="banned" and takeaction=true then response.end end if '/// Load possible answers //// sub loadanswers(questionformat,addcount) if addcount=1 then counter=counter-1 do until questionid2<>questionid or rs.eof answer=rs("answer") thisquestion=replace(questionformat,"[[ANSWER]]",rs("answer")) thisquestion=replace(thisquestion,"[[ANSWERID]]",rs("answerid")) if addcount=1 then counter=counter+1 thisquestion=replace(thisquestion,"[[COUNTER]]",counter) end if xlaapm=xlaapm & thisquestion rs.movenext if not(rs.eof) then questionid2=rs("questionid") loop end sub '/// Prepare javascript code function prepare(msg) thismsg=msg thismsg=replace(thismsg,"\","\\") thismsg=replace(thismsg,"'","\'") thismsg=replace(thismsg,vbcrlf,"\n") thismsg=replace(thismsg,"/","\/") thismsg=replace(thismsg,chr(34),"\" & chr(34)) prepare=thismsg end function set conn=server.createobject("ADODB.Connection") conn.open connection '/// Update Expired Polls xlaAPMLastUpdate=application("xlaAPMLastUpdate") if xlaAPMLastUpdate<>todaydate then psql="update xlaAPMpolls set status=0 where enddate<'"&todaydate&"'" conn.execute(psql) application("xlaAPMLastUpdate")=todaydate end if '//// Get The Poll or Zone /// psql="select * from xlaAPMpolls where pollid="&pollid if pollid="" then psql="SELECT Top 1 xlaAPMpolls.*, xlaAPMzones.autorefresh, xlaAPMzones.allowprevious, xlaAPMzones.zonefont, xlaAPMzones.zonesize, xlaAPMzones.zonecolor FROM xlaAPMpolls INNER JOIN (xlaAPMzones INNER JOIN xlaAPMiPollsPerZone ON xlaAPMzones.zoneid = xlaAPMiPollsPerZone.zoneid) ON xlaAPMpolls.pollid = xlaAPMiPollsPerZone.pollid" psql=psql & " where xlaAPMzones.zoneid="&zoneid&" and xlaAPMpolls.status=1 and xlaAPMpolls.startdate<='"&todaydate&"' and xlaAPMpolls.enddate>='"&todaydate&"'" psql=psql & " and xlaAPMpolls.pollid in (select pollid from xlaAPMquestions) order by xlaAPMpolls.internalhits asc;" end if set rs=conn.execute(psql) if not(rs.eof) then pollid=rs("pollid") allowviewresults=rs("allowviewresults") displaynumbers=rs("displaynumbers") allowcomments=rs("allowcomments") displaycomments=rs("displaycomments") if zoneid<>"" then autorefresh=rs("autorefresh") allowprevious=rs("allowprevious") xlafont=rs("zonefont") xlafontsize=rs("zonesize") xlafontcolor=rs("zonecolor") end if else pollid=0 end if rs.close set rs=nothing '/// Override parameters if fontsize<>"" then xlafontsize=fontsize if font<>"" then xlafont=font if fontcolor<>"" then xlafontcolor=fontcolor if css<>"" then css=" class="&chr(34)&css&chr(34) else css=" style="&chr(34)&"font-family:"&xlafont&";font-size:"&xlafontsize&";color:"&xlafontcolor&";"&chr(34) if nostyle<>"" then css="" '///Update Poll Internal Hits /// psql="update xlaAPMpolls set hits=hits+1,internalhits=internalhits+1 where pollid="&pollid conn.execute(psql) conn.close set conn=nothing '/// Poll Cache /// if pollcache<>"" then dim resultfile resultfile="" call getcache(pollid,nocache) end if '/// Generate Poll //// set conn=server.createobject("ADODB.Connection") conn.open connection psql="SELECT xlaAPMquestions.*, xlaAPManswers.answerid, xlaAPManswers.answer FROM xlaAPMquestions INNER JOIN xlaAPManswers ON xlaAPMquestions.questionid = xlaAPManswers.questionid where pollid="&pollid&" ORDER BY xlaAPMquestions.qorder, xlaAPManswers.answerid" Set rs = conn.execute(psql) if not(rs.eof) then nq=0 dim counter counter=0 questionnr=0 '/// generate Rating scale /// if not(isnumeric(rsfrom)) or rsfrom="" then rsfrom=1 rsto=10 rsincr=1 end if for x=rsfrom to rsto step rsincr ratingscale=ratingscale & "" next xlaapm="
" do until rs.eof questionid=rs("questionid") qtype=rs("qtype") questionid2=questionid counter=counter+1 if displaynumbers<>"" then questionnr=questionnr+1 qnumber=questionnr & ") " end if xlaapm=xlaapm & "" select case qtype case 0 'Radio Buttons questionformat="" xlaapm=xlaapm & "" call loadanswers(questionformat,0) case 1 'Check Boxes questionformat="" call loadanswers(questionformat,1) case 2 'Drop Down Lists xlaapm=xlaapm & "" case 3 'Free text single line xlaapm=xlaapm & "" rs.movenext case 4 'Free text Multi line xlaapm=xlaapm & "" rs.movenext case 5' Rating Scale questionformat="" call loadanswers(questionformat,1) end select xlaapm=xlaapm & "" loop '//// Allow Comments ? /// if allowcomments<>"" then if multiline<>"" then box="" else box="" end if xlaapm=xlaapm &"" end if xlaapm=xlaapm & "" '/// Allow View results /// if allowviewresults<>"" then xlaapm=xlaapm & "" '/// Allow Comments To be Displayed if displaycomments<>"" then xlaapm=xlaapm & "" '/// Allow Previous Polls /// if allowprevious<>"" then xlaapm=xlaapm & "" xlaapm=xlaapm&"
"&qnumber&rs("question")&"
[[ANSWER]]
[[ANSWER]]
[[ANSWER]]
  
"&commentslabel&"
"&box&"
 
View Results
View Comments
Previous Polls
" end if rs.close set rs=nothing conn.close set conn=nothing if xlaapm<>"" then thepoll="function vetAnswers" & pollid & uid &"(){"& vbcrlf thepoll = thepoll & "var yes = 0;"& vbcrlf thepoll = thepoll & "var no = 0;"& vbcrlf thepoll = thepoll & " for (var i=1;i<" & counter+1 &";i++) {"& vbcrlf thepoll = thepoll & " if (eval('document.xlaapmform" & pollid&uid&".answer' + i + '.value') !='') {"& vbcrlf thepoll = thepoll & " yes++;"& vbcrlf thepoll = thepoll & " } "& vbcrlf thepoll = thepoll & " }"& vbcrlf thepoll = thepoll & " if (yes == " & counter &") {"& vbcrlf thepoll = thepoll & " return true;"& vbcrlf thepoll = thepoll & " }"& vbcrlf thepoll = thepoll & " else {"& vbcrlf thepoll = thepoll & " alert('Please answer all the questions before submitting');"& vbcrlf thepoll = thepoll & " return false;"& vbcrlf thepoll = thepoll & " }"& vbcrlf thepoll = thepoll & " }"& vbcrlf thepoll = thepoll & "function xlaapmsubmit" & pollid&uid & "(){"& vbcrlf thepoll = thepoll & " if (vetAnswers" & pollid&uid&"()){"& vbcrlf thepoll = thepoll & " xlaapmxe = window.open('','xlaapmxe','toolbar=0,location=0,status=1,menubar=1,scrollbars=1,resizable=1,width=" & wwidth & ",height=" & wheight & "');"& vbcrlf thepoll = thepoll & " document.xlaapmform" & pollid&uid & ".submit();"& vbcrlf thepoll = thepoll & " xlaapmxe.focus();"& vbcrlf if autorefresh<>"" then thepoll = thepoll & "location.href = location.href;"& vbcrlf thepoll = thepoll & " }"& vbcrlf thepoll = thepoll & "}"& vbcrlf '/// Allow View Results ? if allowviewresults<>"" then thepoll = thepoll & "function xlaviewresults" & pollid&uid &"(){"& vbcrlf thepoll = thepoll & "xlaapmxe = window.open('" & applicationurl & "xlaapmview.asp?p=" & pollid & "','xlaapmxe','toolbar=0,location=0,status=1,menubar=1,scrollbars=1,resizable=1,width=" & wwidth & ",height=" & wheight &"');"& vbcrlf thepoll = thepoll & "}"& vbcrlf end if '/// Allow Display Comments ? if displaycomments<>"" then thepoll = thepoll & "function xlaviewcomments" & pollid&uid & "(){"& vbcrlf thepoll = thepoll & "xlaapmxe = window.open('" & applicationurl &"xlacomments.asp?p=" & pollid & "','xlaapmxe','toolbar=0,location=0,status=1,menubar=1,scrollbars=1,resizable=1,width=" & wwidth & ",height=" & wheight & "');"& vbcrlf thepoll = thepoll & "}"& vbcrlf end if '/// Allow Previous Polls /// if allowprevious<>"" and zoneid<>"" then thepoll = thepoll & "function xlaviewprevious" & pollid&uid & "(){"& vbcrlf thepoll = thepoll & "xlaapmxe = window.open('" & applicationurl & "xlalistprevious.asp?z=" & zoneid & "','xlaapmxe','toolbar=0,location=0,status=1,menubar=1,scrollbars=1,resizable=1,width=" & wwidth & ",height=" & wheight & "');"& vbcrlf thepoll = thepoll & "}"& vbcrlf end if if xlaparsing<>"" then thepoll=""&xlaapm else thepoll = thepoll & " document.write('" & prepare(xlaapm) &"');"& vbcrlf end if else '/// There are No Polls available if nopollmsg<>"" then nopollmsg="

"&nopollmsg&"

" if not(xlaparsing) then nopollmsg="document.write('"&prepare(nopollmsg)&"');" thepoll=nopollmsg end if resultfile="" end if '/// Display Poll response.write thepoll '/// Do Cache ? /// if pollcache<>"" and resultfile<>"" then call writecache(resultfile,thepoll) %>