<%Option Explicit%>
<%
ShopCheckAdmin "shopa_editdisplay.asp"
'*************************************************************
' Version 6.50
' add a category to the database or edit/delete cataegory
' July 5, 2005
' May 30, 2005 add translate
' Jan 2, 2006 Fix category display when xaddproductsubcategorybycategory=Yes
'***************************************************************
'Modified - Added the catlanguage field for the category display pages.
' add category template
Dim CategoryCount
Dim Categories
Dim CategoryNums
Dim dbtable
Dim strcatdescription, strcatimage, strimpressions
Dim lnghighercategoryid,strcathassubcategory,strcatextra
'VP-ASP 6.50 - add new category fields
dim strcatextra2,strcatextra3
Dim strcathide,strcatproductmatch,strcatcustomermatch
dim strcattemplate
dim strcatmemo
'dim helpfile
'helpfile="shopa_categoryhelp.htm"
'Language Modification
dim strcatlanguage
Dim YesNos(3), YesNoCount
Yesnos(0)=replace(getlang("langcommonYes")," ","")
Yesnos(1)=replace(getlang("langCommonNo")," ","")
Dim Novalue, yesvalue
Yesvalue=yesnos(0)
novalue=yesnos(1)
Yesnocount=2
'CATEGORY DROPDOWN
dim categoryarray ' xxx by 4 array
dim rsfieldsvalue, displayfieldvalue, highercategoryid, i, display,recordcount,catid,catdescription,loopcount
dim arraysize,strcategorylist,rsfieldvalue
Const dccategoryid = 0 ' categoryid
Const dccatdescription = 1 ' name
Const dccatlinks = 2 ' links
Const dchighercategoryid = 3 ' highercategoryid
const dcnote=4
const dchassubcategory = 5
'
Dim Actiontype
Dim Which, infomsg
Dim Addaction, updateaction, deleteaction
dbtable="categories"
Dim myconn
sError=""
ShopOpenDatabaseP myconn
Addaction=Request.form("add")
Updateaction=Request.form("update")
Deleteaction=request("delete")
If DeleteAction<>"" then
DeleteCategory
end if
which=request("which")
GetCategories
AdminPageHeader
FormatEditHelpHeader
If addaction="" and updateaction="" Then
If which<>"" then
SetSess "categoryid", which
GetExistingProduct
end if
DisplayForm
else
ProcessUserAction
end if
ShopCloseDatabase myconn
AdminPageTrailer
SUB ProcessUserAction
GetFormData ' get fields from form
ValidateData ' make sure we have them all
if sError = "" Then
UpdateProduct
Serror=Infomsg
GetExistingProduct
which=getSess("categoryid")
end if
Displayform
end sub
Sub GetFormData
dim objrs
CatGetFieldRequest objrs,strcatmemo,"catmemo"
CatGetFieldRequest objrs,lngcategoryid,"categoryid"
CatGetFieldRequest objrs,strcatdescription,"catdescription"
CatGetFieldRequest objrs,strcatimage,"catimage"
CatGetFieldRequest objrs,lnghighercategoryid,"highercategoryid"
CatGetFieldRequest objrs,strcathassubcategory,"hassubcategory"
If strcathassubcategory=Novalue then
strcathassubcategory=""
end if
CatGetFieldRequest objrs,strcatextra,"catextra"
'VP-ASP 6.50 - new category fields
CatGetFieldRequest objrs,strcatextra2,"catextra2"
CatGetFieldRequest objrs,strcatextra3,"catextra3"
CatGetFieldRequest objrs,strcathide,"cathide"
If strcathide=Novalue then
strcathide=""
end if
CatGetFieldRequest objrs,strcatproductmatch,"productmatch"
CatGetFieldRequest objrs,strcatcustomermatch,"customermatch"
CatGetFieldRequest objrs,strcatlanguage,"catlanguage"
CatGetFieldRequest objrs,strcattemplate,"catproducttemplate"
CatGetFieldRequest objrs,strimpressions,"impressions"
end sub
'
Sub ValidateData
sError=""
If strcatdescription = "" Then
sError = sError & getlang("LangProductDescription") & " " & getlang("langcustrequired") & " "
end if
If lnghighercategoryid=getlang("LangCommonSelect") Then
lnghighercategoryid=0
End If
end sub
' ************************
Sub UpdateProduct
'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
Mysqlupdatecategory myconn
exit sub
end if
dim sqlo
dim rso
dim filtersql
Set objRS = Server.CreateObject("ADODB.Recordset")
If updateaction<>"" then
filtersql ="select * from categories Where categoryid=" & GetSess("CategoryID")
' debugwrite filtersql
objRS.open filtersql, myconn, adOpenKeyset, adLockOptimistic
objRS.Update
infomsg= strcatdescription & getlang("LangProductUpdated") & " - " & GetSess("CategoryID") & " "
else
objRS.open "categories", myconn, adOpenKeyset, adLockOptimistic
objRS.AddNew
end if
'CatUpdateField objrs,lngcategoryid,"categoryid"
CatUpdateField objrs,strcatdescription,"catdescription"
CatUpdateField objrs,strcatimage,"catimage"
CatUpdateField objrs,lnghighercategoryid,"highercategoryid"
if strcathassubcategory=novalue then
strcathassubcategory=""
end if
if strcathide=novalue then
strcathide=""
end if
CatUpdateField objrs,strcathassubcategory,"hassubcategory"
CatUpdateField objrs,strcatextra,"catextra"
'VP-ASP 6.50 - new category fields
CatUpdateField objrs,strcatextra2,"catextra2"
CatUpdateField objrs,strcatextra3,"catextra3"
CatUpdateField objrs,strcathide,"cathide"
CatUpdateField objrs,strcatproductmatch,"productmatch"
CatUpdateField objrs,strcatcustomermatch,"customermatch"
CatUpdateField objrs,strcatmemo,"catmemo"
CatUpdateField objrs,strcatlanguage,"catlanguage"
CatUpdateField objrs,strcattemplate,"catproducttemplate"
objRS.Update
Closerecordset objrs
If addaction<>"" then
sqlo = "SELECT max(categoryid) FROM categories"
Set rso = myconn.Execute(sqlo)
lngcategoryID = Cint(rso(0))
Setsess "categoryID",rso(0)
which=rso(0)
rso.Close
set rso=nothing
Infomsg= strcatdescription & getlang("LangProductAdded") & " - " & GetSess("categoryID") & " "
end if
End Sub
'
Sub CatUpdateField (objrs, fieldvalue, fieldname)
if getconfig("xdebug")="Yes" then
debugwrite fieldname & "=" & fieldvalue
else
on error resume next
end if
if fieldvalue="" then
objRS(Fieldname)=NULL
exit sub
end if
'Debugwrite fieldname & "value=" & fieldvalue
if ucase(fieldvalue)="NULL" then
objRS(Fieldname)=NULL
else
objRS(Fieldname)=fieldvalue
end if
end sub
Sub DisplayForm
%>
