<%Option explicit%> <% '******************************************************* ' Customer Service Menu ' VP-ASP Version 6.50 ' add more menus at the botom of this code ' April 19, 2004 add websess ' Nov 22, 2006 HK add RMA '******************************************************* Dim menus(20), urls(20), menucount Dim loginError, infomsg Dim NumProc dim LoginFlag NumProc = 0 'VP-ASP 6.50 - precautionary security fix 'VP-ASP Security Fix 'February 2008 Infomsg=cleanchars(request("msg")) 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" ShopPageHeader if getconfig("xbreadcrumbs") = "Yes" then response.write "
Home " & SubCatSeparator & getlang("langCustAdmin01") & "
" end if Checklogin loginflag 'VP-ASP 6.50 - tidy up this page 'SetupMenus if sError<> "" then shopwriteerror SError Serror="" end if if Infomsg<> "" then shopwriteerror Infomsg Infomsg="" end if AddMenu AddNewUser ShopPageTrailer 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 end sub '********************************************************************** ' Version 3.00 ' Shopadmin.asp forces relogin ' shopadmin1.asp (this routine checks to see if you are already logdded in '*********************************************************************** '******** Display table Sub AddMenu dim i FormatHeader 'VP-ASP 6.50 - tidy up this page SetUpMenus 'For i = 0 to menucount ' Formatrow Menus(i), addwebsess(urls(i)) 'next FormatTrailer end sub ' Sub FormatHeader 'VP-ASP 6.50 - tidy up this page if sError<> "" then shopwriteerror SError Serror="" end if if Infomsg<> "" then shopwriteerror Infomsg & "
" Infomsg="" end if ' style modified by Joseph to maintain consistency Response.write "

" & getlang("langCustAdmin01") & "

" 'Response.write "
" & Custadmintable 'Response.write CustAdminHeaderRow 'Response.write CustAdminHeaderFont & getlang("langCustAdmin01") & CustAdminHeaderEnd end sub ' Sub FormatRow (name, url) 'VP-ASP 6.50 - tidy up this page 'NumProc=Numproc+1 'response.write CustAdminRow 'Response.write CustAdminNumColumn & NumProc & "." & CustAdminNumEnd 'Response.write CustAdminColumn & "" & CustAdminFont & name & "" & CustAdminColumnEnd & vbcrlf end sub ' Sub FormatTrailer 'VP-ASP 6.50 - tidy up this page %> <% end sub ' Sub AddMenuItem (caption, url, flag) If flag<>"Yes" then exit sub 'VP-ASP 6.50 - tidy up this page 'menus(menucount)=caption 'urls(menucount)=url 'menucount=menucount+1 Response.write "
  • " & caption & "
    • " & vbcrlf end sub ' Sub addnewUser 'VP-ASP 6.50 - tidy up this page 'response.write ("

    " & getlang("langLogin02") & "

    ") end sub Sub SetUpMenus '*********************************************************************** ' First field is the caption the customer sees ' Second is URL to go to ' Third is "Yes" (case sensitive) If Yes menu is displayed '************************************************************************ 'VP-ASP 6.50 - tidy up this page 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 If LoginFlag="Yes" Then AddMenuItem getlang("langCommonLogin"),"shopcustadminlogin.asp", "Yes" Else AddMenuItem getlang("langCommonLogout"),"shopcustadminlogin.asp?new=yes", "Yes" End If AddMenuItem getlang("langMaillistSubject"),"shopcustregister.asp", getconfig("xAllowcustomerregister") AddMenuItem getlang("langSupplierAdmin"),"shopsupplierregister.asp", getconfig("xAllowSupplierRegister") AddmenuItem getlang("langCustAdminDetails"),"shopcustupdate.asp",getconfig("xAllowCustomerUpdates") AddMenuItem getlang("langLoginForgot"),"shopmailpwd.asp", getconfig("xPassword") ' Sept 26, 2003 add redeem points AddMenuItem Getlang("langredeempoints"),"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" AddMenuItem getlang("langCouponDiscount"),"shopcustadmincoupon.asp",getconfig("xAllowCoupons") AddMenuItem getlang("langCustAdminStatus"),"shopstatus.asp", getconfig("xAllowReviewOrders") AddMenuItem getlang("LangCommonView") & " " & getlang("langRMA") & "s","shoprmalist.asp", getconfig("xrmaAllowed") AddMenuItem "UPS Tracking","shopa_ups_track.asp", showUPS 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" AddMenuItem getlang("langWishList") & " " & getlang("langcommonView"),"shopsaveperm.asp", getconfig("xwishlist") AddMenuItem getlang("langWishList") & " " & getlang("LangProductProduct"),"shopwishlist.asp?action=list", getconfig("xproductwishlist") AddMenuItem getlang("langSaveCartPrompt"),"shopsavecart.asp", getconfig("xAllowSaveCart") AddMenuItem getlang("langGiftRegistry"),"shopgiftregadmin.asp", getconfig("xgiftregistry") CloseMenuTable End If If getconfig("xGiftCertificates") = "Yes" Then WriteMenuTable getLang("langgiftcertificate"),"images/icons/chest.gif" AddMenuItem getlang("langGiftRedeem"),"shopcustadmingift.asp", getconfig("xGiftCertificates") AddMenuItem getlang("langGiftBuy"),"shopgift.asp", getconfig("xGiftCertificates") 'VP-ASP 600 - Check remaining gift cerificate amount AddMenuItem Getlang("langGiftRemain"),"shopcustadmingift.asp?howmuch=true", getconfig("xGiftCertificates") 'Also displays points redeem if type is GIFT If ucase(getconfig("xpointsredeemtype")) = "GIFT" Then AddMenuItem Getlang("langredeempoints"),"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" AddMenuItem getlang("langCustAdminMailList"),"shopmaillist.asp", getconfig("xAllowMailList") AddMenuItem getlang("langContactus"),"shopcustcontact.asp", getconfig("xcontactform") CloseMenuTable End If 'VP-ASP 6.50 - add affiliate link to customer page WriteMenuTable getLang("langaff"),"images/icons/affiliates.gif" AddMenuItem getlang("langaff"),"shopaffadmin.asp", "Yes" CloseMenuTable menucount=menucount-1 Shopproductcheck end sub function showUPS shopopendatabase myconn if (GetUPSConfig("xupsacctno", true, myconn) = "") or (GetUPSConfig("AccessLicenceNum", true, myconn) = "") then showUPS = "No" else showUPS = "Yes" end if shopclosedatabase myconn end function 'VP-ASP 6.50 - tidy up this page ' Displays menu table header Sub WriteMenuTable(caption,img) Response.Write "" Response.Write "" Response.Write "
    " & caption & "
      " End Sub ' Closes menu table Sub CloseMenuTable Response.Write "
    " End Sub %>