Voting Poll

<% @Language="VBScript" %> <% OPTION EXPLICIT %> <% '/*********************************************************************************** '* * '* Developed By: Corsair Developments (corsairdev.com) * '* * '* Description: Polling Script to provide an interactive poll. * '* * '* Date Finished: 07/14/2002 * '* Date Modified: 07/18/2002 * '* Copyright: (C) 2002 Corsair Developments * '* * '* This script may be freely used. * '* * '***********************************************************************************/ 'To reset the results you'll need to go add ?Admin=ResetResults onto the URL and it will automatically 'reset the file that is holding the values. For example: 'http://www.somewebsite.com/ThisFile.asp?Admin=ResetResults '*********** BEGIN GLOBAL VARIABLES ***********' 'Constants needed to tell FileSystemObject what to do. Const ForReading = 1 Const ForWriting = 2 Const ForAppending = 8 Const TriStateUseDefault = -2 Const TriStateTrue = -1 Const TriStateFalse = 0 'change strOptionsArray() to hold the number of options 'change intValuesArray() and intResultsArray() to hold one more then the number of options. 'don't change strBarColors() unless you add more color images for bar graphs. Dim strOptionsArray(5), intValuesArray(6), intResultsArray(6), strBarColors(9), strFileLocation 'form options strOptionsArray(0) = "This script is great!" strOptionsArray(1) = "This script is pretty darn good" strOptionsArray(2) = "This script could be worse" strOptionsArray(3) = "This script isn't that great" strOptionsArray(4) = "This script blows!" 'bar graph colors strBarColors(0) = "red.gif" strBarColors(1) = "blue.gif" strBarColors(2) = "green.gif" strBarColors(3) = "yellow.gif" strBarColors(4) = "orange.gif" strBarColors(5) = "aqua.gif" strBarColors(6) = "purple.gif" strBarColors(7) = "black.gif" strBarColors(8) = "gray.gif" Const intMaxSize = 300 'this is the size in pixels of how big the bar graph can be. 'IMPORTANT: uncomment the string that applies to you (only one strFileLocation should be uncommented) 'must point to a directory that has "write" permissions. strFileLocation = Server.MapPath("\asp") & "\pollResults.txt" Const strThisFile = "PollScript.asp" 'name of this file. Const strImageDir = "images/" 'name of the directory that holds images relative to this file. '************ END GLOBAL VARIABLES ************' Sub VoteForm() %> Voting Poll Vote Here!:
View Results <% End Sub Sub ShowResults(oFSO) 'check to make sure the FileSystemObject passed in IS an Object If (IsObject(oFSO)) Then 'Declare local variables, REMEMBER arrays need to hold one more 'spot then there are options to hold the total tally Dim oFSStream, counter, innerCounter, intPercent, intPercentInteger, intPercentDecimal, strPercent 'get the file to input the results Set oFSStream = oFSO.OpenTextFile(strFileLocation, ForReading) 'input the results For counter = 0 to (UBound(strOptionsArray) - 1) intValuesArray(counter) = CInt(replace(oFSStream.ReadLine, vbCrLf, "")) Next 'don't forget we have the total tally to get as well. intValuesArray(UBound(strOptionsArray)) = CInt(replace(oFSStream.ReadLine, vbCrLf, "")) '**************** EDIT THE LOOK OF THE RESULTS HERE 'Starting HTML here Response.Write "" & vbCrLf & "" & vbCrLf & vbTab & "Voting Results" & vbCrLf & "" & vbCrLf Response.Write "" & vbCrLf 'output each option and it's percentage of votes. For counter = 0 to (UBound(strOptionsArray) - 1) Response.Write vbTab & "" & vbCrLf & vbTab & "" & vbCrLf & vbTab & "" & vbCrLf Next Response.Write "

" 'This actually outputs to the screen. 'First we output the name of the option followed by a ":" 'then we output the percentage of the total votes 'If you want to change how it is outputed then change this line Response.Write strOptionsArray(counter) & ":

" & " (intPercent * 100)) Then intPercentInteger = intPercentInteger - 1 End If intPercentDecimal = CInt(CDbl((intPercent * 100) - intPercentInteger) * 100) 'get the first two decimals strPercent = CStr(intPercentInteger & "." & intPercentDecimal) Response.Write " BORDER=""0"" ALT=""" & strPercent & "%"" HEIGHT=""20"" WIDTH=""" & CInt((CDbl(intValuesArray(counter) / intValuesArray(UBound(strOptionsArray))) * intMaxSize)) & """>" Response.Write " (" &strPercent & "%)
" Response.Write "

