<%option explicit%> <% ShopCheckAdmin "" '******************************* ' Version 6.50 Edits translate tables Prodfeatures ' ' June 1, 2005 ' Input parameters ' which= ' specific record in table ' dbtable=translateprodfeatures ' idfield=translateid ' featureid= specific prodfeature '******************************* dim Addaction,Updateaction, Deleteaction dim rstemp dim which dim idfield dim dbtable, conn dim translatetable dim languages, langcount, url dim strlanguage, featurename, featurecaption, featureid dim helpfile setsess "currenturl","shopa_edittranslateprodfeatures.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 SetDefaultvalues GenerateForm AdminPageTrailer Else AdminPageHeader Validatefields If serror="" then UpdateRecord end if GenerateForm AdminPageTrailer end if Shopclosedatabase conn '************************ Sub GetInputValues ' 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") If dbtable="" then dbtable="translateprodfeatures" featureid=request.querystring("id") url=request("url") if url="" then url=getsess("currenturl") end if ValidateTable dim force force="Yes" Getlanguages languages, langcount, force End Sub ' Sub ValidateTable '******************************************** 'See if user has access to this table Dim UserTables, i 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="" 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 featurecaption=rstemp("featurecaption") featurename=rstemp("featurename") strlanguage=rstemp("lang") featureid=rstemp("id") end if %>

<%shopwriteheader "Product Features Setup"%>

<% if which<>"" then response.write "" end if response.write "" if which <> "" then response.write "" end if response.write "" %>


" & getlang("langadminadvanced") & " " & getlang("LangCommonEdit") & "	Back To " & ucase(left(dbtable, 1)) & right(dbtable, len(dbtable) - 1) & "

<%shopwriteerror sError%>

<% response.write "

" GenerateDisplayHeader "Product Feature Translation Information" GenerateDisplayBodyHeader response.write "" Response.write tablerow & tablecolumn & getlang("LangLanguage") & tablecolumnend & tablecolumn GenerateselectNV languages,strlanguage,"lang",langcount, getlang("Langcommonselect") Response.write Tablecolumnend & TableRowEnd formateditrow "Feature id","id",featureid FormatEditRow getlang("LangProductFeature") & " " & getlang("langcommoncaption"),"featurecaption",featurecaption FormatEditRow getlang("LangProductFeature") & " " & getlang("LangCommonName"),"featurename",featurename Response.Write(TableDefEnd) response.write "" If which<>"" then Response.Write(" ") Response.Write("") 'VP-ASP 6.50 - moved delete button to same line as add and update Response.Write(" ") Response.write "

" response.write "

" else Response.Write("") end if Response.Write("") GenerateDisplayBodyFooter gethelp "translateprodfeatures" 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 dim fieldname, fieldvalue, fieldtype dim 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 '********************************************************************** ' Find the first record so rest of code works '********************************************************************** Sub Setdefaultvalues dim sql, rs if featureid="" then exit sub sql="select * from prodfeatures where id=" & featureid Set rs=conn.execute(sql) if not rs.eof then featurecaption=rs("featurecaption") featurename=rs("featurename") end if closerecordset rs end sub Sub DeleteRecord dim myconn EditOpenDatabase myconn, database,dbtable dim sql, url 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 '*************************************************************** ' 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 categoryid and language match on adding a record '************************************************************************** Sub Checkforduplicate (rc) rc=0 dim strlanguage, rs, featureid featureid=request("id") 'VP-ASP 6.09 - Precautionary Security Fix if featureid > "" then If not isnumeric(featureid) then shoperror "Feature ID must be numeric" end if end if strlanguage=request("lang") sql="select * from " & dbtable & " where lang='"& strlanguage & "'" sql = sql & " and id=" & featureid set rs=conn.execute(sql) if not rs.eof then sError= sError & "
" & Getlang("langrecordexists") rc=4 end if closerecordset rs end sub Sub Validatefields dim strlanguage, rs, featureid featureid=request("id") 'VP-ASP 6.09 - Precautionary Security Fix if featureid > "" then If not isnumeric(featureid) then sError= sError & "
" & "Feature ID must be numeric" end if end if strlanguage=request("lang") if strlanguage=getlang("langcommonselect") then strlanguage="" end if if strlanguage="" then sError= sError & "
" & getlang("LangLanguage") & " " & getlang("langcustrequired") end if if featureid="" then sError= sError & "
" & "Featureid " & getlang("langcustrequired") end if end sub %>