<% '******************************************************* ' Version 6.50 Shop Administration only ' different users can have different capabilities ' Menu items can be added or deleted ' Aug 17, 2004 add language conversion '****************************************************** dim strfldcomment dim strfldsection dim strfldmenu dim strfldorder Dim SortType Dim Sortfield Dim SortUpDown Dim Sortupdownnames(2) Dim Sortupdownvalues(2) Dim Sortupdowncount SetUpDown ShopCheckAdmin "shopa_menu_control.asp" ShopOpendatabase con DeleteMenu = True If Not Request("AddMenu")="" Then ValidateFields if Serror="" then ad = "insert into tblaccess (fldname,fldurl, fldcomment, fldsection, fldmenu, fldorder) values ('" & request("name") & "','" & request("file") & "','" & strfldcomment & "', '" & strfldsection & "', '" & strfldmenu & "', '" & strfldorder & "')" con.execute(ad) end if End If If Request("Delete")<>"" Then For each item in Request("DeleteMenu") SQL = "SELECT * FROM tbluser" Set rs = con.Execute(SQL) access = Split(rs("fldaccess"),",") For each a in access if cStr(Trim(item)) = cStr(Trim(a)) Then DeleteMenu = False End if Next If DeleteMenu Then d = "DELETE FROM tblaccess WHERE fldauto = " & item con.Execute(d) End If Next if DeleteMenu=False Then serror="Please Delete User Access First!
" end if End If sortfield=request("Sortfield") ' See how we are sorting If Sortfield="" or Sortfield=getlang("langCommonSelect") then sortfield="fldname" end if SortUpdown=request("SortUpdown") if SortUpdown = "ASC" then SortUpdown = "DESC" else SortUpdown = "ASC" end if AdminPageHeader Displayform SQL = "SELECT * FROM tblaccess" If sortfield<>"" then sql=sql & " order by " & sortfield & " " & sortupdown end if Setsess "sortfield",sortfield Setsess "sortupdown",sortupdown Set objRec = con.Execute(SQL) While Not objRec.EOF id = objRec("fldauto") name = objRec("fldname") convertlangname name FormatMenuRow objRec.MoveNext Wend objRec.Close set objRec=nothing Response.write "" response.write "

" Response.write "" response.write "
" GenerateDisplayBodyFooter Displayform2 gethelp Shopclosedatabase con adminPageTrailer Sub FormatMenurow '****************************************************** ' Format 1 menu row '****************************************************** dim url Response.write "" Response.write "" & name & "" Response.write "" & objrec("fldurl") & "" Response.write "" & objrec("fldsection") & "" Response.write "" & objrec("fldmenu") & "" url="" & getlang("Langcommonedit") & "" Response.write "" & url & "" url=" " Response.write "" & url & "" response.write "" end sub ' Sub ValidateFields Serror="" if Request("Name")="" then sError= sError & getlang("LangMenuMissing") & "
" end if if Request("File")="" then sError= sError & getlang("LangMenuFileMissing") & "
" end if strfldcomment=request("comment") If strfldcomment="" then strfldcomment=request("name") end if strfldsection = request("section") strfldmenu = request("menu") strfldorder = request("order") end sub Sub DisplayForm if sError > "" then%>

<%shopwriteerror sError%>

<% end if GenerateDisplayHeader "Menu Setup" GenerateDisplayBodyHeader %>

<% Response.write "" UserHeader "Name", "fldname" UserHeader "Filename", "fldurl" UserHeader "Section", "fldsection" UserHeader "Menu", "fldmenu" Userheader getlang("LangCommonedit"), "NOSORT" Userheader getlang("LangCommonDelete"), "NOSORT" Response.write ReportRowEnd end sub Sub UserHeader (title, sorter) Response.write Reportheadcolumn if sorter = "NOSORT" then response.write title else SortHeader title, sorter end if response.write reportheadcolumnend end sub Sub Displayform2 GenerateDisplayHeader getlang("LangAddMenu") GenerateDisplayBodyHeader %><% Response.write tabledef CreateCustRow getlang("langMenuname"), "Name", strname,"No" CreateCustRow getlang("langMenuFilename"), "File", strfilename,"No" CreateCustRow getlang("langMenuComment"), "comment", strcomment,"No" response.write "" ' CreateCustRow "Section", "section", strsection,"No" ' response.write "" CreateCustRow "Menu", "menu", strmenu,"No" CreateCustRow "Order", "order", strorder,"No" Response.write tabledefend %><%Shopbutton "", getlang("langaddmenu"), "AddMenu"%><% Response.write "" GenerateDisplayBodyFooter end sub Sub SetUpDown Sortupdownnames(0)=getlang("langAscending") Sortupdownnames(1)=getlang("langDescending") Sortupdownvalues(0)="ASC" Sortupdownvalues(1)="DESC" SortUpDowncount=2 end sub %>

Section

" dim sectionArray sectionArray = split("everyday,occasional", ",") GenerateSelectNV sectionArray,strsection,"section", 2,"" response.write "

" ' dim menuRS, menuSQL, menuArray ' menuSQL = "select distinct fldmenu from tblaccess" ' set menurs = con.execute(menuSQL) ' while not menurs.eof ' menuArray = menuArray & menurs("fldmenu") & "," ' menurs.movenext ' wend ' menuArray = left(menuArray, len(menuArray) - 1) ' menuArray = right(menuArray, len(menuArray) - 1) ' menuArray = split(menuArray, ",") ' GenerateSelectNV menuArray,strmenu,menu, ubound(menuArray),"" ' CloseRecordSet menurs ' response.write "