<% Function GetQuestionRows(nClientID, nLangID, nTotalCount, nWidth) GetQuestionRows = "" 'Boundary condition, if we don't have questions, just ignore it If nTotalCount <= 0 Then Exit Function End If Dim strRows Dim oConn Dim rst Dim nCount nCount = 0 'start off with one and display only available Set oConn = Server.CreateObject("ADODB.Connection") oConn.Open strConn strSQL = "SELECT QuestionNum, QuestionType, NumberOfAnswers, Question FROM ClientQuestions WHERE (ClientID = " & nClientID & " AND LangID = " & nLangID & ") ORDER BY QuestionNum" Set rst = oConn.Execute(strSQL) strRows = "" Dim nQuestionArray Redim nQuestionArray(nTotalCount, 5) For i = 0 to nTotalCount-1 nQuestionArray(i, 0) = -1 'Question Number nQuestionArray(i, 1) = 0 'Question Type nQuestionArray(i, 2) = "" 'No.of Answers nQuestionArray(i, 3) = "" 'Question nQuestionArray(i, 4) = "" 'Error Next While ( Not rst.BOF And Not rst.EOF ) nQuestionArray(nCount, 0) = rst.Fields(0).Value nQuestionArray(nCount, 1) = rst.Fields(1).Value nQuestionArray(nCount, 2) = rst.Fields(2).Value nQuestionArray(nCount, 3) = Encode(Trim(rst.Fields(3).Value)) nQuestionArray(nCount, 4) = "" rst.MoveNext nCount = nCount + 1 Wend For nCount = 0 To nTotalCount-1 If nQuestionArray(nCount, 0) <> "-1" Then strRows = strRows & GetQuestionRowBlock(nCount+1, nQuestionArray(nCount,1), nQuestionArray(nCount,2), nQuestionArray(nCount,3), nQuestionArray(nCount,4), nWidth) Else strRows = strRows & GetQuestionRowBlock(nCount+1, "", "", "", "", nWidth) End If Next rst.Close oConn.Close Set oConn = Nothing GetQuestionRows = strRows End Function Function GetQuestionCount(nClientID) GetQuestionCount = 0 Dim oConn Dim rst Set oConn = Server.CreateObject("ADODB.Connection") oConn.Open strConn strSQL = "SELECT ClientQuestions FROM Clients WHERE ClientID = " & nClientID Set rst = oConn.Execute(strSQL) If Not rst.EOF And Not rst.BOF Then If Not IsNull(rst.Fields(0).Value) Then GetQuestionCount = rst.Fields(0).Value End If End If rst.Close oConn.Close Set oConn = Nothing End Function Function GetAnswerCount(nClientID, nLangID, nQuestion) GetAnswerCount = 0 Dim oConn Dim rst Set oConn = Server.CreateObject("ADODB.Connection") oConn.Open strConn strSQL = "SELECT NumberOfAnswers FROM ClientQuestions WHERE ClientID = " & nClientID & " AND LangID = " & nLangID & " AND QuestionNum = " & nQuestion Set rst = oConn.Execute(strSQL) If Not rst.EOF And Not rst.BOF Then If Not IsNull(rst.Fields(0).Value) Then GetAnswerCount = rst.Fields(0).Value End If End If rst.Close oConn.Close Set oConn = Nothing End Function Function GetQuestionTypeScript(strTypeVal) strData = "" If(strTypeVal = "1" Or strTypeVal = "") then strData = strData & "" & "Text Only" & "" Else strData = strData & "" & "Text Only" & "" End If If(strTypeVal = "2") then strData = strData & "" & "Single Answer" & "" Else strData = strData & "" & "Single Answer" & "" End If If(strTypeVal = "3") then strData = strData & "" & "Multiple Answers" & "" Else strData = strData & "" & "Multiple Answers" & "" End If GetQuestionTypeScript = strData End Function Function GetAnswerRows(nClientID, nLangID, nTotalCount, nQuestion, nQuestionType, strQuestion, strError, strQstClass, strAnsClass) GetAnswerRows = "" Dim strScript strScript = "" Dim oConn Dim rst Dim nCount ' ' We are only interested in showing answers for 2 and 3 question ' types ' If nQuestionType = "" Then nQuestionType = 1 End If If nQuestionType <> 2 And nQuestionType <> 3 Then Exit Function End If Dim nAnswerArray, strErrorArray Redim nAnswerArray(nTotalCount, 3) strRows = "" For i = 0 to nTotalCount-1 nAnswerArray(i, 0) = -1 'Answer Number nAnswerArray(i, 1) = "" 'Answer nAnswerArray(i, 2) = "" 'Error Next nCount = 0 ' ' Show actual question that user typed in the first page ' strScript = strScript & "

" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & " " & vbCRLF strScript = strScript & "" & strQuestion & "" & vbCRLF strScript = strScript & " " & vbCRLF ' ' If we have error then, we need to show it ' If strError <> "" Then strScript = strScript & "" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & " " & vbCRLF strScript = strScript & "" & strError & "" & vbCRLF strScript = strScript & " " & vbCRLF End If strScript = strScript & "" & vbCRLF If nTotalCount > 0 Then For nCount = 0 To nTotalCount-1 strScript = strScript & "" & vbCRLF If nCount <= nTotalCount-1 Then If nAnswerArray(nCount, 0) <> "-1" Then strScript = strScript & GetAnswerCellBlock(nQuestion, nCount+1, nAnswerArray(nCount, 1)) Else 'If Session("FromAnswer") = "" Then strScript = strScript & GetAnswerCellBlock(nQuestion, nCount+1, Request.Form("Answer" & nQuestion & nCount+1)) 'Else ' strScript = strScript & GetAnswerCellBlock(nQuestion, nCount+1, Session("Answer" & nQuestion & nCount+1)) 'End If End If End If strScript = strScript & "" & vbCRLF Next End If strScript = strScript & "" & vbCRLF strScript = strScript & "

" GetAnswerRows = strScript End Function Function GetAnswerCellBlock(nQuestion, nAnswer, strAnswer) Dim strScript, strName strScript = "" strName = "Answer" & nQuestion & nAnswer strScript = strScript & "" & vbCRLF strScript = strScript & "Answer " & nAnswer & "" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & "" & vbCRLF GetAnswerCellBlock = strScript End Function Function GetQuestionRowBlock(strNum, strTypeVal, strAnswerVal, strQuestionVal, strError, nWidth) GetQuestionRowBlock = "" Dim strScript Dim strQuestion, strType, strAnswer ' If user changed the type to "Text Only" then we need ' change the number of answers field to 0 ' If strTypeVal <> "" Then nType = CInt(strTypeVal) If nType = 1 Then strAnswerVal = "0" End If End If strType = "QuestionType" & strNum strAnswer = "NoOfAnswers" & strNum strQuestion = "Question" & strNum strScript = "

" ' ' Heading Table ' strScript = strScript & "" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & " " & vbCRLF strScript = strScript & "Enter information for question number " & strNum & "" & vbCRLF strScript = strScript & " " & vbCRLF ' ' If we have error then we fill this table ' If strError <> "" Then strScript = strScript & "" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & " " & vbCRLF strScript = strScript & "" & strError & "" & vbCRLF strScript = strScript & " " & vbCRLF End If strScript = strScript & "" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & "" strScript = strScript & "" strScript = strScript & "" strScript = strScript & "" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & " " strScript = strScript & "Type:" strScript = strScript & " " strScript = strScript & "" & vbCRLF strScript = strScript & GetQuestionTypeScript(strTypeVal) & vbCRLF strScript = strScript & "" strScript = strScript & " " strScript = strScript & "  No.of Answers:" strScript = strScript & " " strScript = strScript & "" & vbCRLF strScript = strScript & " " & vbCRLF strScript = strScript & "Question:" & vbCRLF strScript = strScript & " " & vbCRLF ' ' Question Text area ' strScript = strScript & "" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & "" & vbCRLF strScript = strScript & " " & vbCRLF strScript = strScript & "" & strQuestionVal & "" & vbCRLF strScript = strScript & " " & vbCRLF strScript = strScript & "

" GetQuestionRowBlock = strScript End Function Function GetQuestionFormRows(nClientID, iQCnt, sErrInd, bFromSession, nWidth) GetQuestionFormRows = "" Dim strRows Dim strErrFnd strRows = "" Dim strError strError = "" sErrInd = "N" strErrFnd = "N" If iQCnt > 0 Then For i = 1 to iQCnt If bFromSession Then strQuestionType = Session("QuestionType" & i) Else strQuestionType = Request.Form("QuestionType" & i) End If If bFromSession Then strNoOfAnswers = Session("NoOfAnswers" & i) Else strNoOfAnswers = Request.Form("NoOfAnswers" & i) End If If bFromSession Then strQuestion = Session("Question" & i) Else strQuestion = Request.Form("Question" & i) End If If Not bFromSession Then strError = Validate(i) If strError <> "" Then sErrInd = "Y" strErrFnd = "Y" End If End If strRows = strRows & GetQuestionRowBlock(i, strQuestionType, strNoOfAnswers, strQuestion, strError, nWidth) Next End If If strErrFnd = "Y" Then strRows = "

