<% '******************************************************* ' Version 6.50 Nov 13, 2005 ' Fix duplicate database close ' Handles customer login '******************************************************* dim dbc, url dim forwardURL initializesystem dim strpassword, returnurl 'VP-ASP 6.50 - security fix strPassword=cleanchars(Request("strPassword")) stremail=cleanchars(request("stremail")) strLastname = cleanchars(Request.Form("strLastname")) returnurl=cleanchars(request("returnurl")) If strLastname = "" Then If getconfig("xPasswordLastname")="Yes" or getconfig("Xpassword")="No" then sError = sError & getlang("langLoginLastname") & "
" end if End If if strEmail="" then sError = sError & getlang("langLoginEmail") & "
" end if If ucase(getconfig("xpassword"))="YES" then if strPassword="" then sError = sError & getlang("langLoginPassword") & "
" end if end if If Serror="" then RetrieveLoginData else Serror= getlang("langCommonRequired") & "
" & Serror end if setsess "Loginerror",Serror Setupreturnurl url responseredirect url Sub RetrieveLogindata Dim fieldvalue If GetSess("Login")="" then SetSess "Login","Force" end if LocateCustomer strLastName, stremail , strpassword If strCustomerID <>"" then if isnull(lnglogincount) then lnglogincount=0 LngLoginCount=lngLoginCount+1 UpdateCustomerSessionData UpdateLoginData SetSess "Login",strlastname setsess "customername", strfirstname Else 'VP-ASP 6.50 - don't show this message if serror already has a message in it if serror = "" then SError = SError & getlang("langLoginLocateFail") end if SetSess "Login", "" ' debugwrite "Not found" end if 'ShopCloseDatabase dbc 'set rs=nothing end sub Sub UpdateLoginData Dim dbc 'on error resume next OpenCustomerDB dbc 'response.write "Login count" & lngLoginCount sql = "update customers set " sql = sql & "logincount=" & lnglogincount 'sql = sql & ",lastlogindate='" & date() & "'" sql = sql & ",lastlogindate=" & datedelimit(date() ) sql = sql & " where contactid=" & strcustomerid dbc.execute(sql) ShopCloseDatabase dbc end sub '***************************************************************** ' determine where to go to '***************************************************************** Sub SetupReturnurl (url) if returnurl<>"" then if Serror="" then url=returnurl exit sub else url="shopcustadminlogin.asp" end if exit sub end if If Getsess("Followonurl")="" and getsess("Currenturl")="" then If Serror="" then url=getconfig("xhome") else url="shopcustadminlogin.asp" end if exit sub end if If Serror="" then url=GetSess("FollowonURL") else url=getSess("CurrentURL") end if end sub %>