<%option explicit%> <% ShopCheckAdmin "" '******************************* ' Version 6.50 Edits translate tables ' currently translateproducts, translatecategories, translatecontent ' April 27, 2005 '******************************* 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" 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 UpdateRecord 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") dbtable= request.querystring("table") url=request("url") if url="" then url=getsess("currenturl") end if ValidateTable dim force force="Yes" Getlanguages languages, langcount, force debugwrite "languagecount=" & langcount 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="" 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 debugwrite sqltemp 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") catalogid=rstemp("catalogid") strcname=rstemp("cname") memexdesc=rstemp("extendeddesc") end if response.write "
" 'VPASP 600 - ADD HTML EDITOR AddEditor "editform" shopwriteheader getlang("LangEdit02") shopwriteerror sError response.write "" & getlang("LangCommonEdit") & "  " response.write "" & getlang("LangEditSelectSetup") & "" 'VP-ASP 6.50 - Added buttons to top of page as well as bottom response.write "
" If which<>"" then Response.Write("    ") Response.Write("") Response.Write("  ") response.write "

" else Response.Write("") end if response.write "
" Response.Write TableDef Response.write tablerow & tablecolumn & getlang("LangLanguage") & tablecolumnend & tablecolumn GenerateselectNV languages,strlanguage,"lang",langcount, getlang("Langcommonselect") Response.write Tablecolumnend & TableRowEnd formateditrow "catalogid","catalogid",catalogid PCreateRowText getlang("LangProductName"), "cname", strCname,1,"" PCreateRowText getlang("LangProductDescription"), "cdescription", memcdescription,3,"cdescription" PCreateRowText getlang("LangProductEXtendedDescription"), "extendeddesc", memexdesc,3,"extendeddesc" Response.Write(TableDefEnd) If which<>"" then 'VPASP 600 - HTMLEDITOR If getconfig("xhtmleditor")="Yes" then Response.Write("    ") Response.Write("") else Response.Write("    ") Response.Write("") end if 'VP-ASP 6.50 - Moved Delete button to be on same line as Add and Update Response.Write("  ") response.write "

" else 'VPASP 600 - HTMLEDITOR If getconfig("xhtmleditor")="Yes" then Response.Write("") else Response.Write("") end if end if Response.Write("
") end sub '************ ' Sub UpdateRecord dim sqltemp '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 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 Debugwrite fieldname & "value=" & fieldvalue 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 which<>"" then exit sub sql="select * from translateproducts" Set rs=conn.execute(sql) which=rs(0) 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 debugwrite sql 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 %>