Errors encountered, please make the appropriate changes

" & strRows End If GetQuestionFormRows = strRows End Function Function Validate(nIndex) Validate = "" Dim strError strError = "" ' ' Validate all the fields. ' strType = Request.Form("QuestionType" & nIndex) strAnswers = Request.Form("NoOfAnswers" & nIndex) strQ = Request.Form("Question" & nIndex) If strType = "" Then strError = strError & "Question Type is required
" Else If IsNumeric(strType) Then nType = CInt(strType) If nType < 1 Or nType > 3 Then strError = strError & "Question Type is invalid
" Else nAnswers = 0 If IsNumeric(strAnswers) Then nAnswers = CInt(strAnswers) Else nAnswers = -1 End If If nAnswers <> -1 Then If (nType = 2 Or nType = 3) And nAnswers <= 0 Then strError = strError & "No.of Answers must be greater than zero
" End If ElseIf nType <> 1 Then strError = strError & "No.of Answers must be a valid number
" End If End If End If End If If strQ = "" Then strError = strError & "Question is required
" Else iMaxLen = 500 iLen = Cint(Len(Trim(strQ))) If iLen > iMaxLen Then iLen = iLen - iMaxLen strError = strError & "Question - Length exceeds maximum of " & iMaxLen & " By " & iLen End If End If Validate = strError End Function Function ValidateAnswer(nQuestion, nAnswer, nType) Dim strError strError = "" If nType = 2 Or nType = 3 Then strParam = "Answer" & nQuestion & nAnswer strVal = Request.Form(strParam) If strVal = "" Then strError = strError & "Answer" & nAnswer & " is required
" Else iMaxLen = 50 iLen = Cint(Len(Trim(strVal))) If iLen > iMaxLen Then iLen = iLen - iMaxLen strError = strError & "Answer" & nAnswer & " - Length exceeds maximum of " & iMaxLen & " By " & iLen End If End If End If ValidateAnswer = strError End Function Function ProcessClientQuestion(oConn, nClientID, nLangID, nQuestion, nQuestionType, nAnswers, strQuestion) Set cmd = Server.CreateObject("ADODB.Command") cmd.ActiveConnection = oConn cmd.CommandText = "ProcessClientQuestion" cmd.CommandType = 4 'Stored Procedure cmd.Parameters.Refresh 'Set the parameter values and try to get the unique ID cmd.Parameters("@clientid") = nClientID cmd.Parameters("@langid") = nLangID cmd.Parameters("@questionnum") = nQuestion cmd.Parameters("@questiontype") = nQuestionType cmd.Parameters("@numberofanswers") = nAnswers cmd.Parameters("@question") = strQuestion cmd.Execute End Function Function ProcessClientAnswers(oConn, nClientID, nLangID, nQuestion, nACnt) Dim strAnswer ' This is the right place to remove the existing answers ' and add new answers to the client answers table strSQL = "DELETE FROM ClientQuestionAns WHERE (clientid=" & nClientID & " AND LangID= " & nLangID & " AND questionnum = " & nQuestion & ")" oConn.Execute(strSQL) For nAnswer = 1 To nACnt strAnswer = Request.Form("Answer" & nQuestion & nAnswer) If strAnswer <> "" Then ProcessClientAnswer oConn, nClientID, nLangID, nQuestion, nAnswer, strAnswer Session("Answer" & nQuestion & nAnswer) = strAnswer End If Next End Function Function ProcessClientAnswer(oConn, nClientID, nLangID, nQuestion, nAnswer, strAnswer) Set cmd = Server.CreateObject("ADODB.Command") cmd.ActiveConnection = oConn cmd.CommandText = "ProcessClientAnswer" cmd.CommandType = 4 'Stored Procedure cmd.Parameters.Refresh 'Set the parameter values and try to get the unique ID cmd.Parameters("@clientid") = nClientID cmd.Parameters("@langid") = nLangID cmd.Parameters("@questionnum") = nQuestion cmd.Parameters("@answernum") = nAnswer cmd.Parameters("@answer") = strAnswer cmd.Execute End Function Function Encode(ByREF s) s = Replace(s, "'", "’") s = Replace(s, """", """) Encode = s End Function %>