<%option explicit%>
<%
ShopCheckAdmin ""
dim maximumnumberoffields
maximumnumberoffields = cint(getconfig("xbulkupdatefields"))
if maximumnumberoffields = "" then maximumnumberoffields = 5
'const maximumnumberoffields=5
'**************************************************************************
' Shop administration Only
' Allow customer to alter any field in any table in a table format
' Input: table=xxxxxxx
' 6.50 Nov 11, 2005
'**************************************************************************
dim my_link,scriptresponder
dim strcategorylist,strsubcategorylist
dim languages, langcount, i
dim rstemp
dim tempfield
dim sqlo
dim StockSql
dim ArrayFields
dim rowcount
dim fieldvalue
dim newfieldvalue
dim fieldtype
dim rc
dim fldname
dim strsql
dim gensql, genrs, rsfieldvalue, displayfieldvalue
dim cid, name,catSQL,highercategoryid
dim catcount, maxcategories
Dim catrs, hassubcategory,mylink
Dim UserTables
dim tablecount
dim deletename
Dim displayArray(100)
dim sqlproc
dim key
dim sqladd
Dim howmanyrecs
dim idvalue
dim howmanyfields
dim Found, j, currentvalue
dim mysql
Dim Fieldcount
Dim Headnames(6)
Dim ProcType
Dim SortType
Dim Sortfield
Dim SortUpDown,Sortupdownnames(2),Sortupdownvalues(2), Sortupdowncount
Dim Fieldnames, fieldtypes, Fieldnamecount
Dim DisplayFields, displayFieldCount, DisplayField
Dim Idfield
Dim SelectField, SelectValue
Dim maxfields, item, dbtable, fieldname
Dim dbc
Dim productcategoryid
dim language
dim Action
dim rowsintable
Dim CurrentCategories(500), currentcategorycount
Dim CurrentSubCategories(500), currentsubcategorycount
Dim rowsize
dim Selectioncritereontext
dim specialsearchcount
dim Specialsearch
Specialsearch="YES"
specialsearchcount=4
'*****************************************************************
' main program logic
' If first time initial table session varaibles
' If button has been pressed, then update table
' Otherwise display the form
'*****************************************************************
if request.form("advanced") > "" then
if request.form("advanced") <> getsess("advanced") then
setsess "advanced", request.form("advanced")
responseredirect "shopa_editdisplaybulk.asp?page="&GetSess("pagenumberaddproduct")&"&table=" & dbtable
end if
end if
SetSess "CurrentURL","shopa_editdisplaybulk.asp"
AdminPageHeader ' normal page header
GetTableName ' find out what table we are using
Setupresponders
if dbtable<>"" then
EditOpenDatabase dbc,database,dbtable ' open database
InitializeEnvironment ' set-up all global data
action=Request("Update")
If action="" then
action=request("Update.x")
end if
If action<>"" then
Updatetable ' update table
end if
GenerateSearchHeader
GenerateDisplayHeaderFlat
GenerateDisplayBodyHeader
DisplayForm ' just display the table
GenerateDisplayBodyFooter
GetHelp
end if
adminpagetrailer
shopclosedatabase dbc
'********************************************************************
' if going to next page then most of things are already set-up
'********************************************************************
sub InitializeEnvironment
mypage = Request("page") ' are we going from page to page
if mypage="" then
Getdatabasefieldnames ' get database field names and types
GetDisplayfields
else
'VP-ASP 6.09 - Precautionary Security Fix
if mypage > "" then
If not isnumeric(mypage) then
shoperror "Page size must be numeric"
end if
end if
end if
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
' see which types processed or unprocessed
SortUpdown=request("SortUpdown")
If SortUpdown="" then
sortupdown="DESC"
end if
' If first time through then
if mypage="" then
mypage=1
GenerateSQL
else
Mysql=Getsess("bulksqlquery")
Fieldnamecount=GetSess("bulkFieldcount")
fieldcount=fieldnamecount
Fieldnames=GetsessA("bulkFieldnames")
Fieldtypes=GetsessA("bulkFieldtypes")
sortfield=GetSess("bulksortfield")
'VP-ASP 6.5
sortupdown=GetSess("sortupdown")
IDfield=GetSess("bulkIDfield")
productcategoryid=GetSess("bulkproductcategoryid")
language=Getsess("bulkeditlanguage")
dbtable=GetSess("bulktable")
DisplayFields=GetSessA("bulkDisplayFields")
DisplayFieldCount=GetSess("bulkDisplayFieldCount")
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")
'maxrecs=getconfig("xeditdisplaymaxrecords")
mypagesize=maxrecs
SetUpDown
maxfields=maximumnumberoffields ' maximum number of fields
SAveDisplayDetails ' set up any display details
arrayfields=displayfields
end sub
'*************************************************************************
' need to get all the fieldnames and all the field types for this table
'*************************************************************************
Sub GetdatabaseFieldNames
dim textfieldtype, fsql, rs
Fieldnamecount=0
ReDim Fieldnames(300)
redim fieldtypes(300)
FSQL = "SELECT * FROM " & lcase(dbtable)
Set rs = dbc.Execute(fSQL)
For each fldName in rs.Fields
Fieldnames(fieldnamecount)=fldName.Name
Fieldtype=fldName.type
textfieldtype=GetTypeName(fieldtype) ' convert number to text field
fieldtypes(fieldnamecount)=textfieldtype
fieldnamecount=fieldnamecount+1
next
closerecordset rs
Idfield=Fieldnames(0)
SetSessA "Bulkfieldnames",Fieldnames
setsessA "bulkfieldtypes",fieldtypes
setsess "bulkfieldcount",fieldnamecount
setsess "bulkidfield",idfield
DisplayFields=Fieldnames
If fieldnamecount<=maxfields then
Displayfieldcount=fieldnamecount
else
Displayfieldcount=maxfields
end if
SetSessA "BulkDisplayFields",Displayfields
SetSess "BulkDisplayFieldCount",displayfieldCount
fieldcount = fieldnamecount
End Sub
'******************************************************************************
' Converts numeric field type to text
'*****************************************************************************
Function GetTypeName(id)
Select Case id
Case "3","2"
GetTypeName = "Number"
Case "200","129"
GetTypeName = "Text"
Case "129"
GetTypeName = "Text"
Case "201","203"
GetTypeName = "Memo"
Case "6"
GetTypeName = "Currency"
Case "11"
GetTypeName = "YesNo"
Case "4","5"
GetTypeName = "Number"
Case "7", "133","134","135"
GetTypeName = "DateTime"
Case Else
GetTypeName = "Text"
End Select
End Function
Sub SetUpDown
Sortupdownnames(0)=getlang("langAscending")
Sortupdownnames(1)=getlang("langDescending")
Sortupdownvalues(0)="ASC"
Sortupdownvalues(1)="DESC"
SortUpDowncount=2
end sub
'***************************************************************
' not every admin can reference every table
Sub ValidateTable
'********************************************
'See if user has access to this table
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
'************************************************************************
' save session variables
'***********************************************************************
sub SAveDisplaydetails()
If DisplayFieldcount> 0 then
howmanyfields=DisplayFieldCount-1
ArrayFields=DisplayFields
else
howmanyfields=fieldnamecount-1
ArrayFields=Fieldnames
end if
if howmanyfields > maxfields then
howmanyfields = maxfields
end if
If getconfig("xdebug")="Yes" then
debugwrite "howmanyfields=" & howmanyfields & " displayfieldcount=" & displayfieldcount
End If
end sub
Sub DisplayForm
'******************************************************************************
' displays the form by
' display navigation Header
' Open recordset
' display page navigation
' Close recordset
'*****************************************************************************
ShopopenRecordSet mysql, rstemp, mypagesize, mypage
GenerateTable ' write the tabe
closerecordset rstemp
end sub
'*************************************************************************
' find out what table we are using and make sure allowed to use it
'*************************************************************************
Sub GetTableName
dbtable=Request("Table")
if dbtable="" then
dbtable=GetSess("bulktable")
else
ValidateTable
end if
if dbtable="" then
shopwriteerror getlang("langEditSelectFail")
exit sub
end if
SetSess "bulktable",dbtable
end sub
'**************************************************************************
' get fields to display
'**************************************************************************
Sub GetDisplayFields
DisplayFieldCount = Request("DisplayFields").Count
If getconfig("xdebug")="Yes" then
Debugwrite "displayfieldcount2=" & DisplayfieldCount
End If
if DisplayfieldCount=0 then
setsess "buldisplayfieldcount",displayfieldcount
exit sub
end if
displayField=Request("DisplayFields")
DisplayFields= Split(DisplayField, ", ", -1, 1)
If lcase(DisplayFields(0))="all" then
Displayfieldcount=0
displayfields=fieldnames
end if
SetSessA "BulkDisplayFields",DisplayFields
SetSess "BulkDisplayfieldcount",displayfieldcount
end sub
'******************************************************************************
' SQL is generated by looking at sort values and selection values
'******************************************************************************
Sub GenerateSQL
dim sqlproc
dim key
dim sqladd
if Request("Selectioncritereontext")<>"" then
if trim(ucase(request("Selectioncritereontext"))) <> trim(ucase(session("bulksqlquery"))) then
mysql=request("Selectioncritereontext")
setsess "bulksqlquery", request("Selectioncritereontext")
exit sub
end if
end if
sqladd=" Where"
MySql = "SELECT * from " & lcase(dbtable)
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
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 "bulksqlquery",MySQL
Setsess "bulksortfield",sortfield
'VP-ASP 6.5
Setsess "sortupdown",sortupdown
If getconfig("xdebug")="Yes" then
debugwrite "generated sql=" & mysql & " "
end if
End sub
Sub GenerateSQL_OLD
sqladd=" Where"
MySql = "SELECT * from " & lcase(dbtable)
if Selectvalue<> "" then
key = SelectValue & "%"
mySQL = MySQL & " where " & SelectField & " like '" & key & "'"
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 "bulksqlquery",MySQL
Setsess "bulksortfield",sortfield
'VP-ASP 6.5
Setsess "sortupdown",sortupdown
If getconfig("xdebug")="Yes" then
debugwrite "generated sql=" & mysql & " "
end if
End sub
'
'***********************************************************************
' there are restricted userids that can only see there own products
'**********************************************************************
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
'***************************************************************************
' generate table in the form of a table with input text boxes/text areas
' arrayfields have the names of fields to display
' idfield is the first field in table
' Put out header column
' For the maximum number of records put out each row
'**************************************************************************
Sub GenerateTable()
dim i, fieldname, fieldtype
arrayfields=displayfields
%>
<%
end sub
'*****************************************************************************
' allow merchnat to select by categories
'****************************************************************************
Sub AddCategories
If lcase(dbtable)<>"products" then exit sub
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"
%>
<%
response.write ""
end sub
'***************************************************************************
' allow merchant to select a subset of the languages
'**************************************************************************
Sub AddLanguages
If lcase(dbtable)<>"languages" then exit sub
Readlanguages languages, langcount,"Yes"
response.write "
<%
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
'*******************************************************************************
' create text or text area for field
'********************************************************************************
Sub reportrow (rstemp,rowname, dbfield, readonly, fieldtype)
dim textarearows, rowsize
rowsize=20
textarearows=5
If fieldtype="Number" or fieldtype="Currency" then
rowsize=5
end if
If fieldtype="Memo" then
rowsize=20
end if
If getconfig("xdebug")="Yes" then
debugwrite "dbfield=" & dbfield & " Fieldtype=" & fieldtype & " rowsize=" & rowsize
End If
tempfield=rstemp(dbfield)
if isnull (tempfield) then
tempfield=""
end if
Handlespecialfields rstemp,rowname,dbfield, rc
if rc=0 then exit sub
%>
<%
tempfield = Replace(tempfield, Chr(34), """)
If readonly="" then
If fieldtype<>"Memo" then
response.write ""
else
response.write ""
end if
else
response.write tempfield & ReportDetailColumnEnd
response.write ""
end if
response.write ReportDetailColumnEnd
end sub
'************************************************************************
'a couple of fields generate dropdown lists and not text boxess
'************************************************************************
Sub HandleSpecialfields (rstemp,rowname, dbfield, rc)
rc=4
select case dbfield
case "subcategoryid"
Handlesubcategoryid rstemp, rowname
rc=0
case "ccategory"
Handleccategory rstemp, rowname
rc=0
end select
end sub
'*************************************************************************
'list every subcategory not used
'************************************************************************
sub HandlesubcategoryidDropdown (rstemp, rowname)
dim catalogid
catalogid=rstemp("catalogid")
GetCurrentSubCategories catalogid
response.write ReportDetailColumn
GenerateSelectTableMULTSUBCAT "categories",rowname,Currentsubcategories,currentsubcategorycount,"","catdescription","categoryid","catdescription"
response.write ReportDetailColumnEnd
end sub
'*************************************************************************
'list every high level category not used
'************************************************************************
Sub HandleccategoryDropdown (rstemp, rowname)
dim catalogid
catalogid=rstemp("catalogid")
GetCurrentCategories catalogid
response.write ReportDetailColumn
GenerateSelectTableMULTCAT "categories",rowname,Currentcategories,currentcategorycount,"","catdescription","categoryid","catdescription"
response.write ReportDetailColumnEnd
end sub
'*************************************************************************
'list every high level category
'************************************************************************
Sub Handleccategory (rstemp, rowname)
dim catalogid, i, catlist
catalogid=rstemp("catalogid")
GetCurrentCategories catalogid
response.write ReportDetailColumn
for i = 0 to currentcategorycount-1
If catlist<>"" then
catlist=catlist & ","
end if
catlist=catlist & currentcategories(i)
next
response.write catlist
response.write ReportDetailColumnEnd
end sub
'*************************************************************************
'list every high level category
'************************************************************************
Sub Handlesubcategoryid (rstemp, rowname)
dim catalogid, i, catlist
catlist=""
catalogid=rstemp("catalogid")
GetCurrentsubCategories catalogid
response.write ReportDetailColumn
if currentsubcategorycount>0 then
for i = 0 to currentsubcategorycount-1
If catlist<>"" then
catlist=catlist & ","
end if
catlist=catlist & currentsubcategories(i)
next
end if
response.write catlist
response.write ReportDetailColumnEnd
end sub
'****************************************************************************
' for each field in table, we create sql and update the database
' each row has there own values.
' The fieldnames are fieldname_row
' need to get real fieldnames and values
' create update sql
' update database
' repeat for all rows
' Products table needs special handling for categories and subcategories
'
'***************************************************************************
Sub Updatetable
if lcase(dbtable)="tbllog" OR lcase(dbtable)="ups_config" then
Shopclosedatabase dbc
shoperror "Editing this table is not allowed."
exit sub
end if
dim rowname, idvalue
rowsintable=request("rowsintable")
for RowCount = 1 to RowsInTable
rowname=idfield & "_" & rowcount ' get form name name
idvalue=request(rowname)
stocksql="update " & dbtable & " "
sqlo=""
for i = 0 to howmanyfields
rowname=ArrayFields(i) & "_" & rowcount ' get form name name
fieldvalue=request(rowname)
fieldname=ArrayFields(i)
Fieldtype=Locatefieldtype(fieldname)
If getconfig("xdebug")="Yes" then
debugwrite "rowname=" & rowname & " fieldname=" & fieldname & " fieldvalue=" & fieldvalue
End If
if fieldname<>idfield then
handleSpecialUpdatefields fieldname, fieldtype, fieldvalue, sqlo, rc
if rc<>0 then
if lcase(fieldname) = "password" then
fieldname = "[password]"
end if
Updatedatabasefield sqlo, fieldname,fieldvalue, fieldtype
end if
end if
'VP-ASP 6.09 - for categories, check if highercategoryid = categoryid
if lcase(dbtable) = "categories" then
if lcase(fieldname) = "highercategoryid" then
if clng(fieldvalue) = clng(idvalue) then
serror=serror & "Higher Category ID is the same as the Category ID for Record #" & idvalue & ". Please change the Higher Category ID for this record. "
end if
end if
end if
next
stocksql=stocksql & sqlo
stocksql=stocksql & " where " & idfield & "=" & idvalue
If getconfig("xdebug")="Yes" then
debugwrite stocksql
End if
If stocksql<>"" then
dbc.execute(stocksql)
end if
next
shopwriteheader getlang("LangProductUpdated") & " " & rowsintable
'VP-ASP 6.09 - for categories, check if highercategoryid = categoryid
if serror > "" then
shopwriteheader serror
end if
end sub
'*********************************************************************************
' ccategory and subcategoryid require updating of prodcategories table
'*********************************************************************************
Sub handleSpecialUpdatefields (fieldname, fieldtype, fieldvalue, sqlo, rc)
rc=4
select case fieldname
case "ccategory"
UpdateCCategory sqlo, fieldvalue
rc=0
case "subcategoryid"
Updatesubcategoryid sqlo, fieldvalue
rc=0
end select
end sub
'
sub Updatedatabasefield (sql, fieldname,fieldvalue, fieldtype)
dim delimiterL, delimiterR
'VP-ASP 6.50 - broadened defintion of IF statement to cover cases where xmysql hasn't been set
if ucase(xdatabasetype) = "MYSQL" OR ucase(xdatabasetype) = "MYSQL351" OR getconfig("xMYSQL")="Yes" then
'VP-ASP 6.50 - these delimiters are no longer required
'delimiterL="["
'delimiterR="]"
delimiterL=""
delimiterR=""
else
delimiterL=""
delimiterR=""
end if
if (fieldvalue="") then
fieldvalue="NULL"
end if
If sql="" then
sql="SET "
else
sql= sql & ","
end if
If fieldvalue="NULL" then
sql=sql & delimiterL & fieldname & delimiterR & "=NULL"
else
fieldvalue = replace(fieldvalue,"'","''")
If getconfig("xdebug")="Yes" then
debugwrite "fieldname=" & fieldname & " fieldvalue+" & fieldvalue
End If
NormalizeFieldvalue fieldname, fieldvalue, fieldtype, newfieldvalue, rc
if rc=0 then
sql=sql & delimiterL & fieldname & delimiterR & "=" & newfieldvalue
end if
end if
end sub
'********************************************************************************
' normalize field value based on type
' may need to add quotes around date or # for dates
'******************************************************************************
SUB NormalizeFieldvalue (fieldname, fieldvalue, fieldtype, newfieldvalue, rc)
rc=0
newfieldvalue=fieldvalue
select case lcase(fieldtype)
case "number"
newfieldvalue=fieldvalue
if not isnumeric(newfieldvalue) then
rc=4
end if
case "currency"
newfieldvalue=fieldvalue
if not IsNumeric(newfieldvalue) then
rc=4
end if
case "text"
newfieldvalue="'" & fieldvalue & "'"
case "memo"
newfieldvalue="'" & fieldvalue & "'"
case "datetime"
newfieldvalue=datedelimit(fieldvalue)
case "yesno"
If fieldvalue="" then
newfieldvalue=0
exit sub
end if
fieldvalue=lcase(fieldvalue)
If fieldvalue="true" or fieldvalue="yes" then
newfieldvalue=1
exit sub
end if
if fieldvalue="false" or fieldvalue="no" then
newfieldvalue="0"
exit sub
end if
If not isnumeric(fieldvalue) then
newfieldvalue=0
end if
case else
newfieldvalue="'" & fieldvalue & "'"
end select
end sub
'**************************************************************************
' a product can be in multiple high level categories
' find out what these are
'************************************************************************
Sub GetCurrentCategories (catalogId)
dim catidrs
CurrentCategoryCount=0
If not isnumeric(catalogId) then exit sub
if catalogid="" then exit sub
strsql="SELECT prodcategories.intcategoryid "
strsql=strsql & " FROM prodcategories, categories "
strsql=strsql & " Where prodcategories.intcategoryid = categories.categoryid "
strsql=strsql & " AND categories.highercategoryid=0 "
strsql=strsql & " AND prodcategories.intcatalogid=" & catalogid
If getconfig("xdebug")="Yes" then
debugwrite strsql
End If
Set catidRs=dbc.execute(strsql)
while not catidrs.eof
CurrentCategories(currentcategorycount)=catidrs("intcategoryid")
Currentcategorycount=currentcategorycount+1
catidrs.movenext
wend
closerecordset catidrs
end sub
Sub GenerateSelectTableMULTCAT (table, selectname, currentvalues, currentvaluecount,FirstField, sortfield, rsfieldname, rsdisplayfield)
%>
"
closerecordset genrs
End Sub
'***************************************************************************
' the category can have multiple values, we need to update
' prod categories table with values
' fieldvalue may be a list, Select or 1 vqalue
' not used or tested
'***************************************************************************
Sub UpdateCCategory(sqlo, fieldvalue)
exit sub
dim cmd, categories, catalogid
dim sql,i
categories=fieldvalue
if categories=getlang("langcommonselect") then exit sub
sql="delete from prodcategories where intcatalogid=" & lngcatalogid
dbc.execute(sql)
Category=Split(Category, ", ")
LngcCategory=category(0)
For i=0 to UBOUND(Category)
sql="insert into prodcategories (intcategoryid,intcatalogid) values (" & category(i) & "," & lngcatalogid & ")"
myconn.execute(sql)
Next
sql="Update products set ccategory=" & lngccategory & " where catalogid=" & lngcatalogid
myconn.execute(sql)
if subcategories="" then exit sub
Category=Split(subcategories, ", ")
LngcCategory=category(0)
For i=0 to UBOUND(Category)
sql="insert into prodcategories (intcategoryid,intcatalogid) values (" & category(i) & "," & lngcatalogid & ")"
myconn.execute(sql)
Next
End Sub
Function Locatefieldtype (fieldname)
dim i
for i = 0 to fieldnamecount-1
if fieldname=fieldnames(i) then
fieldtype=fieldtypes(i)
locatefieldtype=fieldtype
exit function
end if
next
debugwrite "fieldtype not found for " & fieldname
end function
'*****************************************************************
' get subcategories for this product
'******************************************************************
Sub GetCurrentSubCategories (catalogId)
CurrentSubCategoryCount=0
dim catidRS, strsql
If not isnumeric(catalogId) then exit sub
if catalogid="" then exit sub
strsql="SELECT prodcategories.intcategoryid "
strsql=strsql & " FROM prodcategories, categories "
strsql=strsql & " Where prodcategories.intcategoryid = categories.categoryid "
strsql=strsql & " AND categories.highercategoryid<>0 "
strsql=strsql & " AND prodcategories.intcatalogid=" & catalogid
'debugwrite strsql
Set catidRs=dbc.execute(strsql)
do while not catidrs.eof
CurrentsubCategories(currentsubcategorycount)=catidrs("intcategoryid")
Currentsubcategorycount=currentsubcategorycount+1
catidrs.movenext
loop
closerecordset catidrs
If getconfig("xdebug")="Yes" then
Debugwrite "subcatcount=" & currentsubcategorycount
End if
end sub
Sub GenerateSelectTableMULTSUBCAT (table, selectname, currentvalues, currentvaluecount,FirstField, sortfield, rsfieldname, rsdisplayfield)
%>
"
closerecordset genrs
If getconfig("xdebug")="Yes" then
debugwrite gensql
End If
End Sub
Sub Updatesubcategoryid (sqlo, fieldvalue)
' not used or tested
end sub
Sub GenerateSearchHeader
%>
<%end sub
Sub AddHowMany
%>
<%
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
%>
<%=valuearray(i)%>
<%=Selected%>>
<%
Next
%>
<%
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
'VP-ASP 6.50 - replace any quotes in search term with ''
sql = sql & " " & criterion & " Not like '%" & replace(criterionvalue,"'","''") & "%'"
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
sql = sql & " " & prevandor & " " & openbracket & criterion & " like '%" & replace(criterionvalue,"'","''") & "%'" & closebracket & " "
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
'VP-ASP 6.50 - replace any quotes in search term with ''
select case criteriontype
case "equals"
criterionvalue = " like '" & replace(criterionvalue,"'","''") & "' "
case "starts with"
criterionvalue = " like '" & replace(criterionvalue,"'","''") & "%' "
case "contains"
criterionvalue = " like '%" & replace(criterionvalue,"'","''") & "%' "
end select
sql = sql & " " & openbracket & criterion & criterionvalue & closebracket
sqladd="AND"
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
%>
Select <%=i%>
<%
Next
%>
<%
For i = 1 to num
%>
<%Writetableallfields dbtable,i,""%>
<%
Next
%>
<%
For i = 1 to num
%>
" name=criterionvalue<%=i%> size="15">
<%
Next
%>
<%
For i = 1 to num
%>
<%RadioButtons i%>
<%
Next
%>
<%
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
%>