viewsurveyresultpage.asp

implementation of survey

<%

Response.Buffer = True 
On Error Resume Next
dim htmlCode, tempCode 

htmlCode = ""
tempCode = ""

if not session("viewingRight")="yes" then
   tempCode="<h2 align='center' style='color:#FF9999; margin-top:100px;'>Sorry, you don't have right to access the survey data</h2>"
   htmlCode = html  &  tempCode
   response.Write tempCode
end if
if session("viewingRight")="yes" then	
	analyze()
	tempCode = "<p style='margin-left:500px;'><a href='#' onClick='window.print()'>Print me!</a>"
	htmlCode = htmlCode  &  tempCode
	response.Write(tempCode)	
	tempCode = "<a href='customizedAnalysis.asp' style='margin-left:10px;' >CustomizedAnalysis</a></p>"
	htmlCode = htmlCode  &  tempCode
	response.Write(tempCode)	
	createReportSnapShot htmlCode
end if

function getAnswerTitleFromAnswerMark(answerSheetId)
		dim xmlsPath, questionDom, tablesNum, i, k, answersNode, currentQuestion, answerId
		
		currentQuestion = ""
		xmlsPath = Server.MapPath("../xmls")
		
		set questionDom = Server.CreateObject("Microsoft.XMLDOM")
		questionDom.async = false
		questionDom.load(xmlsPath & "/surveyInfo.xml")
		set answersNode = questionDom.getElementsByTagName("answer_E")
		tablesNum = answersNode.length
		answerId = answerSheetId
		k = inStr(1, answerSheetId, "rank", 1) 
		if k > 0 then
				answerId = left(answerSheetId, k-1 )
		end if
		
		for i = 0 to tablesNum-1 step 1
				if answersNode.item(i).getAttribute("id")= answerId then
					currentQuestion = answersNode.item(i).Text
				end if
		next
		getAnswerTitle = currentQuestion
		
		set answersNode =nothing
		set questionDom = nothing
		getAnswerTitleFromAnswerMark = currentQuestion
end function

function getCheckedCount(tableName, columnName)
		dim databasePath, accessDB, con, rcs, answersSet, sql, num
		
		databasePath = Server.MapPath("../database")
		accessDB = databasePath & "/surveyData.mdb"
		set con = server.createObject("ADODB.Connection")
		set rcs = server.createObject("ADODB.Recordset")
		set answersSet = server.createObject("ADODB.Recordset")
		con.provider = "Microsoft.Jet.OLEDB.4.0"
		con.Open(accessDB)
		sql = "select * from " & tableName & " where " & columnName & " = -1 "
		rcs.open sql, con, 1, 1
		num = rcs.RecordCount
		
		
		set answersSet = nothing
		set rcs = nothing
		set con = nothing
		getCheckedCount = num
end function



function getSelectedCount(tableName, optionNum)
		dim databasePath, accessDB, con, rcs, answersSet, sql, num
		
		databasePath = Server.MapPath("../database")
		accessDB = databasePath & "/surveyData.mdb"
		set con = server.createObject("ADODB.Connection")
		set rcs = server.createObject("ADODB.Recordset")
		set answersSet = server.createObject("ADODB.Recordset")
		con.provider = "Microsoft.Jet.OLEDB.4.0"
		con.Open(accessDB)
		sql = "select * from " & tableName & " where " & tableName & " = " & optionNum
		rcs.open sql, con, 1, 1
		num = rcs.RecordCount
		
		
		set answersSet = nothing
		set rcs = nothing
		set con = nothing
		getSelectedCount = num
end function

function getTextCommentsNum(tableName, subAnserTitle)
		dim databasePath, accessDB, con, rcs, answersSet, sql, num
		
		databasePath = Server.MapPath("../database")
		accessDB = databasePath & "/surveyData.mdb"
		set con = server.createObject("ADODB.Connection")
		set rcs = server.createObject("ADODB.Recordset")
		set answersSet = server.createObject("ADODB.Recordset")
		con.provider = "Microsoft.Jet.OLEDB.4.0"
		con.Open(accessDB)
		sql = "select "& subAnserTitle &" from " & tableName & " where " & subAnserTitle & " <> '' "
		rcs.open sql, con, 1, 1
		num = rcs.RecordCount
		
		set answersSet = nothing
		set rcs = nothing
		set con = nothing
		getTextCommentsNum = num
end function


