<%Option Explicit%>
<%
ShopCheckAdmin "shopa_editdisplay.asp"
'*************************************************************
' Version 4.50a
' add a category to the database
' October 16, 2002
'***************************************************************
Dim CategoryCount
Dim Categories
Dim CategoryNums
Dim dbtable
Dim strcatdescription, strcatimage
Dim lnghighercategoryid,strcathassubcategory,strcatextra
Dim strcathide,strcatproductmatch,strcatcustomermatch
dim strcatmemo
'
Dim Actiontype
Dim Which, infomsg
Dim Addaction, updateaction, deleteaction
dbtable="categories"
Dim myconn
sError=""
ShopOpenDatabase myconn
Addaction=Request.form("add")
Updateaction=Request.form("update")
Deleteaction=request("delete")
If DeleteAction<>"" then
DeleteCategory
end if
which=request.querystring("which")
GetCategories
AdminPageHeader
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"
CatGetFieldRequest objrs,strcatextra,"catextra"
CatGetFieldRequest objrs,strcathide,"cathide"
CatGetFieldRequest objrs,strcatproductmatch,"productmatch"
CatGetFieldRequest objrs,strcatcustomermatch,"customermatch"
CatGetFieldRequest objrs,strcatmemo,"catmemo"
end sub
'
Sub ValidateData
sError=""
If strcatdescription = "" Then
sError = sError & LangProductDescription & " " & langcustrequired & " "
end if
If lnghighercategoryid=LangCommonSelect Then
lnghighercategoryid=0
End If
end sub
' ************************
Sub UpdateProduct
If 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 & 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"
CatUpdateField objrs,strcathassubcategory,"hassubcategory"
CatUpdateField objrs,strcatextra,"catextra"
CatUpdateField objrs,strcathide,"cathide"
CatUpdateField objrs,strcatproductmatch,"productmatch"
CatUpdateField objrs,strcatcustomermatch,"customermatch"
CatUpdateField objrs,strcatmemo,"catmemo"
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 & 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
Response.Write("
" & getconfig("xfont") & sError & "
")
if which="" then
Response.Write("")
End Sub
'***********************
Sub GetCategories
' get categories from database and store in array for quicker access
dim sql
dim rsCat
SQL = "SELECT * from categories order by catdescription"
categorycount=0
Set rsCat = myconn.Execute(SQL)
redim Categories(getconfig("xMaxCategories"))
redim CategoryNums(getconfig("xMaxCategories"))
categorycount=0
Do While NOT rscat.EOF
categories(categorycount)= rscat("catdescription") & " [" & rscat("categoryid") & "]"
categorynums(categorycount)= rscat("categoryid")
' Debugwrite categories(categorycount)
categorycount=categorycount+1
rscat.movenext
loop
rscat.close
set rscat=nothing
end sub
Sub RowHeader (Header)
Dim srowColor
srowColor="FFFFFF"
Response.Write("
" & header &"
")
end sub
'
Sub GetProductCategory
' Need to get category number from array for update
Dim CategoryName
Dim i
'locate category in category table
'debugwrite "category count=" & categorycount
for i = 0 to categorycount-1
' debugwrite "searching for " & strcategory & "matching " & categories(i)
if strcategory=categories(i) then
lngCategoryID=categorynums(i)
exit sub
end if
next
lngcCategory=0
Debugwrite "GetProductCategory Failed to find =" & strcategory
end sub
Sub GetExistingProduct
dim getsql
lngcategoryid=getsess("categoryid")
getsql="select * from categories where categoryid=" & lngcategoryid
'debugwrite getsql
Set objRS = myconn.Execute(getsql)
If objRS.EOF Then
catresetfield objrs,lngcategoryid,"categoryid"
catresetfield objrs,strcatdescription,"catdescription"
catresetfield objrs,strcatimage,"catimage"
catresetfield objrs,lnghighercategoryid,"highercategoryid"
catresetfield objrs,strcathassubcategory,"hassubcategory"
catresetfield objrs,strcatextra,"catextra"
catresetfield objrs,strcathide,"cathide"
catresetfield objrs,strcatproductmatch,"productmatch"
catresetfield objrs,strcatcustomermatch,"customermatch"
Else
CatGetField objrs,strcatmemo,"catmemo"
CatGetField objrs,lngcategoryid,"categoryid"
CatGetField objrs,strcatdescription,"catdescription"
CatGetField objrs,strcatimage,"catimage"
CatGetField objrs,lnghighercategoryid,"highercategoryid"
CatGetField objrs,strcathassubcategory,"hassubcategory"
CatGetField objrs,strcatextra,"catextra"
CatGetField objrs,strcathide,"cathide"
CatGetField objrs,strcatproductmatch,"productmatch"
CatGetField objrs,strcatcustomermatch,"customermatch"
End If
Closerecordset objRS
End Sub
Sub CatGetField (objrs,fieldvalue,fieldname)
'debugwrite fieldname
If not isnull(objrs(fieldname)) then
fieldvalue=objrs(fieldname)
else
fieldvalue=""
end if
end sub
Sub CatGetFieldRequest (unused, fieldvalue,fieldname)
fieldvalue=request(fieldname)
end sub
Sub CatResetGetField (unused, fieldvalue,fieldname)
fieldvalue=""
end sub
Sub Deletecategory
which=request.querystring("which")
dim sql, url
sql="delete from categories where categoryid=" & which
myconn.execute(sql)
shopclosedatabase myconn
url="shopa_editdisplay.asp?table=categories"
response.redirect url
end sub
Sub CatCreateRowImage (caption, fieldname, fieldvalue,dbfield)
dim uploadurl
dim imageurl
imageurl=""
uploadurl=""
If fieldvalue<>"" then
imageurl="" & langcommonview & ""
end if
If Getconfig("xupload")="Yes" then
if lngcategoryid<>"" then
uploadurl="shopa_upload.asp?id=" & lngcategoryid & "&field=" & dbfield & "&table=categories&idfield=categoryid&url=" & server.urlencode("shopa_addcategory.asp")
end if
end if
Response.Write tablerow & tableColumn & caption
If imageurl<>"" then
response.write " " & imageurl
end if
If uploadurl<>"" then
Response.write " " & langupload & ""
end if
Response.write tablecolumnend
response.write "