红色部分直接没有看明白呢 远看越绕了 老师可否点一下 谢谢！
'上一题和下一题的处理,结束的处理也在这里
Dim e As RequestEventArgs = Args(0)
If e.PostValues.Count > 0 Then
Dim id As String = e.PostValues("hideid")
MessageBox.Show(e.PostValues("hideid"))
Dim drU As DataRow = Functions.Execute("CheckToken",id,e) '授权验证
If drU IsNot Nothing AndAlso Functions.Execute("UpdateLogonTime",drU("OpenID")) Then
Dim qt As String = e.Cookies("cqt")
Dim formsid As String = e.PostValues("hideformseq") '或者当前的练习信息
MessageBox.Show(formsid)
Dim seq As Integer
Dim QuestionType As Integer
Dim testid As String
If formsid > "" Then
Dim fs() As String = formsid.Split("|")
seq = val(fs(0))
MessageBox.Show(seq) sep永远都是1
QuestionType = val(fs(1))
testid = fs(2)
MessageBox.Show(testid)
Else
e.WriteString("错误: 无法获取正确的问题序号!")
Return ""
End If
Dim direction As String = e.PostValues("hidedirection") '通过这里判断是上一题还是下一题
Dim p_Qty As String = e.PostValues("cboqty")
MessageBox.Show(e.PostValues("cboqty")) 没有弹出值
Dim dr As DataRow
Dim answer As String = ""
'根据题型取得正在做的题,并更新用户的答案
If QuestionType = 3 Then
dr = DataTables("UsersCodeAnswerForm").Find("TestID = '" & testid & "' And Seq = " & seq)
If dr IsNot Nothing Then
answer = e.PostValues("txtcodeanswer")
If answer > "" Then
dr("AnswerCode") = answer
dr("AnswerTime") = Date.Now
dr("IsAnswer") = True
ElseIf direction <> "close"
e.WriteString("错误: 请在代码回答区填写答案!建议在pc微信客户端做代码题.")
Return ""
End If
End If
Else
dr = DataTables("UsersAnswerForm").Find("TestID = '" & testid & "' And Seq = " & seq)
If dr IsNot Nothing Then
'获取用户的选择题/判断题的答案拼接起来,类似结果: A|B|C
Dim achoice() As String = { "chkchoicea","chkchoiceb","chkchoicec","chkchoiced","rdgsingle","rdgyn"}
For Each ac As String In achoice
If e.PostValues.ContainsKey(ac) Then
answer &= "|" & e.PostValues(ac)
End If
Next
answer = answer.Trim("|")
If answer > "" Then
dr("AnswerChoice") = answer
dr("IsCorrect") = (dr("CorrectAnswer") = answer) '如果用户答案和标准答案一致,则本题回答正确,方便以后的处理,不用在一一比较
dr("AnswerTime") = Date.Now '回答时间
dr("IsAnswer") = True '已经回答
ElseIf direction <> "close"
e.WriteString("错误: 请至少选择一个答案!")
Return ""
End If
End If
End If
If dr IsNot Nothing Then dr.Save
dr = DataTables("UsersTestForm").Find("TestID = '" & testid & "'")
If dr IsNot Nothing Then
Dim subType As Integer = dr("TestType")
Dim qtile As String = IIF(subType=5,"考试","练习")
If dr("IsCompleted") Then '如果练习已经结束,则直接返回,不提供再做题的机会
e.WriteString(CExp("结束: 本次{0}已结束! 可能您已经在另外的设备完成{0}!",qtile))
Return ""
End If
Dim acount As Integer = dr("AnswerQty")+1
'从后台实时计算已经回答的数量,更准确
Dim sql As String = "exec [upd_GetAnswerQuestionCount] @TestID= '" & testid & "'"
Dim dt As DataTable = Functions.Execute("Cmd_GetDataTable","Q",sql)
Dim score As Integer = 0
If dt.DataRows.Count > 0 Then
acount = dt.DataRows(0)("Qcount")
dr("AnswerQty") = acount '已经回答的标准题的数量
dr("AnswerCodeQty") = dt.DataRows(0)("CodeCount") '已经回答的问答题的数量
score = dt.DataRows(0)("CorCount")
MessageBox.Show(e.PostValues("score ")) 没有弹出值
dr("CorrectQty") = score '已经回答的标准题的正确数量
If acount > 0 Then
dr("CorrectRate") = dr("CorrectQty") / acount '计算准确率
End If
acount = acount + dr("AnswerCodeQty")
dr("CompleteRate") = acount / dr("QuestionQty") '计算完成率
End If
dr.Save
If direction <> "prev" Then '如果不是点击上一题(即下一题或者结束),prev由js传入
'如果完成的数量等于选题的数量,或者用户按了"结束"按钮,强制完成本次练习
If (acount = dr("QuestionQty") AndAlso seq = acount) OrElse direction = "close" Then '已做完题目
dr("IsCompleted") = True
dr("CompleteTime") = Date.Now
dr.Save
Dim tips As String = CExp("结束: 本次{2}已结束, 选题{0}道, 完成{1}道!",dr("QuestionQty"),acount,qtile)
If dr("TestType") <> 4 Then
tips &= CExp(" 标准题正确{0}道, 准确率{1}!",dr("CorrectQty"),Format(dr("CorrectRate"),"00%"))
End If
'移除已经完成的练习
DataTables("UsersAnswerForm").RemoveFor("TestID = '" & testid & "'")
DataTables("UsersCodeAnswerForm").RemoveFor("TestID = '" & testid & "'")
DataTables("UsersTestForm").RemoveFor("TestID = '" & testid & "'")
'更新连续错题
sql = "exec dbo.upd_Add5TimesQuestion @OpenID=N'" & drU("OpenID") & "'"
Functions.Execute("Cmd_ExecuteNonQuery","Q",sql)
e.WriteString(tips)
Return "" '这里必须返回
End If
'下一题
sql = CExp("exec [upd_GetQuestionDetailBySeq] @TestID='{0}',@Seq={1}, @direct=1",testid, seq ) '查询此题是否已经存在
dt = Functions.Execute("Cmd_GetDataTable","Q",sql)
If dt.DataRows.Count > 0 Then '说明是已经做的题,并不是新题
Dim jo As JObject = Functions.Execute("GetExistAnswerHtm",dt.DataRows(0),score)
e.WriteString(jo.ToString)
Return ""
Else '新的题
Dim openid As String = dr("OpenId")
sql = CExp("exec [upd_GetNextNewQuestionFor] @OpenID='{0}',@SelectTestType={1}",openid ,subType) '获取新题 弹窗提示 SelectTestType=0
dt = Functions.Execute("Cmd_GetDataTable","Q",sql)
Dim drQs As DataRow
If dt.DataRows.Count > 0 Then
drQs = dt.DataRows(0)
Dim htmJson As String = Functions.Execute("GetNewAnswerHtm",openid ,drQs("QuestionID"),drQs("QuestionType"),dr,score) '获取练习题的内容,html格式
e.WriteString(htmJson)
Return ""
End If
End If
Else
'获取上一题
sql = CExp("exec [upd_GetQuestionDetailBySeq] @TestID='{0}',@Seq={1}, @direct=0",testid, seq )
dt = Functions.Execute("Cmd_GetDataTable","Q",sql)
If dt.DataRows.Count > 0 Then
Dim jo As JObject = Functions.Execute("GetExistAnswerHtm",dt.DataRows(0),score)
e.WriteString(jo.ToString)
Return ""
Else
e.WriteString("错误: 已经是第一条题目!")
Return ""
End If
End If
End If
End If
End If
e.WriteString("错误: 表单(" & e.Path & ")提交出错!")
Return ""
加好友 
发短信
Post By：2021/5/14 15:39:00 [只看该作者]
此主题相关图片如下：13.png