VPASP Shopping Cart Control Panel

<% ' to use second password enter a value below const xadminpage = "lfshadmin.asp" const SecondPassword="rs142140" ' const Secondpasswordmsg="Second password does not match" const adminmail="No" ' email on all logins const adminips="" ' these are OK const adminemailIpcheck="No" ' email on IP failures '********************************************************************** ' Shop administration only VP-ASP Shopping Cart ' Forces user to login ' asked for userid and password ' Goes to shopadmin1.asp ' Version 6.50 ' March 29, 2004 Cleanup on saved carts and session files '********************************************************************* SetSess "ShopAdmin","" SetSess "INIT","" Dim myconn Dim rs Dim username,userpassword dim my_system msg="" ShopInit 'on error resume next AdminvalidateIPAddress ' see if Ip address is valid If Request("Submit")<>"" Then shopinit SetSess "Login","Force" ShopOpenDatabase myconn If GetSess("Login")="Force" then SetSess "Login","" end if username=request("Username") userpassword=request("password") username=replace(username,"'","") userpassword=replace(userpassword,"'","") if ucase(Username)<>"SUPPLIER" then sql = "select * from tbluser where fldusername='" & username & "' and fldpassword='" & userpassword & "'" Set rs = myconn.Execute(SQL) if not rs.eof then if (rs("fldusername") = username) and (rs("fldpassword") = userpassword) Then CheckSecondpassword rc If rc=0 then GetAdminData rs else closerecordset rs shopclosedatabase myconn msg=msg & Secondpasswordmsg & "
" end if else rs.close set rs=nothing LocateSupplier end if else rs.close set rs=nothing LocateSupplier end if if msg="" then msg=getlang("langAdmin01") & "
" end if Shopclosedatabase myconn else msg=getlang("langAdmin01") & "
" Shopclosedatabase myconn end if end if %> VPASP Shopping Cart Control Panel

<% if msg <> "" Then shopwriteerror msg end if if SecondPassword = "" then shopwriteerror "You are not using a second password. Please add a password into const secondpassword at the top of this file." end if 'shopwriteheader getlang("langAdmin02") %>

<%=getlang("langAdmin03")%>

<%'31/1/2006 - admin page now in const at top of this file%>

<% '23/02/2006 - Check if default username and password are still in us SetSess "Login","Force" ShopOpenDatabase myconn If GetSess("Login")="Force" then SetSess "Login","" end if sql = "select * from tbluser where fldusername='admin' and fldpassword='admin'" Set rs = myconn.Execute(SQL) if not rs.eof then response.write "Default username and password still in use!
Username = admin
Password = admin
Please change as soon as possible!" else response.write "Please enter your username and password:" end if closerecordset rs shopclosedatabase myconn %>

<% If Secondpassword<>"" then %> <% end if %>

<%=getlang("LangAdminUserName")%>
<%=getlang("LangAdminPassword")%>
<%=getlang("LangAdminPassword")%> 2

" name="Submit" />

Your IP Address has been logged: <%IpAddressDisplay%>

<%=getlang("LangCommonCopyright")%>

<% '**************************************************************** ' We have locate the user in the database ' set some session variables ' close database ' log user has logged in ' See if security needs checking ' continue to shopadmin1 '***************************************************************** 'adminpagetrailer ' Sub GetAdminData (rs) setsess "shopadmin" ,rs("fldusername") if isnull(rs("Admintype")) then SetSess "admintype","SUPER" else setsess "admintype",ucase(rs("admintype")) end if setsess "login" , rs("fldusername") setsess "usertables",rs("tablesallowed") setsess "adminmenus",rs("fldaccess") closerecordset rs LogUser GetSess("ShopAdmin"), "in", myconn SetSess("Supplierid"),"" Shopclosedatabase myconn CheckSecurity (userpassword) AdminEmailmerchantSuccess If getconfig("xdownloads")="Yes" or getconfig("xwishlist")="Yes" or xusefilesession="Yes" then responseredirect "shopa_cleanup.asp" else responseredirect "shopadmin1.asp" end if end sub Sub LocateSupplier If getconfig("xAllowSupplierlogin")<>"Yes" then exit sub sql = "select * from suppliers where supplieruserid='" & username & "' and supplierpassword='" & userpassword & "'" Set rs = myconn.Execute(SQL) If err.number>0 then msg="database Open error
" & GetSess("Openerror") else If Not rs.EOF Then 'VP-ASP 6.09 - precautionary security fix setsess "shopadmin" ,replace(request("username"),"'","''") setsess "admintype","supplier" setsess "login" , rs("supplieruserid") setsess("supplierid"),rs("supplierid") rs.close set rs=nothing GetUserTables ' setsess "usertables",rs("tablesallowed") LogUser GetSess("ShopAdmin"), "in", myconn Shopclosedatabase myconn AdminEmailmerchantSuccess responseredirect "shopadmin1.asp" else rs.close set rs=nothing end if end if end sub Sub GetUserTables dim rs sql = "select * from tbluser where fldusername='supplier'" Set rs = myconn.Execute(SQL) if err.number>0 then msg="database Open error
" & GetSess("Openerror") else If Not rs.EOF Then setsess "usertables",rs("tablesallowed") setsess "adminmenus",rs("fldaccess") end if end if rs.close set rs=nothing end sub Sub Checksecurity (ipassword) dim tpassword tpassword=ucase(ipassword) if tpassword="VPASP" or tpassword="ADMIN" then setsess "security","Yes" end if end sub '******************************************************************* ' if using second password facility, the validate it '******************************************************************* Sub CheckSecondPassword(rc) dim password rc=4 If secondpassword="" then rc=0 exit sub end if password=request.form("password2") if password="" then exit sub if ucase(password)<>ucase(secondpassword) then exit sub rc=0 end sub '***************************************************************************** ' make sure IP address starts with something merchant knows '***************************************************************************** Sub AdminValidateIpAddress if adminips="" then exit sub dim ips(50),ipcount, i, ipaddress, length, prefix ipaddress=request.servervariables("REMOTE_ADDR") debugwrite "ipaddress=" & ipaddress parserecord adminips, ips, ipcount,"," for i = 0 to ipcount-1 length=len(ips(i)) prefix=left(ipaddress, length) if prefix=ips(i) then exit sub end if next If lcase(adminemailIpcheck)="yes" then AdminEmailmerchant getlang("LangAdminUnauth") & " " & ipaddress end if username="" userpassword="" shoperror getlang("LangAdminUnauth") end sub Sub AdminEmailMerchant (subject) dim url, body, acount, emailformat dim mytime dim mailtype, my_from, my_fromaddress, my_toaddress, my_to, my_subject mytime= formatdatetime(now(), 0) ipaddress=request.servervariables("REMOTE_ADDR") emailformat = "Text" body = subject & vbcrlf body=body & mytime & vbcrlf body =body & getlang("langipaddress") & " " & ipaddress mailtype=getconfig("xemailtype") my_from=getconfig("xemailname") my_fromaddress=getconfig("xemail") my_toaddress=getconfig("xemail") my_to=getconfig("xemailname") my_system=getconfig("xemailsystem") my_subject=subject acount=0 ExecuteMail mailtype,My_from,my_fromaddress,my_to,my_toaddress,my_subject,body,emailformat,My_attachment,acount end sub Sub AdminEmailmerchantSuccess dim subject if lcase(adminmail)<>"yes" then exit sub subject=getlang("LangLoginSuccessful") & " " & username AdminEmailmerchant subject end sub Sub IpAddressDisplay dim ipaddress ipaddress=Request.ServerVariables("REMOTE_ADDR") response.write ipaddress End Sub %>