<%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 ' VP-ASP 6.50 June 29, 2005 ' Oct 6, 2004 add delete productcategories '************************************************************************** 'VP-ASP 6.50 - filter customers on products ordered dim oitemsnamescount, oitemsnames, oitemsvalues 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 showhowmany dim SpecialFunction Dim Continue Dim SelectAll Dim productcategoryid dim language dim partsql dim Selectioncritereontext dim specialsearchcount dim Specialsearch dim tempText Specialsearch="YES" specialsearchcount=4 SelectAll="" SetSess "CurrentURL","shopa_editdisplay.asp" if request.form("advanced") > "" then if request.form("advanced") <> getsess("advanced") then setsess "advanced", request.form("advanced") responseredirect "shopa_editdisplay.asp?page="&GetSess("pagenumberaddproduct")&"&table=" & dbtable end if end if ShopcheckLicense AdminPageHeader GetTableName GetDatabase If dbtable<>"" then ' no valid table GetSpecialFunction EditOpenDatabase dbc,database,dbtable GetInput ' get all form fields maxfields=5 ProcessSpecialRequests ' delete or mail requests SetupResponders SetSess "pagenumberaddproduct",mypage GenerateSearchHeader ' 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 gethelp 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 not isnumeric(productcategoryid) 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=request("IDfield") if idfield ="" then IDfield=GetSess("IDfield") productcategoryid=GetSess("productcategoryid") language=Getsess("editlanguage") dbtable=GetSess("table") DisplayFields=GetSess("DisplayFields") DisplayFieldCount=GetSess("DisplayFieldCount") partsql=getsess("partsql") end if if request.form("showhowmany") > "" then if request.form("showhowmany") <> getlang("langcommonselect") then setsess "showhowmany", request.form("showhowmany") else setsess "showhowmany", getconfig("xeditdisplaymaxrecords") end if else if getsess("showhowmany") > "" then else setsess "showhowmany", getconfig("xeditdisplaymaxrecords") end if end if if instr(getsess("showhowmany"), ",") > 0 then setsess "showhowmany", left(getsess("showhowmany"), instr(getsess("showhowmany"), ",")) end if maxrecs=getsess("showhowmany") 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 shopproductcheck dim sqlproc dim key dim sqladd if Request("Selectioncritereontext")<>"" then if trim(ucase(request("Selectioncritereontext"))) <> trim(ucase(session("sqlquery"))) then mysql=request("Selectioncritereontext") setsess "sqlquery", request("Selectioncritereontext") exit sub end if end if sqladd=" Where" MySql = "SELECT * from " & lcase(dbtable) 'VP-ASP 6.50 - filter customers on products ordered oitemsnames=request("oitemsnames") If oitemsnames<>"" and isnumeric(oitemsnames) then 'If (oitemsnames<>"") AND (oitemsnames<>getlang("Langcommonselect")) then mysql = mysql & sqladd & " contactid IN (SELECT ocustomerid FROM orders WHERE orderid IN (SELECT orderid FROM oitems WHERE catalogid = " & oitemsnames &"))" sqladd= "AND" end if dim i dim bracketopen bracketopen=false simplespecialsearchterm MYSQL,sqladd,Request("criterion99"),Request("criterionvalue99"),Request("criteriontype99"),bracketopen For i = 1 to specialsearchcount specialsearchterm MYSQL,sqladd,Request("criterion" & i),Request("criterionvalue" & i ),Request("Selection" & i),bracketopen Next if bracketopen then MYSQl=MYSQL & ")" if Selectvalue<> "" then key = SelectValue & "%" 'VP-ASP 6.50 - replace any quotes in search term with '' mySQL = MySQL & " where " & SelectField & " like '" & replace(key,"'","''") & "'" sqladd=" AND " end if If ucase(dbtable)="PRODUCTS" then DoRestrictProducts MySQL, sqladd end if 'VP-ASP 6.50.1 - show all products for selected category If (Productcategoryid<>"") then mysql=Mysql & sqladd mysql=Mysql & " catalogid IN (SELECT intcatalogid FROM prodcategories WHERE intcategoryid = " & 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 setsess "Productcategoryid", Productcategoryid 'VP-ASP 6.50 - filter customers on products ordered SetSess "oitemsname",oitemsnames 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") & "'" sqladd=" and " 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 Request("DisplayFields")="" then if howmanyfields > maxfields then howmanyfields = maxfields end if end if GenerateDisplayHeaderFlat GenerateDisplayBodyHeader GenerateSelection GenerateDisplayBodyFooter GenerateDisplayHeaderFlat GenerateDisplayBodyHeader %>