" & vbCrLf 'output the total number of votes cast. Response.Write "

" & vbCrLf Response.Write "Total Votes Cast: " & intValuesArray(UBound(strOptionsArray)) & vbCrLf 'Ending HTML here Response.Write vbCrLf & "

Back to Poll" & vbCrLf Response.Write vbCrLf & "" & vbCrLf & "" '**************** STOP EDITTING THE LOOK OF THE RESULTS HERE Else 'Write an error. 'Starting HTML here Response.Write "" & vbCrLf & "" & vbCrLf & vbTab & "Voting Results" & vbCrLf & "" & vbCrLf 'error here. Response.Write "Unable to locate results
" 'Ending HTML here Response.Write vbCrLf & "" & vbCrLf & "" End If End Sub Sub StoreResults(strOption) 'Declare local variables, REMEMBER arrays need to hold one more 'spot then there are options to hold the total tally Dim oFSO, oFSStream, counter 'create a FileSystem Object Set oFSO = Server.CreateObject("Scripting.FileSystemObject") 'Check to see if the File doesn't exist, because if it 'doesn't then we must create the file. Otherwise, we want to 'read in the old results. If (oFSO.FileExists(strFileLocation)) Then 'open the file for reading. Set oFSStream = oFSO.OpenTextFile(strFileLocation, ForReading) Else 'create a default file with 0 tallys Set oFSStream = oFSO.CreateTextFile(strFileLocation) For counter = 0 to (UBound(strOptionsArray) - 1) oFSStream.WriteLine 0 Next oFSStream.WriteLine 0 'now reopen for reading. Set oFSStream = oFSO.OpenTextFile(strFileLocation, ForReading) End If 'Get the old results For counter = 0 to (UBound(strOptionsArray) - 1) 'read in the value from the text file, and convert it to an 'integer, while replacing any New Line characters encountered. intResultsArray(counter) = CInt(replace(oFSStream.ReadLine, vbCrLf, "")) Next 'read in the last line which is the total tally of all the votes. 'NOTE: remember arrays are referenced at 0, so although we are referencing 'the spot that you would think is the last option's tally, it is really the 'spot we reserved for the total, because UBound(strOptionsArray) - 1 is really the last 'option's tally. intResultsArray(UBound(strOptionsArray)) = CInt(replace(oFSStream.ReadLine, vbCrLf, "")) 'decide which option's tally needs to be updated. For counter = 0 to (UBound(strOptionsArray) - 1) 'if the option selected matches the Option in the array 'for the value of the variable i then increment the Results array If (strOption = strOptionsArray(counter)) Then intResultsArray(counter) = intResultsArray(counter) + 1 End If Next 'increment the total tally intResultsArray(UBound(strOptionsArray)) = intResultsArray(UBound(strOptionsArray)) + 1 'open the file to write. Set oFSStream = oFSO.OpenTextFile(strFileLocation, ForWriting) 'write the new results to the file. For counter = 0 to (UBound(strOptionsArray) - 1) oFSStream.WriteLine intResultsArray(counter) Next 'write, as the last line, the total oFSStream.WriteLine intResultsArray(UBound(strOptionsArray)) 'show the results and pass the FileSystemObject into the sub procedure 'to save resources so we don't have to reopen a new one. call ShowResults(oFSO) 'destroy unused objects. oFSStream.Close Set oFSStream = Nothing Set oFSO = Nothing End Sub '**************************************************************** '*************** DECIDE WHAT TO DO WITH PAGE HERE *************** '**************************************************************** 'Check to see if there are any Form Submission Variables, 'If there are, update and display the results, otherwise show form. If (Request.Form("Option") <> "") Then call StoreResults(Request.Form("Option")) Else If (Request.QueryString("show") = "results") Then Dim oFSO Set oFSO = Server.CreateObject("Scripting.FileSystemObject") call ShowResults(oFSO) Set oFSO = Nothing Else If (Request.QueryString("Admin") = "ResetResults") Then Dim oFSOReset, oFSReset Set oFSOReset = Server.CreateObject("Scripting.FileSystemObject") Set oFSReset = oFSOReset.CreateTextFile(strFileLocation) oFSReset.Close Set oFSO = Nothing Set oFSReset = Nothing Response.Write "Poll Results reset" Else call VoteForm() End If End If End If %>