<%option explicit%>
<%
ShopCheckAdmin ""
'*******************************
' Version 6.50 Edits translate tables
' currently translateproducts, translatecategories, translatecontent\
' June 1, 2005
' Input parameters
' which= ' specific record in table
' dbtable=translateproducts
' idfield=translateid
' catalogid= specific product
'*******************************
dim Addaction,Updateaction, Deleteaction
dim rstemp
dim which
dim idfield
dim dbtable, conn
dim translatetable
dim languages, langcount, url
dim strlanguage, catalogid
dim helpfile
helpfile="shopa_producthelp.htm"
setsess "currenturl","shopa_edittranslateproducts.asp"
Addaction=Request.form("add")
Updateaction=Request.form("update")
sError=""
Deleteaction=request("delete")
GetInputValues
If DeleteAction<>"" then
DeleteRecord
end if
EditOpenDatabase conn, database,dbtable
If Addaction = "" and Updateaction = "" Then
AdminPageHeader
' FormatEditHelpHeader
SetDefaultvalues
GenerateForm
AdminPageTrailer
Else
AdminPageHeader
' FormatEditHelpHeader
SetDefaultvalues
validatefields
if serror="" then
UpdateRecord
end if
GenerateForm
AdminPageTrailer
end if
Shopclosedatabase conn
'************************
Sub GetInputValues
dim force
' ID, allows editing a record
which=request.querystring("which")
'VP-ASP 6.09 - Precautionary Security Fix
if which > "" then
If not isnumeric(which) then
shoperror "ID must be numeric"
end if
end if
idfield=request.querystring("idfield")
if idfield="" then
idfield="translateid"
end if
dbtable= request.querystring("table")
catalogid = request.querystring("catalogid")
'VP-ASP 6.09 - Precautionary Security Fix
if catalogid > "" then
If not isnumeric(catalogid) then
shoperror "Catalog ID must be numeric"
end if
end if
url=request("url")
if url="" then
url=getsess("currenturl")
end if
ValidateTable
force="Yes"
Getlanguages languages, langcount, force
End Sub
Sub ValidateTable
'See if user has access to this table
Dim UserTables, i, 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=""
shoperror getlang("langEditSelectFail")
end sub
'*******************************************************************************
' Get the specific record and then generate form based on this record
'*******************************************************************************
Sub GenerateForm
dim sqltemp
if which <> "" then
sqltemp="select * from " & dbtable
sqltemp=sqltemp & " where " & idfield & "=" & which
set rstemp=conn.execute(sqltemp)
end if
DisplayForm
if which <> "" then
rstemp.close
set rstemp=nothing
end if
end Sub
Sub DisplayForm()
if which <> "" then
memcdescription=rstemp("cdescription")
strlanguage=rstemp("lang")
if rstemp("catalogid") <> request.querystring("catalogid") then
catalogid = rstemp("catalogid")
else
catalogid = request.querystring("catalogid")
end if
strcname=rstemp("cname")
memexdesc=rstemp("extendeddesc")
end if
%><%
GenerateDisplayBodyFooter
gethelp "translateproducts"
end sub
Sub UpdateRecord
dim sqltemp, rc
'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
MYSQLProcessrecord updateaction, conn, dbtable, idfield, which
exit sub
end if
If updateaction<>"" then
sqltemp="select * from " & dbtable
sqltemp= sqltemp & " where " & idfield & "=" & which
Set rstemp = Server.CreateObject("ADODB.Recordset")
rstemp.open sqltemp, conn, 1, 3
rstemp.Update
else
CheckforDuplicate rc
if rc<>0 then exit sub
Set rstemp = Server.CreateObject("ADODB.Recordset")
rstemp.open dbtable, conn, adOpenKeyset, adLockOptimistic
rstemp.AddNew
end if
GenerateUpdateSQL
which = rstemp(idfield)
rstemp.close
set rstemp=nothing
sError= sError & "
" & getlang("LangEdit03") & ""
end sub
' ******** general Sql
Sub GenerateUpdateSQL()
Dim howmanyfields, fieldname, fieldvalue, fieldtype, i
howmanyfields=rstemp.fields.count -1
rstemp.update
for i=1 to howmanyfields
fieldname = rstemp(i).name
fieldtype=rstemp(i).type
fieldvalue = request.form(fieldname)
EUpdatefield fieldname,fieldvalue
next
rstemp.update
end sub
Sub EUpdateField (fieldname, fieldvalue)
on error resume next
if fieldvalue="" then
rstemp(Fieldname)=NULL
exit sub
end if
if ucase(fieldvalue)="NULL" then
rstemp(Fieldname)=NULL
else
rstemp(Fieldname)=fieldvalue
end if
end sub
'**********************************************************************
' Set default values from parent record
'**********************************************************************
Sub Setdefaultvalues
dim sql, rs
If which<>"" then exit sub
if catalogid="" then exit sub
sql="select * from products where catalogid=" & catalogid
Set rs=conn.execute(sql)
if not rs.eof then
memcdescription=rs("cdescription")
memexdesc=rs("extendeddesc")
strcname=rs("cname")
end if
closerecordset rs
end sub
Sub DeleteRecord
dim myconn, sql, url
EditOpenDatabase myconn, database,dbtable
sql="delete from " & dbtable & " where " & idfield & "=" & which
myconn.execute(sql)
shopclosedatabase myconn
url="shopa_editdisplay.asp?table=" & dbtable
responseredirect url
end sub
'*************************************************************************
' New to find which table and which record
'*************************************************************************
Sub GetFormFields
end sub
Sub GetExistingProduct
dim rs, sql
sql="Select " & realname & " from " & table & " where " & idfield & "=" & recordid
response.flush
set rs=myconn.execute(sql)
if not rs.eof then
textdata=rs(realname)
end if
closerecordset rs
end sub
Sub PCreateRowText (caption, fieldname, fieldvalue, rows, realname)
dim url, htmlurl, linkurl
url="shopa_edittranslate.asp?which=" & which
htmlurl="shopa_htmledit.asp?which=" & which & "&idfield=catalogid&table=products&fieldname=" & realname
htmlurl=htmlurl & "&url=" & server.urlencode(url)
Linkurl="" & "HTML edit" & ""
Response.write tablerow & tablecolumn & caption
response.write tablecolumnend
response.write ""'"
'VPASP 600 - ADD HTML EDITOR
If getconfig("xhtmleditor")="Yes" then
addHTMLEditor fieldname, fieldvalue, "editform"
else
response.write ""
end if
response.write " | "
' FormatEditHelp fieldname, helpfile
response.write ""
end sub
'***************************************************************
' Get languages from language file or array
' Do not include default laqnguage
'*****************************************************************
Sub Getlanguages (languages, langcount, force)
dim cid, name,catSQL,i, conn, defaultlang
dim maxlangs, catrs,mylink
langcount=0
maxlangs=20
defaultlang=lcase(getconfig("xlanguage"))
Redim languages(maxlangs)
ShopOpenDatabase conn
catSQL="SELECT lang from languages GROUP BY lang"
set catrs=conn.execute(catsql)
Do While Not catrs.EOF and langcountdefaultlang then
languages(langcount)=name
langcount=langcount+1
end if
catrs.MoveNext
loop
closerecordset catrs
ShopCloseDatabase conn
end sub
'**************************************************************************
' check catalogid and language match on adding a record
'**************************************************************************
Sub Checkforduplicate (rc)
dim catalogid, strlanguage, rs
rc=0
catalogid=request("catalogid")
strlanguage=request("lang")
sql="select * from " & dbtable & " where lang='"& strlanguage & "'"
sql = sql & " and catalogid=" & catalogid
set rs=conn.execute(sql)
if not rs.eof then
sError= sError & "
" & Getlang("langrecordexists")
rc=4
end if
closerecordset rs
end sub
'*********************************************************************
' need language and categoryid
'********************************************************************
Sub Validatefields
dim strlanguage, rs, categoryid
catalogid=request("catalogid")
strlanguage=request("lang")
if strlanguage=getlang("langcommonselect") then
strlanguage=""
end if
if strlanguage="" then
sError= sError & "
" & getlang("LangLanguage") & " " & getlang("langcustrequired")
end if
if catalogid="" then
sError= sError & "
" & "catalogid " & getlang("langcustrequired")
end if
end sub
%>