<%=getlang("langCommonPage") & mypage & getlang("langCommonOf") & maxpages%>

<%Call PageNavBar (Mysql)%>

><% CheckAll dbtable,"SelectAll_" & dbtable if Specialfunction<>"" then %> <% if lcase(SpecialFunction) <> "delete" then%> <%else%> <%end if%>

<% end if response.write ReportTableDef & "" for i=0 to howmanyfields ' response.write ReportHeadColumn & ArrayFields(i) & reportHeadColumnEnd response.write ReportHeadColumn SortHeader ArrayFields(i),ArrayFields(i) response.write reportHeadColumnEnd next response.write ReportHeadColumn & "Edit" & reportHeadColumnEnd If ucase(Dbtable)="REGISTRANT" then response.write ReportHeadColumn & "View" & reportHeadColumnEnd end if If Specialfunction<>"" then ' Response.write ReportHeadColumn & SpecialFunction & reportHeadColumnEnd response.write "" 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 & "?page="&mypage&"&which=" & rstemp(idfield) & "&idfield=" & idfield & "&table=" & dbtable & "&database=" & dbname ' response.write ReportDetailRow & ReportDetailColumn & "" & getlang("langCommonEdit") & "" & reportDetailColumnEnd response.write ""'tablerow for i = 0 to howmanyfields If IsNull(rstemp(ArrayFields(i))) then response.write ReportDetailColumn & " " & reportDetailcolumnEnd else if len(rstemp(ArrayFields(i))) > 28 then tempText = RemoveHtmlFileio(rstemp(ArrayFields(i)),"
") response.write ReportDetailColumn & left(tempText, 26) & "..." & ReportDetailColumnEnd 'response.write ReportDetailColumn & left(rstemp(ArrayFields(i)), 26) & "..." & ReportDetailColumnEnd else tempText = RemoveHtmlFileio(rstemp(ArrayFields(i)),"
") response.write ReportDetailColumn & tempText & ReportDetailColumnEnd 'response.write ReportDetailColumn & rstemp(ArrayFields(i)) & ReportDetailColumnEnd end if end if next end if response.write ReportDetailColumn & "

" & reportDetailColumnEnd AddspecialLinks If SpecialFunction<>"" then response.write ReportDetailColumn & "" & reportdetailcolumnend end if response.write "" howmanyrecs=howmanyrecs+1 if howmanyrecs < maxrecs then rstemp.movenext end if loop if Specialfunction<>"" then %>
<% if lcase(SpecialFunction) <> "delete" then%> <%else%> <%end if%>

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

<%=getlang("langCommonPage") & mypage & getlang("langCommonOf") & maxpages%>

<%Call PageNavBar (Mysql)%>

<% response.write("

") GenerateDisplayBodyFooter 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 dim dsql dbc.Execute "delete from " & dbtable & " where " & idfield & "=" & Item, RowsAffected, 1 If lcase(dbtable)="products" then dsql="delete from prodcategories where intcatalogid=" & item dbc.execute(dsql) end if end sub '***************************************************** Sub GenerateSearchHeader %>

	<%=getlang("langEditadd")%>	<%shopwriteheader ucase(left(dbtable, 1)) & lcase(right(dbtable, len(dbtable) - 1))%>
<%shopwriteerror sError%>

<%=ucase(left(dbtable, 1)) & lcase(right(dbtable, len(dbtable) - 1))%> Search

<% AddHowMany %>

Selection criteria:	<% Writetableallfields dbtable,"99",request.form("criterion99") %>		">

<%AddCategories Addlanguages %>

<%if getsess("advanced") <> "yes" then %>

" onclick="location.href='shopa_editdisplay.asp?<%=Request.ServerVariables("QUERY_STRING")%>'" >

<%end if%>

<%If Specialsearch="YES" then%> <%else%> <%end if %>

<%callSpecialSearch%>

<%GenerateSelectNV Fieldnames,SelectField,"SelectField", fieldcount, getlang("langCommonSelect")%>

<%=getlang("langEditDisplay")%>
<%GenerateSelectMult Fieldnames,fieldcount,DisplayFields,DisplayfieldCount,"DisplayFields","All"%>

Query Statement
<%=Selectioncritereontext%>

<%if lcase(dbtable) = "customers" then%>

<%GenerateOitemsFilter%>

<%end if%>

" onclick="location.href='shopa_editdisplay.asp?<%=Request.ServerVariables("QUERY_STRING")%>'" >

" type="hidden" id="advanced">

<%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 "CONTENT" scriptresponder="shopa_editcontent.asp" case "TRANSLATEPRODUCTS" scriptresponder="shopa_edittranslateproducts.asp" case "TRANSLATECATEGORIES" scriptresponder="shopa_edittranslatecategories.asp" case "TRANSLATEPRODFEATURES" scriptresponder="shopa_edittranslateprodfeatures.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 Responseredirect "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 Responseredirect "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 Responseredirect "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 my_link="shopgiftregformat.asp" & "?which=" & rstemp(idfield) response.write ReportDetailColumn & "

" & reportDetailColumnEnd end if 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

<%=getlang("langcommoncategories")%>

<%GenerateSelectV categories,categoryids,productcategoryid,"productcategoryid", catcount,getlang("langCommonSelect")%>

<% 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")%> <%=getlang("LangLanguage")%>

<% response.write "
" & getlang("Langcommonreset") & " " & 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 AddHowMany %>

Results Per Page

<%GenerateSelectV split("10,20,50,100",","),split("10,20,50,100",","),getsess("showhowmany"),"showhowmany", 4,getlang("langCommonSelect")%>

<% 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 Sub callSpecialSearch WriteSelectTable specialsearchcount End Sub '============================================== ' SPECIAL SEARCH CUSTOMISATION ' Writes the Table '============================================== Sub WriteSelectTable (num) dim i Selectioncritereontext=MYSQL %> <% For i = 1 to num %> <% Next %> <% For i = 1 to num %> <% Next %> <% For i = 1 to num %> <% Next %> <% For i = 1 to num %> <% Next %>

Select <%=i%>

<%Writetableallfields dbtable,i,""%>

" name=criterionvalue<%=i%> size="15">

<%RadioButtons i%>

<% End Sub '============================================== '============================================== ' SPECIAL SEARCH CUSTOMISATION ' Write all the fields for that table '============================================== Sub Writetableallfields (dbtable,num,selecttype) dim sql,rs,fieldnamestable,fieldcount,strselect,fldName,selected fieldcount=0 if selecttype="multiple" then strselect=" type=multiple size=5 " else strselect=" size=1" end if SQL = "SELECT * FROM " & dbtable Set rs = dbc.Execute(SQL) %> <% closerecordset rs End Sub Sub RadioButtons (num) if num=specialsearchcount then exit sub dim value,i,selected dim valuearray(3) valuearray(0)="And" valuearray(1)="Or" valuearray(2)="Not" value=Request("Selection"&num) %> <% if value="" then value="Or" For i = 0 to 2 if value=valuearray(i) then selected=" CHECKED" else selected="" end if %> <% Next %>

<%=valuearray(i)%>

<%=Selected%>>

<% End Sub Sub Writeselect(table,num,idfield,fieldname) sql="select * from " & table & "" set rs=dbc.execute(sql) %> <% closerecordset rs End Sub dim prevandor prevandor="" Sub specialsearchterm (SQL,sqladd,criterion,criterionvalue,andor,bracketopen) dim openbracket,closebracket openbracket="" closebracket="" if criterionvalue="" then exit sub if lcase(Sqladd)=" where" then sql=sql & sqladd sqladd="AND" end if if lcase(andor) = "not" then andor=" and " sql = sql & prevandor if (instr(criterion, "price") > 0) and (xdatabasetype = "SQLServer") then 'VP-ASP 6.50 - replace any quotes in search term with '' sql = sql & " " & criterion & " = " & replace(criterionvalue, "'", "''") else 'VP-ASP 6.50 - replace any quotes in search term with '' sql = sql & " " & criterion & " Not like '%" & replace(criterionvalue, "'", "''") & "%'" end if prevandor=andor else select case (lcase(andor)) case "or" if bracketopen=false then openbracket="(" bracketopen=true end if case "and" if bracketopen then closebracket=")" bracketopen=false end if end select if (instr(criterion, "price") > 0) and (xdatabasetype = "SQLServer") then 'VP-ASP 6.50 - replace any quotes in search term with '' sql = sql & " " & prevandor & " " & openbracket & criterion & " = " & criterionvalue & closebracket else 'VP-ASP 6.50 - replace any quotes in search term with '' sql = sql & " " & prevandor & " " & openbracket & criterion & " like '%" & criterionvalue & "%' " & closebracket end if prevandor=andor end if sqladd="AND" End Sub Sub simplespecialsearchterm (SQL,sqladd,criterion,criterionvalue,criteriontype,bracketopen) dim openbracket,closebracket openbracket="" closebracket="" if criterionvalue="" then exit sub if lcase(Sqladd)=" where" then sql=sql & sqladd sqladd="AND" end if if bracketopen then closebracket=")" bracketopen=false end if if (instr(criterion, "price") > 0) and (xdatabasetype = "SQLServer") then sql = sql & " " & openbracket & criterion & "=" & criterionvalue & closebracket else select case criteriontype case "equals" criterionvalue = " like '" & criterionvalue & "' " case "starts with" criterionvalue = " like '" & criterionvalue & "%' " case "contains" criterionvalue = " like '%" & criterionvalue & "%' " end select sql = sql & " " & openbracket & criterion & criterionvalue & closebracket end if sqladd="AND" End Sub '============================================== Sub GenerateSelection %>

<%=getlang("langEditMailSetup")%>

<%=getlang("langEditExportSetup")%>

<%=getlang("langCommonDelete")%> Mode

<% End sub 'VP-ASP 6.50 - filter customers on products ordered Sub GenerateOitemsFilter If getconfig("xdisplayordersproductlist")="Yes" then response.write "" GetOitemsnames response.write "" response.write "

Filter Orders on Items Ordered

" GenerateSelectV Oitemsnames, oitemsvalues, cstr(getsess("oitemsname")), "Oitemsnames", Oitemsnamescount,getlang("langCommonSelect") response.write "

" exit sub end if response.write "" response.write "" response.write "" response.write "

Filter Orders on catalogid

" response.write "" response.write "

" end sub 'VP-ASP 6.50 - filter customers on products ordered Sub GetOitemsNames dim oitemsdbc ShopOpendatabaseP oitemsdbc dim oitemssql, oitemsrs, k k = 0 'if GetSess("oitemsnamescount")<>"" then ' oitemsnames=GetSessA("oitemsnames") ' oitemsvalues=GetSessA("oitemsvalues") ' oitemsnamescount=GetSess("oitemsnamescount") ' exit sub 'end if redim oitemsnames(200) redim oitemsvalues(200) oitemssql="SELECT count(catalogid) as catcount FROM products" Set oitemsrs=Server.CreateObject("ADODB.Recordset") oitemsrs.open oitemssql, oitemsdbc, 3, 3 if not oitemsrs.eof then oitemsnamescount=oitemsrs("catcount") redim oitemsnames(oitemsnamescount) redim oitemsvalues(oitemsnamescount) end if oitemssql="SELECT catalogid, cname FROM products" Set oitemsrs=Server.CreateObject("ADODB.Recordset") oitemsrs.open oitemssql, oitemsdbc, 3, 3 while not oitemsrs.eof oitemsnames(k)= oitemsrs("catalogid") & " - " & oitemsrs("cname") oitemsvalues(k)= cstr(oitemsrs("catalogid")) k = k + 1 oitemsrs.movenext wend SetSessA "oitemsnames",oitemsnames SetSessA "oitemsvalues",oitemsvalues SetSess "oitemsnamescount",oitemsnamescount oitemsrs.close set oitemsrs=nothing ShopClosedatabase oitemsdbc end sub %>