<%option explicit%> <% Const ExtraDisplay="No" ShopCheckAdmin "shopa_editdisplay.asp" '************************************************************************** ' Shop administration Only ' Format list of Records in any table so that they can be viewed or deleted ' add sort facility, fields to display ' 5.00 Apr 3, 2003 ' Free Version '************************************************************************** dim mysql Dim Fieldcount Dim Headnames(6) Dim ProcType Dim SortType Dim Sortfield Dim SortUpDown Dim Sortupdownnames(2) Dim Sortupdownvalues(2) Dim Sortupdowncount Dim Procnames(3) dim Procvalues(3) Dim Fieldnames Dim Fieldnamecount Dim DisplayFields Dim displayFieldCount Dim DisplayField Dim Idfield Dim SelectField Dim SelectValue Dim maxfields Dim i Dim item dim dbtable Dim scriptresponder dim fieldname Dim rstemp Dim dbc dim SpecialFunction Dim Continue Dim SelectAll Dim productcategoryid dim language dim partsql ' ' SelectAll="" GetTableName SetSess "CurrentURL","shopa_editdisplay.asp" AdminPageHeader GetDatabase If dbtable<>"" then ' no valid table GetSpecialFunction EditOpenDatabase dbc,database,dbtable GetInput ' get all form fields maxfields=6 ProcessSpecialRequests ' delete or mail requests SetupResponders GenerateDisplayHeader ' Generate sort button etc ' Different Responders for different tables ShopopenRecordSet mysql, rstemp, mypagesize, mypage GenerateTable ' write the tabe Call PageNavBar (Mysql) ' put bottom navigation bar rsTemp.close ' close database set rstemp=nothing ShopCloseDatabase dbc end if AdminPageTrailer ' Write admin trailer ' Sub GetDatabase Database=request("database") if database="" then database=GetSess("db") else SetSess "db",database end if if database="" then Debugwrite "No database specified" end if end sub Sub GetTableName dbtable=Request("Table") if dbtable="" then dbtable=GetSess("table") else ValidateTable end if if dbtable="" then shopwriteerror getlang("langEditSelectFail") exit sub end if SetSess "table",dbtable 'Response.write getlang("langEdittablename") & " = " & dbtable & "
" end sub Sub GetSpecialFunction specialfunction=Request("Specialfunction") if specialfunction="" then specialfunction=GetSess("specialfunction") If Specialfunction="" then specialfunction=getlang("langCommonDelete") setsess("specialfunction"),specialfunction end if else If ucase(Specialfunction)="NULL" then SpecialFunction="" end if end if SetSess "specialfunction",specialfunction end sub '************************************************************************** Sub GetInput mypage = Request("page") 'first time we need everything, othertimes sql is set up sortfield=request("Sortfield") ' See how we are sorting If Sortfield="" or Sortfield=getlang("langCommonSelect") then sortfield=IdField end if SelectValue=request("Selectvalue") SelectField=request("selectField") Productcategoryid=request("productcategoryid") If productcategoryid=getlang("langCommonselect") then productcategoryid="" end if If SelectField=getlang("langCommonselect") then selectvalue="" end if 'response.write "sortfield="& sortfield & "
" ' see which types processed or unprocessed SortUpdown=request("SortUpdown") If SortUpdown="" then sortupdown="ASC" end if if mypage="" then SetFieldNames ' field names for table GetDisplayfields mypage=1 GenerateSQL else Mysql=Getsess("sqlquery") Fieldcount=GetSess("Fieldcount") Fieldnames=GetsessA("Fieldnames") sortfield=GetSess("sortfield") sortupdown=GetSess("sortupdown") IDfield=GetSess("IDfield") productcategoryid=GetSess("productcategoryid") language=Getsess("editlanguage") dbtable=GetSess("table") DisplayFields=GetSess("DisplayFields") DisplayFieldCount=GetSess("DisplayFieldCount") partsql=getsess("partsql") end if maxrecs=getconfig("xeditdisplaymaxrecords") mypagesize=maxrecs SetUpDown ' see if mail of export If Request("SelectAll")<>"" then SelectAll=" checked " end if database=Getsess("db") end sub ' ' SQL is generate by using fields on form Sub GenerateSQL dim sqlproc dim key dim sqladd sqladd=" Where" MySql = "SELECT * from " & lcase(dbtable) if Selectvalue<> "" then key = SelectValue & "%" If isnumeric(selectvalue) then mySQL = MySQL & " where " & SelectField & "=" & Selectvalue else mySQL = MySQL & " where " & SelectField & " like '" & key & "'" end if sqladd=" AND " end if If ucase(dbtable)="PRODUCTS" then DoRestrictProducts MySQL, sqladd end if If Productcategoryid<>"" then mysql=Mysql & sqladd mysql=Mysql & " ccategory=" & productcategoryid sqladd=" And " end if AddLanguagesql mysql, sqladd If sortfield="" then sortfield=idfield If sortfield<>"" then mysql=mysql & " order by " & sortfield & " " & sortupdown end if SetSess "sqlquery",MySQL Setsess "sortfield",sortfield Setsess "sortupdown",sortupdown If getconfig("xdebug")="Yes" then debugwrite "generated sql=" & mysql & "
" end if End sub ' Sub DorestrictProducts (isql, sqladd) if getconfig("XAdminRestrictProducts")<>"Yes" then exit sub If GetSess("Admintype")="" then exit sub If GetSess("Admintype")="SUPER" then exit sub iSql = isql & sqladd & " userid='" & GetSess("shopadmin") & "'" end sub Sub GenerateTable() dim howmanyfields dim my_link Dim howmanyrecs Dim ArrayFields Dim fieldvalue dim idvalue SetSess "Table",dbtable SetSess "Dbname",dbname SetSess "Idfield",idfield SetSess "Fieldcount",fieldcount If DisplayFieldcount> 0 then howmanyfields=DisplayFieldCount-1 ArrayFields=DisplayFields else howmanyfields=fieldcount-1 ArrayFields=Fieldnames end if 'DebugWrite "fieldcount = " & fieldcount & "howmany=" & howmanyfields if howmanyfields > maxfields then howmanyfields = maxfields end if response.write "" response.write "" & getlang("langCommonPage") & mypage & getlang("langCommonOf") & maxpages & "" %>