function getQuestionAnsweredTimes(questionId)
		dim xmlsPath,  answerDom, answersNode,  answersNum, i, k, answerId, sql, condition, questionType, temp
		
		xmlsPath = Server.MapPath("../xmls")
	
		set answerDom = Server.CreateObject("Microsoft.XMLDOM")
		answerDom.async = false
		answerDom.load(xmlsPath & "/answerSheetModel.xml")	
		set answersNode = answerDom.getElementsByTagName("answer")
		
		questionType = getQuestionType(questionId)
		

		answersNum = answersNode.length				
		sql="SELECT * FROM " & questionId & " Where "

		condition=""
		for i = 0 to answersNum-1 step 1
				answerId = answersNode.item(i).getAttribute("id")
				if inStr(answerId, "answer") <> 0 then
						temp= left(answerId, inStr(answerId,"answer")-1)
				else
						temp = answerId
				end if
				if trim(LCase(temp))= trim(LCase(questionId)) then
					if inStr(1, questionType, "text", 1 )<>0 then
							condition =condition &  answerId & " <>'' OR "
						else
							condition =condition & answerId & " <> 0 OR "
					end if
				end if
		next
		condition =left(condition, len(condition)-3)
		sql = sql & condition
	'	response.Write(sql)
		set answerDom = nothing
		set answersNode = nothing


		dim databasePath, accessDB, con, rcs, answersSet, num
		
		databasePath = Server.MapPath("../database")
		accessDB = databasePath & "/surveyData.mdb"
		set con = server.createObject("ADODB.Connection")
		set rcs = server.createObject("ADODB.Recordset")
		con.provider = "Microsoft.Jet.OLEDB.4.0"
		con.Open(accessDB)

		rcs.open sql, con, 1, 1
		num = rcs.RecordCount	

		set rcs = nothing
		set con = nothing
		getQuestionAnsweredTimes =  num

	'	response.Write("function getQuestionAnsweredTimes works well   result: " & num)
end function


function getSubQuestionReplyTimes(questionId, gridAnswerId)
		dim xmlsPath,  answerDom, answersNode,  answersNum, i, k, answerId, sql, condition, questionType, temp
		
		xmlsPath = Server.MapPath("../xmls")
	
		set answerDom = Server.CreateObject("Microsoft.XMLDOM")
		answerDom.async = false
		answerDom.load(xmlsPath & "/answerSheetModel.xml")	
		set answersNode = answerDom.getElementsByTagName("answer")
		
		questionType = getQuestionType(questionId)
		
		answersNum = answersNode.length				
		sql="SELECT * FROM " & questionId & " Where "

		condition=""
		for i = 0 to answersNum-1 step 1
				answerId = answersNode.item(i).getAttribute("id")
				if inStr(LCase(answerId), "rank")<>0 then
					temp = left(answerId, inStr(answerId,"rank")-1)
				else
					temp = answerId
				end if
				if trim(LCase(temp))= trim(LCase(gridAnswerId)) then
					if inStr(1, questionType, "text", 1 )>0 then
							condition =condition &  answerId & " <>'' OR "
						else
							condition =condition & answerId & " < 0 OR " & answerId & " > 0 OR "
					end if
				end if
		next
		condition =left(condition, len(condition)-3)
		sql = sql & condition
		set answerDom = nothing
		set answersNode = nothing


		dim databasePath, accessDB, con, rcs, answersSet, num
		
		databasePath = Server.MapPath("../database")
		accessDB = databasePath & "/surveyData.mdb"
		set con = server.createObject("ADODB.Connection")
		set rcs = server.createObject("ADODB.Recordset")
		con.provider = "Microsoft.Jet.OLEDB.4.0"
		con.Open(accessDB)

		rcs.open sql, con, 1, 1
		num = rcs.RecordCount	

		set rcs = nothing
		set con = nothing
		getSubQuestionReplyTimes =num

end function

function createTextDoc(questionId, subAnserTitle, questionTitle, answerName)

		on error resume next
		if Err.number<>0 then
			response.Write "Failed to craete a word document for text comments"
		end if
		
		dim databasePath, accessDB, con, rcs, answersSet, num
		folderPath = Server.MapPath("../comments") 
		
		databasePath = Server.MapPath("../database")
		accessDB = databasePath & "/surveyData.mdb"
		set con = server.createObject("ADODB.Connection")
		set rcs = server.createObject("ADODB.Recordset")
		con.provider = "Microsoft.Jet.OLEDB.4.0"
		con.Open(accessDB)
		sql = "SELECT  * FROM " & questionId & " WHERE " & subAnserTitle & " <> ''"
		rcs.open sql, con, 1, 1

		dim creator,docFile
		set creator=Server.CreateObject("Scripting.FileSystemObject")
		set docFile=creator.CreateTextFile(folderPath & "/"& subAnserTitle & ".doc",true)
		docFile.WriteLine  questionTitle 
		docFile.WriteLine  answerName