%@language = "vbscript"%>
<%
Option Explicit
Response.Buffer = True
Response.CacheControl = "no-cache"
Response.AddHeader "Pragma", "no-cache"
Response.Expires = -1
'****************************************************
'
' Name: login.asp
' Purpose: page for user to log in
'
'
' Author: AdaCorp Software
' Date Written: 6/24/2002
' Modified:
'
' Changes:
'****************************************************
%>
<%
Dim strUsername
Dim strPassword
Dim strError
Dim strSQL
Dim rsResults
Dim strAction
Dim intUserType
Dim intSurveyID
Dim intLoginType
Dim strMessage
Dim intMessage
Dim strGUID
Dim intUserID
Dim strPermanentGUID
Call user_clearSessionInfo()
strAction = Request.Form("submit")
intUserType = 0
intSurveyID = Request("surveyID")
intMessage = Request.QueryString("message")
If utility_isPositiveInteger(intMessage) Then
If cint(intMessage) = SV_MESSAGE_INFORMATION_SENT Then
strMessage = "Your login information has been sent to your email address."
End If
End If
strPermanentGUID = request.QueryString("guid")
If utility_isPositiveInteger(intSurveyID) and len(strPermanentGUID) = 0 Then
Call user_getSessionInfo(intUserID, intUserType, "","", "",False)
If utility_isPositiveInteger(intUserID) Then
Response.Redirect("takeSurvey.asp?surveyID=" & intSurveyID)
End If
End If
If strAction = "Cancel" Then
Response.Redirect("index.asp")
'if requested to log in
ElseIf strAction = "Login" or len(strPermanentGUID) > 0 Then
If len(strPermanentGUID) = 0 Then
'get all values from form post
strUsername = trim(Request.Form("username"))
strPassword = trim(Request.Form("password"))
'check required values
If strUsername = "" Then
strError = strError & "Username is required.
"
End If
If strPassword = "" Then
strError = strError & "Password is required.
"
End If
End If
'If no errors have been encountered
If strError = "" Then
If len(strPermanentGUID) = 0 Then
strSQL = "SELECT userID, userType, userGUID " &_
"FROM s1_SurveyUser " &_
"WHERE userName = " & utility_SQLEncode(strUsername, False) &_
" AND pword = " & utility_SQLEncode(strPassword, False)
Else
strSQL = "SELECT userID, userType, userGUID " &_
"FROM s1_SurveyUser " &_
"WHERE permanentGUID = " & utility_SQLEncode(strPermanentGUID, True)
End If
Set rsResults = utility_getRecordset(strSQL)
If rsResults.EOF Then
If len(strPermanentGUID) = 0 Then
strError = "Username/Password combination not found."
Else
strError = "Access Denied."
End If
Else
intUserID = rsResults("userID")
intUserType = rsResults("userType")
strGUID = rsResults("userGUID")
If not(len(strPermanentGUID) > 0 and intUserType = SV_USER_TYPE_ADMINISTRATOR) Then
If len(trim(strGUID)) = 0 or isNull(strGUID) or SV_PREVENT_CONCURRENT_LOGIN = True Then
strGUID = utility_createGUID()
strSQL = "UPDATE s1_surveyUser SET userGUID = " & utility_SQLEncode(strGUID, True) & " WHERE userID = " & intUserID
Call utility_executeCommand(strSQL)
End If
Call user_setSessioninfo(intUserID, intUserType, strUserName, SV_LOGIN_TYPE_PASSWORD, "true",strGUID)
response.Cookies(SV_COOKIE_NAME & "user")("overrideNetwork") = "true"
If utility_isPositiveInteger(intSurveyID) Then
Response.Redirect("takeSurvey.asp?surveyID=" & intSurveyID & survey_getQuerystring(intSurveyID))
Else
Response.Redirect("index.asp?message=" & SV_MESSAGE_LOGGED_IN)
End If
End If
End If
End If
End If
If utility_isPositiveInteger(intSurveyID) Then
Dim strHeader
Dim strFooter
Dim strBaseFont
Dim strTitleColor
Dim intTitleSize
Dim strSurveyDescriptionColor
Dim intSurveyDescriptionSize
Dim strBackgroundColor
Dim intQuestionSize
Dim strQuestionColor
Dim intQuestionDescriptionSize
Dim strQuestionDescriptionColor
Dim intAnswerSize
Dim strAnswerColor
Dim intTemplateID
Dim boolUseStandardUI
Dim strOddRowColor
Dim strEvenRowColor
Dim strHeaderColor
strSQL = "SELECT templateID FROM s1_survey WHERE surveyID = " & intSurveyID
Set rsResults = utility_getRecordset(strSQL)
If not rsResults.EOF Then
intTemplateID = rsResults("templateID")
End If
rsResults.Close
Set rsResults = NOTHING
strSQL = "SELECT templateName, header, footer, baseFont, backgroundColor, titleSize, titleColor, " &_
"surveyDescriptionSize, surveyDescriptionColor, questionSize, questionColor, " &_
"questionDescriptionSize, questionDescriptionColor, answerSize, answerColor, " &_
"useStandardUI, oddRowColor, evenRowColor, headerColor " &_
"FROM s1_styleTemplates " &_
"WHERE templateID = " & intTemplateID
Set rsResults = utility_getRecordset(strSQL)
strHeader = rsResults("header")
strFooter = rsResults("footer")
strBaseFont = rsResults("baseFont")
strBackgroundColor = rsResults("backgroundColor")
intTitleSize = rsResults("titleSize")
strTitleColor = rsResults("titleColor")
intSurveyDescriptionSize = rsResults("surveyDescriptionSize")
strSurveyDescriptionColor = rsResults("surveyDescriptionColor")
intQuestionSize = rsResults("questionSize")
strQuestionColor = rsResults("questionColor")
intQuestionDescriptionSize = rsResults("questionDescriptionSize")
strQuestionDescriptionColor = rsResults("questionDescriptionColor")
intAnswerSize = rsResults("answerSize")
strAnswerColor = rsResults("answerColor")
boolUseStandardUI = cbool(rsResults("useStandardUI"))
strOddRowColor = rsResults("oddRowColor")
strEvenRowColor = rsResults("evenRowColor")
strHeaderColor = rsResults("headerColor")
Set rsResults = NOTHING
Else
boolUseStandardUI = True
End If
If not isNull(strHeader) Then
%>
<%=strHeader%>
<%
End If
If boolUseStandardUI = True Then
Call header_htmlTop("white","")
Call header_writeHeaderTop(intUserType, "")
Call header_writeSubMenuLogin("Login")
Call header_writeHeaderBottom()
Else
Call header_htmlTop(strBackgroundColor, "")
Call header_padding()
End If
%>
Login