<% response.write ReportTableDef & ReportHeadRow & "" for i=0 to howmanyfields response.write ReportHeadColumn & ArrayFields(i) & reportHeadColumnEnd next If Specialfunction<>"" then Response.write ReportHeadColumn & SpecialFunction & reportHeadColumnEnd end if Response.write "" ' Now lets grab all the records howmanyrecs=0 DO UNTIL rstemp.eof OR howmanyrecs=maxrecs idvalue=rstemp(idfield) if partsql<>"" then Formatproductdetails idvalue, howmanyfields,arrayfields else my_link=scriptresponder & "?which=" & rstemp(idfield) & "&idfield=" & idfield & "&table=" & dbtable & "&database=" & dbname response.write ReportDetailRow & ReportDetailColumn & "" & getlang("langCommonEdit") & "" & reportDetailColumnEnd for i = 0 to howmanyfields If IsNull(rstemp(ArrayFields(i))) then response.write ReportDetailColumn & " " & reportDetailcolumnEnd else response.write ReportDetailColumn & rstemp(ArrayFields(i)) & ReportDetailColumnEnd end if next end if If SpecialFunction<>"" then response.write ReportDetailColumn & "" & reportdetailcolumnend end if AddspecialLinks response.write "" howmanyrecs=howmanyrecs+1 if howmanyrecs < maxrecs then rstemp.movenext end if loop if Specialfunction<>"" then %>

">	">
">	">

