⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 processdata.asp

📁 implementation of survey
💻 ASP
字号:
<%
Response.Buffer = True 
On Error Resume Next

dim arrayId, arrayValue, folderPath, dbPath
dim con, rcs, sql, children, num, i, nodeId, xmlDoc, currentSurvey

folderPath = Server.MapPath("../database")
accessDB = folderPath & "/surveyData.mdb"

set xmlDoc = server.CreateObject("Microsoft.xmlDom")
xmlDoc.async = false
xmlDoc.load Request
if ifSurveyed() then
		if validCheck(xmlDoc) then
			    pushDataIntoDatabase(xmlDoc)
                delTempXml()
		else
				response.Write("The question with Star has to be answered") 
		end if
else
		response.Write("Sorry, you submitted survey")
end if

function ifSurveyed()
		dim sql, thisIP, recordsNum, currentTime, rcs, trafficLight, temp
		dim questionsDom, questionsList, questionsNode, tablesNum, questionId,  num
		set con = server.createObject("ADODB.Connection")
		set rcs = server.createObject("ADODB.Recordset")
		con.provider = "Microsoft.Jet.OLEDB.4.0"
		con.Open(accessDB)
		thisIP = Request.ServerVariables("REMOTE_ADDR")
		currentTime = Now
		trafficLight = true
		
		set questionsDom = Server.CreateObject("Microsoft.XMLDOM")
		questionsDom.async = false
		questionsDom.load(Server.MapPath("../xmls") & "/surveyInfo.xml")
		set questionsNode = questionsDom.getElementsByTagName("question")
		tablesNum = questionsNode.length	
		questionId = questionsNode.item(0).getAttribute("id")
		sql = "select surveyTime from " & questionId & " where IP LIKE """ & thisIP & """"
		rcs.open sql, con, 1, 1
		num = rcs.RecordCount

		if num > 0 then
				do until rcs.EOF
						temp = rcs.fields("surveyTime")
						rcs.MoveNext
				loop
				temp = DateDiff("s", temp, currentTime)
				if temp <3 then
						trafficLight = false
				end if
		end if

		set questionsNode = nothing
		set questionDom = nothing
		set rcs = nothing
		set con = nothing		
		ifSurveyed = trafficLight
end function


function pushDataIntoDatabase(xmlDoc)
		dim questionsDom, questionsList, questionsNode, tablesNum, questionId, k, sql , temp
		
		set children = xmlDoc.getElementsBytagName("answer")
		num = children.length

		set con = server.createObject("ADODB.Connection")
		con.provider = "Microsoft.Jet.OLEDB.4.0"
		con.Open(accessDB)
		
		set questionsDom = Server.CreateObject("Microsoft.XMLDOM")
		questionsDom.async = false
		questionsDom.load(Server.MapPath("../xmls") & "/surveyInfo.xml")
		set questionsNode = questionsDom.getElementsByTagName("question")
		tablesNum = questionsNode.length		

		dim thisIP, currentTime, fore
		currentTime = Now
		thisIP = Request.ServerVariables("REMOTE_ADDR")
		yuyan = session("language")
		for k = 0 to tablesNum-1 step 1
			sql=""
			questionId = questionsNode.item(k).getAttribute("id")
			thisDataType = questionsNode.item(k).childNodes.item(3).childNodes.item(0).Text		
	
					sql = "INSERT INTO " & questionId & " ("
	
					arrayId = "IP, surveyTime, EnOrFn, " 
					arrayValue ="'" & thisIP &"', '" &  currentTime & "', '" & yuyan & "', "
			
					for i = 0 to num-1 step 1
							nodeId = children.item(i).getAttribute("id")
							if inStr(nodeId, "answer") <> 0 then
									temp = left(nodeId, inStr(nodeId, "answer")-1)
							else
									temp = nodeId
							end if				
							if trim(LCase(temp)) = trim(LCase(questionId)) then 
									arrayId = arrayId & children.item(i).getAttribute("id") & ", "
									arrayValue = arrayValue & "'" & children.item(i).Text & "', "
							end if
					next
					
					arrayId=left(arrayId, len(arrayId)-2)
					arrayValue=left(arrayValue, len(arrayValue)-2)
					sql = sql & arrayId & ") VALUES (" & arrayValue & ")"		
					
					con.Execute sql
		next
		set con = nothing
	    set questionsNode = nothing
	    set questionsDom = nothing
	    'questionsDom.close
		response.Write(" You have completed the survey, Thank you for your time")
end function

function validCheck(xmlDoc)
		dim questionsDom, questionsNode, tablesNum, questionId, k, flag, must, temp
		set children = xmlDoc.getElementsBytagName("answer")
		num = children.length
		
		set questionsDom = Server.CreateObject("Microsoft.XMLDOM")
		questionsDom.async = false
		questionsDom.load(Server.MapPath("../xmls") & "/surveyInfo.xml")
		set questionsNode = questionsDom.getElementsByTagName("question")
		tablesNum = questionsNode.length		
		flag = true
		for k = 0 to tablesNum-1 step 1
			questionId = questionsNode.item(k).getAttribute("id")
			must = questionsNode.item(k).childNodes.item(3).childNodes.item(2).Text
			if must = "-1" then
					flag = false
					for i = 0 to num-1 step 1
							nodeId = children.item(i).getAttribute("id")
							if inStr(LCase(nodeId), "answer") <> 0 then
									temp = left(nodeId, inStr(nodeId, "answer")-1)
							else
									temp = nodeId
							end if				
							if inStr(1, temp, questionId, 1)<>0 and inStr(1, questionId, temp, 1)<>0 then 
									if not (children.item(i).Text = "0" or children.item(i).Text = "") then
											flag = true	
									end if
							end if
					next
			end if
			if not flag then 
					exit for
			end if
		next
		set questionsNode = nothing
		set questionsDom = nothing
		set children = nothing
		validCheck = flag	
end function

function delTempXml()
	dim tempFile, fs, savedFile
	Set fs = Server.CreateObject("Scripting.FileSystemObject") 
	savedFile = Request.ServerVariables("REMOTE_ADDR")
	savedFile = Server.MapPath("../temp") & "/" & savedFile & ".xml"
	if fs.FileExists(savedFile) then
			fs.DeleteFile(savedFile)
	end if
	Set fs = nothing
end function



if Err.number<>0 then
			response.Write "survey failed, please try again" &err
	else
			Response.Cookies("unFinishedSurvey") =""
	end if
%>

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -