<%option explicit%>
<%response.buffer=true%>
<%ShopOpenDatabase dbc%>
<%
'*********************************************************************************
' 7.00
' 1 Dec 2009
' Customer Service Menu
'*********************************************************************************
dim menus(20), urls(20), menucount
dim loginError, infomsg
dim NumProc
dim LoginFlag
NumProc = 0
'701 - 2010.10.25 - Enhancement: shopcustadmin.asp msg should be stored in sessions
Infomsg = session("shopcustadminmsg")
session("shopcustadminmsg") = ""
if trim(Infomsg) = "" then
'VP-ASP Security Patch - 17 April 2008
Infomsg=CleanChars(request("msg"))
end if
dim tmprc
CleanseMessage infomsg,tmprc
if tmprc=4 then infomsg=""
Shopinit
if GetSess("CustomerLoginCID")="" then
SetSess("Customerlogincid"),GetSess("Customerid")
end if
SetSess "CurrentUrl","shopcustadmin.asp"
'800 - 2015.08.17 - Better handling on the site title
'2019.04.29 - Enhancement: To include options to generate meta title to the site
dim temp_meta_site_title
temp_meta_site_title = GetLang("langCustAdmin01")
include_xtitle_process temp_meta_site_title
SetSess "Dynamictitle", temp_meta_site_title
ShopPageHeader
if GetConfig("xbreadcrumbs") = "Yes" then
response.write "Home " & SubCatSeparator & GetLang("langCustAdmin01") & "
"
end if
CheckLogin loginflag
if SError<> "" then
ShopWriteError SError
SError=""
end if
if Infomsg<> "" then
ShopWriteError Infomsg
Infomsg=""
end if
AddMenu
AddNewUser
ShopPageTrailer
ShopCloseDatabase dbc
'3.00, Shopadmin.asp forces relogin
'shopadmin1.asp (this routine checks to see if you are already logdded in
sub CheckLogin (loginflag)
ShopCheckLicense
LoginFlag="Yes"
if GetSess("Customerid")<>"" and GetSess("Lastname") <>"" then
if GetSess("Customerlogincid")="" then
SetSess "CustomerLoginCID",GetSess("Customerid")
Loginflag="No"
else
Loginflag="No"
end if
end if
'800 - 2015.05.20 - Better Guest Checkout process
if session("guestcheckout") = "yes" then
Loginflag="Yes"
SetSess "customertype",""
setsess "login", ""
setsess "customerid", ""
end if
end sub
sub AddMenu
dim i
htmlwrite ""
FormatHeader
'6.50 - tidy up this page
SetUpMenus
FormatTrailer
htmlwrite "
"
end sub
sub FormatHeader
'6.50 - tidy up this page
if SError<> "" then
ShopWriteError SError
SError=""
end if
if Infomsg<> "" then
ShopWriteError Infomsg & "
"
Infomsg=""
end if
htmlwrite "" & GetLang("langCustAdmin01") & "
"
end sub
sub FormatRow (name, url)
end sub
sub FormatTrailer
end sub
sub AddMenuItem (caption, url, flag)
if flag<>"Yes" then exit sub
response.write "" & caption & "" & vbcrlf
end sub
sub AddNewUser
end sub
sub SetUpMenus
menucount=0
WriteMenuTable GetLang("langMaillistSubject"),"images/icons/user.gif"
'Check to see if user is logged in and will display correct caption and link accordingly
'6.50.4 - moved register and update links into if statement below so they only show when relevent
if LoginFlag="Yes" then
'800 - Enhanced SEO
AddMenuItem GetLang("langCommonLogin"),DoFriendlySEOPage("shopcustadminlogin.asp"), "Yes"
AddMenuItem GetLang("langMaillistSubject"),DoFriendlySEOPage("shopcustregister.asp"), GetConfig("xAllowcustomerregister")
else
'800 - Enhanced SEO
AddMenuItem GetLang("langCommonLogout"),""& DoFriendlySEOPage("shopcustadminlogin.asp") &"?new=yes", "Yes"
AddMenuItem GetLang("langCustAdminDetails"),DoFriendlySEOPage("shopcustupdate.asp"),GetConfig("xAllowCustomerUpdates")
end if
'800 - Enhanced SEO
AddMenuItem GetLang("langSupplierAdmin"),DoFriendlySEOPage("shopsupplierregister.asp"), GetConfig("xAllowSupplierRegister")
AddMenuItem GetLang("langLoginForgot"),DoFriendlySEOPage("shopmailpwd.asp"), GetConfig("xPassword")
'Sept 26, 2003 add redeem points
'800 - Enhanced SEO
AddMenuItem GetLang("langredeempoints"),DoFriendlySEOPage("shoppointsredeem.asp"), GetConfig("xpointsredeem")
CloseMenuTable
if GetConfig("xAllowCoupons") = "Yes" Or _
GetConfig("xAllowReviewOrders") = "Yes" Or _
GetConfig("xrmaAllowed") = "Yes" Or _
ShowUPS = "Yes" then
WriteMenuTable GetLang("langaffvieworders"),"images/icons/package.gif"
'800 - Enhanced SEO
AddMenuItem GetLang("langCouponDiscount"),DoFriendlySEOPage("shopcustadmincoupon.asp"),GetConfig("xAllowCoupons")
AddMenuItem GetLang("langCustAdminStatus"),DoFriendlySEOPage("shopstatus.asp"), GetConfig("xAllowReviewOrders")
AddMenuItem GetLang("LangCommonView") & " " & GetLang("langRMA") & "s",DoFriendlySEOPage("shoprmalist.asp"), GetConfig("xrmaAllowed")
AddMenuItem "UPS Tracking",DoFriendlySEOPage("shopa_ups_track.asp"), ShowUPS
'700 Project Payments Enhancement
'800 - Enhanced SEO
AddMenuItem GetLang("langinvoicesummary"),DoFriendlySEOPage("shopprojectsummary.asp"), "Yes"
CloseMenuTable
end if
if GetConfig("xwishlist") = "Yes" Or _
GetConfig("xproductwishlist") = "Yes" Or _
GetConfig("xAllowSaveCart") = "Yes" Or _
GetConfig("xgiftregistry") = "Yes" then
WriteMenuTable GetLang("langsavecartprompt"),"images/icons/shoppingcart.gif"
'800 - Enhanced SEO
AddMenuItem GetLang("langWishList") & " " & GetLang("langcommonView"),DoFriendlySEOPage("shopsaveperm.asp"), GetConfig("xwishlist")
AddMenuItem GetLang("langWishList") & " " & GetLang("LangProductProduct"),""& DoFriendlySEOPage("shopwishlist.asp") &"?action=list", GetConfig("xproductwishlist")
AddMenuItem GetLang("langSaveCartPrompt"),DoFriendlySEOPage("shopsavecart.asp"), GetConfig("xAllowSaveCart")
AddMenuItem GetLang("langGiftRegistry"),DoFriendlySEOPage("shopgiftregadmin.asp"), GetConfig("xgiftregistry")
CloseMenuTable
end if
if GetConfig("xGiftCertificates") = "Yes" then
WriteMenuTable GetLang("langgiftcertificate"),"images/icons/chest.gif"
'800 - Enhanced SEO
AddMenuItem GetLang("langGiftRedeem"),DoFriendlySEOPage("shopcustadmingift.asp"), GetConfig("xGiftCertificates")
AddMenuItem GetLang("langGiftBuy"),DoFriendlySEOPage("shopgift.asp"), GetConfig("xGiftCertificates")
'600 - Check remaining gift cerificate amount
AddMenuItem GetLang("langGiftRemain"),""& DoFriendlySEOPage("shopcustadmingift.asp") &"?howmuch=true", GetConfig("xGiftCertificates")
'Also displays points redeem if type is GIFT
if ucase(GetConfig("xpointsredeemtype")) = "GIFT" then
'800 - Enhanced SEO
AddMenuItem GetLang("langredeempoints"),DoFriendlySEOPage("shoppointsredeem.asp"), GetConfig("xpointsredeem")
end if
CloseMenuTable
end if
if GetConfig("xAllowMailList") = "Yes" Or GetConfig("xcontactform") = "Yes" then
WriteMenuTable GetLang("langcontactus"),"images/icons/messages.gif"
'800 - Enhanced SEO
AddMenuItem GetLang("langCustAdminMailList"),DoFriendlySEOPage("shopmaillist.asp"), GetConfig("xAllowMailList")
AddMenuItem GetLang("langContactus"),DoFriendlySEOPage("shopcustcontact.asp"), GetConfig("xcontactform")
CloseMenuTable
end if
'700 - 2010.09.21 - Enhancement: To have xaffiliateenable to switch on/off affilate features
if getconfig("xaffiliateenable") = "Yes" then
'6.50 - add affiliate link to customer page
WriteMenuTable GetLang("langaff"),"images/icons/affiliates.gif"
'800 - Enhanced SEO
AddMenuItem GetLang("langaff"),DoFriendlySEOPage("shopaffadmin.asp"), "Yes"
CloseMenuTable
end if
'700 - Downloads Enhancement
'add downloads section caption
if lcase(getconfig("xdownloads")) = "yes" then
WriteMenuTable GetLang("LangorderDownload"),"images/icons/package.gif"
AddMenuItem GetLang("LangorderDownload"),DoFriendlySEOPage("shopcustdownloads.asp"), "Yes"
CloseMenuTable
end if
menucount=menucount-1
Shopproductcheck
end sub
function ShowUPS
if (GetUPSConfig("xupsacctno", true, dbc) = "") or (GetUPSConfig("AccessLicenceNum", true, dbc) = "") then
ShowUPS = "No"
else
ShowUPS = "Yes"
end if
end function
sub WriteMenuTable(caption,img)
htmlwrite ""
htmlwrite "
" & caption & "
"
htmlwrite "
"
end sub
'Closes menu table
sub CloseMenuTable
htmlwrite "