<%
'*******************************************************************************
'* XUD Copyright 1995-2003 XCENT - www.xcent.com *
'* XUD is a trademark of XCENT *
'* This notice may not be removed from this source code file *
'*******************************************************************************
sCMD = UCase(Trim(RequestValue("CMD")))
Set objErr = CreateObject("Scripting.Dictionary")
sLoginName = RequestValue("UserName") 'sLoginUserName -> sLoginName
sLoginPassword = RequestValue("Password")
sReturnTo = RequestValue("ReturnTo")
bRemember = EvalBool(RequestValue("REMEMBER"))
If Len(Trim(sLoginName)) = 0 Then
sLoginName = Request.Cookies("Xc")("UserName")
End If
If Len(Trim(sReturnTo)) = 0 Then
If Len(Trim(gsDefLoginURL)) = 0 Then
sReturnTo = "XUD.asp"
Else
sReturnTo = gsDefLoginURL
End If
End If
sSessionCheck = Request.Cookies("XcSessionCheck")
If Len(Trim( sSessionCheck )) = 0 OR FVal(sSessionCheck) = 0 Then
Response.Cookies("XcSessionCheck") = "1"
End If
bRun = True
If gbUseSSL And gbUseSSLOnLogin Then
If UCase(Trim(Request.ServerVariables("HTTPS"))) <> "ON" Then
bRun = False
Response.Write ""
Response.Write vbCrLf & vbCrLf & "" & vbCrLf
End If
End If
If bRun Then
OpenDBConn
Select Case sCMD
Case "SHOWLOGIN":
DoPageHeader
TableHead
ShowLogin
TableFoot
DoPageFooter
Case "CHECKLOGIN":
CheckLogin
Case "LOGOUT":
Logout
Case Else
DoPageHeader
TableHead
ShowLogin
TableFoot
DoPageFooter
End Select
CloseDBConn
End If 'End bRun
Set objErr = Nothing
Sub ShowLogin
' Response.Write ""
Response.Write "
"
%>
<%
End Sub
Sub CheckLogin
Response.Cookies("XcSessionCheck") = "" & (FVal(sSessionCheck) + 1)
sLoggedIn = "FAIL"
If Len(Trim(sLoginName)) = 0 Then
objErr.Add "USERNAME", "N"
End If
'If Len(Trim(sLoginPassword)) = 0 Then
' objErr.Add "PASSWORD", "N"
'End If
If objErr.Count = 0 Then
If IsEmailAddress(sLoginName) Then
'Login is trying to use email address
sSQL = "SELECT regID, regEnabled, regEmail, regUsername FROM tblXUDUserRegistration " & _
" WHERE regPHash = " & SQLVal(PHASH(sLoginPassword)) & _
" AND regEmail = " & SQLStr(sLoginName)
'Response.Write "" & sSQL & " "
sLoginType = "EMAIL"
Else
'Check login using UserName
sSQL = "SELECT regID, regEnabled, regEmail, regUsername FROM tblXUDUserRegistration " & _
" WHERE regPHash = " & SQLVal(PHASH(sLoginPassword)) & _
" AND regUserName = " & SQLStr(sLoginName)
'Response.Write "" & sSQL & " "
sLoginType = "USERNAME"
End If
Set rsCheckLogin = gobjConnect.Execute(sSQL)
If Not rsCheckLogin.Eof Then
If EvalBool(rsCheckLogin("regEnabled")) Then
sLoggedIn = "SUCCESS"
If gbShowSubscriptions Then
RenewSubscription FVal(rsCheckLogin("regID"))
End If
If gbLogEvents And gbLogLogins Then
sLogString = DispShortDateTime(Now) & ", " & Server.HTMLEncode(sLoginName) & ", " & Request.ServerVariables("Remote_ADDR") & ", " & sLoggedIn
LogEvent "LOGIN", sLogString
End If
If FVal(Request.Cookies("XcSessionCheck"))>1 Then
DoLogin(sLoginType)
Else
ShowBadSession
End If
Else
ShowDisabled
End If
Else
BadLogin
End If
rsCheckLogin.Close
Set rsCheckLogin = Nothing
Else
DoPageHeader
TableHead
ShowLogin
TableFoot
DoPageFooter
End If
If gbLogEvents AND gbLogLogins Then
sLogString = DispShortDateTime(Now) & ", " & Server.HTMLEncode(sLoginName) & ", " & Request.ServerVariables("Remote_ADDR") & ", " & sLoggedIn
LogEvent "LOGIN", sLogString
End If
End Sub
Sub ShowBadSession
DoPageHeader
TableHead
ShowHTMLFile "XUDHtmlTxt/XUDLoginBadSession.htm"
Response.Write ""
TableFoot
DoPageFooter
End Sub
Sub ShowDisabled
DoPageHeader
TableHead
Response.Write "
"
'***Show Login Screen
ShowLogin
TableFoot
DoPageFooter
End Sub
Sub DoLogin(psLoginType)
'** Get User_ID
Select Case UCase(Trim(psLoginType))
Case "EMAIL":
sSQL = "SELECT * FROM tblXUDUserRegistration WHERE regPHash = " & SQLVal(PHASH(sLoginPassword)) & _
" AND regEmail = " & SQLStr(sLoginName)
Case Else
sSQL = "SELECT * FROM tblXUDUserRegistration WHERE regPHash = " & SQLVal(PHASH(sLoginPassword)) & _
" AND regUserName = " & SQLStr(sLoginName)
End Select
Set rsUser = gobjConnect.Execute(sSQL)
If Not rsUser.Eof Then
lRegID = FVal(rsUser("regID"))
sUserName = Trim("" & rsUser("regUserName"))
sEmail = Trim("" & rsUser("regEmail"))
sUserCurrency = "" & rsUser("regDefCurrency")
lCurrentSubsID = FVal(rsUser("regSubsID"))
If Len(sUserCurrency) = 0 Then sUserCurrency = gsMoneySymbol
sHasMail = "" & rsUser("regHasUserMail")
End If
rsUser.Close
Set rsUser = Nothing
'** Create LoginKey and Insert into Database
sLoginKey = CreateKey
sSQL = "UPDATE tblXUDUserRegistration Set " & _
" regLoginKey = " & SQLStr(sLoginKey) & ", " & _
" regLastActivity = " & SQLDate(Now) & _
" WHERE regID = " & SQLVal(lRegID)
gobjConnect.Execute(sSQL)
Response.Cookies("Xc")("UserName") = sUserName
Response.Cookies("Xc")("UserID") = lRegID
Response.Cookies("Xc")("LoginKey") = sLoginKey
Response.Cookies("Xc")("Email") = sEmail
Response.Cookies("Xc")("Currency") = sUserCurrency
If bRemember Then
Response.Cookies("Xc").Expires = Date + 365
End If
Response.Cookies("XcHasMail") = sHasMail
If UserBillingExpired(lRegID) Then
sReturnTo = "XUDEditUserBilling.asp?expired=y&returnto=" & Server.URLEncode(sReturnTo)
End If
If gbShowSubscriptions And (lCurrentSubsID = 0) Then
sTempReturnTo = "XUDEditUserBilling.asp?ReturnTo=" & Server.URLEncode(sReturnTo)
sReturnTo = sTempReturnTo
End If
If FALSE Then 'Disabled - trying to switch back from SSL here presents some problems below (see below)
If (UCase(Left(sReturnTo,5))<>"HTTP:") AND (UCase(Left(sReturnTo,6))<>"HTTPS:") Then
sReturnTo = gsXUDURL & sReturnTo
End If
End If
'Response.Write "Redirect To:" & sReturnTo & ""
If TRUE Then 'Which method to pass parameterized ReturnTo URL back?
'If switching back from SSL, a REDIRECT shows a warning in IE
Response.Redirect "" & sReturnTo
Else
'If switching back from SSL, a hidden FORM shows a warning in Netscape
Response.Write ""
Response.Write vbCrLf & vbCrLf & "" & vbCrLf
End If
End Sub
Sub Logout
Response.Cookies("Xc")("UserName") = ""
Response.Cookies("Xc")("LoginKey") = ""
Response.Cookies("Xc")("UserID") = ""
Response.Cookies("Xc")("Email") = ""
Response.Cookies("XcSessionCheck") = ""
Response.Cookies("XcHasMail") = ""
DoPageHeader
TableHead
ShowLogin
TableFoot
DoPageFooter
End Sub
Sub TableHead
Response.Write "