<% else Response.write "" end if %> <% response.write("

") end sub Sub SetFieldNames Fieldnamecount=0 dim fSql dim rs dim fldname ReDim Fieldnames(200) FSQL = "SELECT * FROM " & lcase(dbtable) 'debugwrite fSQL Set rs = dbc.Execute(fSQL) For each fldName in rs.Fields Fieldnames(fieldcount)=fldName.Name ' debugwrite fieldnames(fieldcount) & "
" fieldcount=fieldcount+1 next rs.close Idfield=Fieldnames(0) SetSessA "Fieldnames",Fieldnames DisplayFields=Fieldnames Displayfieldcount=fieldcount SetSessA "DisplayFields",Displayfields SetSess "DisplayFieldCount",displayfieldCount End Sub Sub SetUpDown Sortupdownnames(0)=getlang("langAscending") Sortupdownnames(1)=getlang("langDescending") Sortupdownvalues(0)="ASC" Sortupdownvalues(1)="DESC" SortUpDowncount=2 end sub ' ******************************************************* Sub DeleteRecord(Item) dim Rowsaffected dbc.Execute "delete from " & dbtable & " where " & idfield & "=" & Item, RowsAffected, 1 end sub '***************************************************** Sub GenerateDisplayHeader GenerateSelection response.write "" %> " response.write "" end sub Sub GetDisplayFields dim i Dim displayArray(100) DisplayFieldCount = Request("DisplayFields").Count 'Debugwrite DisplayfieldCount if DisplayfieldCount=0 then SetSess "Displayfieldcount",displayfieldcount exit sub end if displayField=Request("DisplayFields") DisplayFields= Split(DisplayField, ", ", -1, 1) If DisplayFields(0)="All" then Displayfieldcount=0 end if SetSessA "DisplayFields",DisplayFields SetSess "Displayfieldcount",displayfieldcount end sub '***************************** Sub GenerateSelection %> <% If Extradisplay="Yes" then %> <%end if%>

<%=getlang("langEditMailSetup")%>	<%=getlang("langEditSelectSetup")%>	<%=getlang("langEditExportSetup")%>	<%=getlang("langEditDeleteSetup")%>
Ebay Setup

<% End sub Sub ProcessSpecialRequests if Request("All") <> "" then SEtSess "Allrecords","Yes" ProcessSpecialFunction else SetSess "AllRecords","" end if If Request("Selected")<>"" then ProcessSpecialFunction end if end sub Sub ProcessSpecialfunction dim deletename deletename=getlang("langcommonDelete") & "User" SpecialFunction=ucase(Request("SpecialFunction")) If SpecialFunction=ucase(getlang("langCommonDelete")) Then For each item in Request(Deletename) DeleteRecord Item Next exit sub End if If Specialfunction=ucase(getlang("langSpecialMAIL")) then ProcessMail exit sub End if If SpecialFunction=ucase(getlang("langSpecialEXPORT")) Then ProcessExport exit sub End if If SpecialFunction="EBAY" Then ProcessEbay exit sub End if end sub Sub setupResponders dim uctable uctable=ucase(dbtable) select case uctable Case "PRODUCTS" scriptresponder="shopa_addproduct.asp" case "CATEGORIES" scriptresponder="shopa_addcategory.asp" case "SHIPMETHODS" scriptresponder="shopa_editshipmethods.asp" case "MYCOMPANY" scriptresponder="shopa_editmycompany.asp" case "PRODFEATURES" scriptresponder="shopa_editprodfeatures.asp" case "TEMPLATES" scriptresponder="shopa_edittemplate.asp" case else scriptresponder="shopa_editrecord.asp" end select end sub '*************************************************************** Sub ProcessEbay Dim ExportList Dim Exporttype SetSess "Table",dbtable Exportlist="" For each item in Request("EbayUser") If Exportlist<>"" then ExportList= Exportlist & "," & item else Exportlist=item end if Next SetSess "ExportList",Exportlist 'DebugWrite "Ebaylist=" & Exportlist Response.redirect "shopa_ebay.asp" end sub Sub ProcessExport Dim ExportList Dim Exporttype, exportname setSess "Table",dbtable Exportname=getlang("langspecialexport") & "User" Exportlist="" Exporttype=GetSess("ExportType") ExportType = ucase(left(exporttype,3)) For each item in Request(exportname) If Exportlist<>"" then ExportList= Exportlist & "," & item else Exportlist=item end if Next SetSess "ExportList",Exportlist shopclosedatabase dbc Response.redirect "shopa_export.asp" end sub Sub ProcessMail Dim MailList, mailname mailname=getlang("langSpecialmail") & "User" SetSess "Table",dbtable Maillist="" For each item in Request(Mailname) If Maillist<>"" then MailList=MailList & "," & item else MailList=item end if Next SetSess "MailList",Maillist Shopclosedatabase dbc Response.redirect "shopa_mail.asp" end sub Sub ValidateTable '******************************************** 'See if user has access to this table Dim UserTables dim tablecount if getconfig("xRestrictAdminTables")<>"Yes" then exit sub UserTables=GetSess("UserTables") If Isnull(UserTables) then exit sub end if if UserTables="" then exit Sub else UserTables=split(GetSess("UserTables"),",",-1,1) end if tablecount=ubound(UserTables) for i = 0 to tablecount if ucase(dbtable)=ucase(Usertables(i)) then exit sub end if next dbtable="" end sub Sub addSpecialLinks dim my_link If ucase(Dbtable)<>"REGISTRANT" then exit sub my_link="shopgiftregformat.asp" & "?which=" & rstemp(idfield) response.write ReportDetailColumn & "" & getlang("langCommonView") & "" & reportDetailColumnEnd end sub Sub AddCategories If lcase(dbtable)<>"products" then exit sub dim cid, name,catSQL,i, highercategoryid dim strcategory, catcount, categories,maxcategories, categoryids Dim catrs, hassubcategory,mylink catcount=getsess("allcatcount") If catcount="" then catcount=0 catcount=0 If catcount=0 then catcount=0 maxcategories=getconfig("xmaxcategories") redim categories(maxcategories) redim categoryids(maxcategories) catSQL="Select * from categories where highercategoryid=0 order by catdescription" set catrs=dbc.execute(catsql) While Not catrs.EOF and catcount" %> " %>

<% GenerateSelectV categories,categoryids,productcategoryid,"productcategoryid", catcount,getlang("langCommonSelect") Response.write "

<%=getlang("langcommoncategories")%>

<% response.write "

" end sub Sub AddLanguages If lcase(dbtable)<>"languages" then exit sub dim languages, langcount, i Readlanguages languages, langcount,"Yes" response.write "

" %> " %>

<% GenerateSelectNV languages,language,"language", langcount,getlang("langcommonselect") Response.write " <%=getlang("LangLanguage")%>
<% response.write "

" end sub Sub AddLanguagesql (mysql, sqladd) If lcase(dbtable)<>"languages" then exit sub language=request("language") If language="" then language=Getsess("language") end if if language="" then language=getconfig("xlanguage") end if If language=getlang("Langcommonselect") then language="" end if If language<>"" then mysql=Mysql & sqladd mysql=Mysql & " lang='" & language & "'" sqladd=" And " end if end sub Sub FormatProductDetails (catalogid, howmanyfields,arrayfields) dim rstemp, sql,my_link sql="select * from products where catalogid=" & catalogid set rstemp=dbc.execute(sql) my_link=scriptresponder & "?which=" & rstemp(idfield) & "&idfield=" & idfield & "&table=" & dbtable & "&database=" & dbname response.write ReportDetailRow & ReportDetailColumn & "" & LangCommonEdit & "" & reportDetailColumnEnd for i = 0 to howmanyfields If IsNull(rstemp(ArrayFields(i))) then response.write ReportDetailColumn & " " & reportDetailcolumnEnd else response.write ReportDetailColumn & rstemp(ArrayFields(i)) & ReportDetailColumnEnd end if next closerecordset rstemp end sub %>

<%=getlang("langEdittablename")%>: <%=dbtable%>
<%=getlang("langEditSort")%>	<%=getlang("langEditSelect")%>	<%=getlang("langEditDisplay")%>
<%GenerateSelectNV fieldnames,sortfield,"sortfield", fieldcount, getlang("langCommonSelect")%> <%GenerateSelectV Sortupdownnames,Sortupdownvalues,sortupdown,"sortupdown", sortupdowncount,""%>	<%GenerateSelectNV Fieldnames,SelectField,"SelectField", fieldcount, getlang("langCommonSelect")%>	<%GenerateSelectMult Fieldnames,fieldcount,DisplayFields,DisplayfieldCount,"DisplayFields","All"%>
<%=getlang("langEditadd")%>	">	">