📄 processdata.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 + -