<%option explicit%> <% ShopCheckAdmin "shopa_editdisplay.asp" '******************************* ' Version 6.50 Content table editor ' Display fields in one record of one table ' setting field to keyword "NULL" sets field to empty ' April 9, 2004 ' Sept 28, fix Ole error on SQL server ' Dec 4, 2004 Fix content image '******************************* dim Addaction,Updateaction, Deleteaction dim rstemp dim which dim idfield dim dbtable, conn dim helpfile Dim featuretypes(20), yesnos(3), yesnocount, featuretypecount dim strfeaturenum, strfeatureprice, strfeatureid, strfeaturedefault dim strmessage, strmessage2, strmessagetype, strimage, strhide, strloggedin dim strother1, strother2, strother3, strlanguage '========================= 'VP-ASP 600 - insertion of page impressions '12/10/2005 '========================= dim strimpressions '========================= '========================= 'VP-ASP 600 - insertion of date product was added '12/10/2005 '========================= dim datCdateupdated, datCdateadded '========================= 'VP-ASP 6.50 - whether this page is the homepage or not dim strhomepage Dim Novalue, yesvalue 'Language Modification dim strcatlanguage Addaction=Request.form("add") Updateaction=Request.form("update") Deleteaction=request("delete") SetupDefaults GetInputValues If DeleteAction<>"" then DeleteRecord end if sError="" EditOpenDatabase conn, database,dbtable If Addaction = "" and Updateaction = "" Then AdminPageHeader GenerateForm AdminPageTrailer Else AdminPageHeader UpdateRecord GenerateForm AdminPageTrailer end if Shopclosedatabase conn '************************ Sub GetInputValues ' ID, allows editing a record which=request("which") 'VP-ASP 6.09 - Precautionary Security Fix if which > "" then If not isnumeric(which) then shoperror "Content Id must be numeric" end if end if idfield=request("idfield") dbtable= request("table") If idfield="" then dbtable="content" idfield="contentid" end if ValidateTable If dbtable="" then shoperror getlang("LangEditSelectFail") end if 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 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() strhide=yesnos(1) strloggedin=yesnos(1) strhomepage=yesnos(1) if which <> "" then GetFieldvalue "contentid","contentid",strfeatureid getfieldvalue getlang("LangCommontype"),"messagetype",strmessagetype getfieldvalue getlang("LangGiftMessage"),"message",strmessage getfieldvalue getlang("LangGiftMessage") & " 2","message2",strmessage2 getfieldvalue "Hide","hide",strhide getfieldvalue getlang("LangProductImage"),"contentimage",strimage getfieldvalue getlang("LangProductTemplate"),"template",strtemplate getfieldvalue getlang("Langlanguage"),"contentlanguage",strlanguage getfieldvalue getlang("LangOtherfields") & " 1","other1",strother1 getfieldvalue getlang("LangOtherfields") & " 2","other2",strother2 getfieldvalue getlang("LangOtherfields") & " 3","other3",strother3 '========================= 'VP-ASP 600 - insertion of page impressions '12/10/2005 '========================= getfieldvalue "Impressions","impressions",strimpressions if (strimpressions = "") or (isnull(strimpressions)) then strimpressions = 0 end if '========================= '========================= 'VP-ASP 600 - insertion of date product was added '12/10/2005 '========================= getfieldvalue "Date Added","cdateadded",datcdateadded getfieldvalue "Date Updated","cdateupdated",datcdateupdated '========================= getfieldvalue "Logged In","loggedin",strloggedin If strhide="" then strhide=yesnos(1) end if If strloggedin="" then strloggedin=yesnos(1) end if CorrectBooleanProgram strhide ' turn into yes no CorrectBooleanProgram strloggedin ' turn into yes no 'VP-ASP 6.50 - is this page the homepage? getfieldvalue "Homepage","homepage",strhomepage If strhomepage="" then strhomepage=yesnos(1) end if CorrectBooleanProgram strhomepage ' turn into yes no end if %>
<%shopwriteheader "Content 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 "
" 'VPASP 600 - ADD HTML EDITOR AddEditor "editform" GenerateDisplayHeader "Basic Information" GenerateDisplayBodyHeader 'VP-ASP 6.50 - Added buttons to top of page as well as bottom response.write "
" If which<>"" then 'VPASP 600 - HTMLEDITOR If getconfig("xhtmleditor")="Yes" then Response.Write("    ") Response.Write("") else Response.Write("    ") Response.Write("") end if Response.Write("  ") else 'VPASP 600 - HTMLEDITOR If getconfig("xhtmleditor")="Yes" then Response.Write("") else Response.Write("") end if end if response.write "


" response.write "" if which > "" then FormatEditRowStatic "","contentid",strfeatureid end if FormatEditRow getlang("LangCommontype"),"messagetype",strmessagetype 'VP-ASP 6.50 - changed to single line for SEO reasons 'PCreateRowText "Content Header","message",strmessage,10,"message" FormatEditRow "Content Header","message",strmessage' PCreateRowText "Content Body","message2",strmessage2,10,"message2" FeatureRowImage getlang("LangProductImage"),"contentimage",strimage,"contentimage" if strhide="" then strhide=novalue Response.write tablerow & tablecolumn & getlang("LangHideProduct") & tablecolumnend & "") FormatEditRow getlang("LangProductTemplate"),"template",strtemplate FormatEditRow getlang("Langlanguage"),"language",strlanguage FormatEditRow getlang("LangOtherfields") & " 1","other1",strother1 FormatEditRow getlang("LangOtherfields") & " 2","other2",strother2 FormatEditRow getlang("LangOtherfields") & " 2","other3",strother3 if strloggedin="" then strloggedin=novalue Response.write tablerow & tablecolumn & "Only available to registered users" & tablecolumnend & "") '========================= 'VP-ASP 600 - insertion of page impressions '12/10/2005 '========================= if which > "" then FormatEditRowStatic "Impressions","strimpressions",strimpressions if (strimpressions = "") or (isnull(strimpressions)) then strimpressions = 0 end if end if '========================= '========================= 'VP-ASP 600 - insertion of date product was added '12/10/2005 '========================= if which > "" then FormatEditRowStatic "Date Last Updated","datCdateupdated",datCdateupdated FormatEditRowStatic "Date Added","datCdateadded",datCdateadded end if '========================= 'VP-ASP 6.50 - is this page the homepage? if strhomepage="" then strhomepage=novalue Response.write tablerow & tablecolumn & "Use as homepage?" & tablecolumnend & "") Response.Write(TableDefEnd) response.write "
" 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("  ") else 'VPASP 600 - HTMLEDITOR If getconfig("xhtmleditor")="Yes" then Response.Write("") else Response.Write("") end if end if response.write "
" AddHiddenFields GenerateDisplayBodyFooter Response.Write("") AddtranslateLinkMenu conn, which, dbtable gethelp "content" end sub '************ ' Sub UpdateRecord 'VP-ASP 6.50 - set all homepage flags to NO if request("homepage") = "Yes" then conn.execute("update content set homepage = NULL") end if 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 Fix sept 28, 2004 for i=1 to howmanyfields fieldname = rstemp(i).name fieldvalue = request.form(fieldname) fieldtype=rstemp(i).type Adjustfieldvalues fieldname, fieldvalue EUpdatefield fieldname,fieldvalue ' debugwrite fieldname & " / " & fieldvalue next rstemp.update end sub Sub EUpdateField (fieldname, fieldvalue) on error resume next '========================= 'VP-ASP 600 - insertion of date product was added '12/10/2005 '========================= if fieldname = "cdateadded" then if fieldvalue = "DONTUPDATE" then exit sub end if end if '========================= '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 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 Sub GetFieldvalue (caption, fieldname, fieldvalue) 'Debugwrite "fieldvalue=" & fieldname fieldvalue=rstemp(fieldname) if isnull(fieldvalue) then fieldvalue="" end if end sub Sub SetupDefaults Yesnos(0)=replace( getlang("langcommonYes")," ","") Yesnos(1)=replace( getlang("LangCommonNo")," ","") yesnocount=2 Yesvalue=yesnos(0) novalue=yesnos(1) end sub Sub Adjustfieldvalues (fieldname, fieldvalue) select case fieldname ' fix boolean values case "hide" If Fieldvalue=yesnos(0) then fieldvalue=1 else fieldvalue=0 end if case "loggedin" If Fieldvalue=yesnos(0) then fieldvalue=1 else fieldvalue=0 end if 'VP-ASP 6.50 - use as homepage? case "homepage" If Fieldvalue=yesnos(0) then fieldvalue=1 else fieldvalue=0 end if '========================= 'VP-ASP 600 - insertion of date product was added '12/10/2005 '========================= case "cdateadded" if which="" then fieldvalue = now() else fieldvalue = "DONTUPDATE" end if case "cdateupdated" fieldvalue = now() '========================= end select end sub Sub AddHiddenFields Formathiddenfield "idfield",idfield Formathiddenfield "which",which Formathiddenfield "table",dbtable end sub Sub FormatHiddenField (fieldname, fieldvalue) response.write "" & vbcrlf end sub Sub FeatureRowImage (caption, fieldname, fieldvalue,dbfield) dim uploadurl dim imageurl imageurl="" uploadurl="" If fieldvalue<>"" then imageurl="" & getlang("langcommonview") & "" end if If Getconfig("xupload")="Yes" then ' if which<>"" then uploadurl="shopa_uploadpop.asp?form=editform&formfield=" & fieldname & "&id=" & which & "&field=" & dbfield & "&table=content&idfield=contentid&url=" & server.urlencode("shopa_editcontent.asp") ' end if end if Response.Write tablerow & tableColumn & caption Response.write tablecolumnend response.write "" response.write "" end sub Sub PCreateRowText (caption, fieldname, fieldvalue, rows, realname) dim url, htmlurl, linkurl url="shopa_editcontent.asp?which=" & which 'htmlurl="shopa_htmledit.asp?which=" & which & "&idfield=contentid&table=content&fieldname=" & realname 'htmlurl=htmlurl & "&url=" & server.urlencode(url) Linkurl="" & "HTML edit" & "" Response.write tablerow & tablecolumn & caption 'If getconfig("xhtmleditor")="Yes" then ' If realname<>"" and which<>"" Then ' Response.write "
" & linkurl ' end if 'end if 'response.write tablecolumnend response.write "" response.write "" end sub '************************************************************************************ ' Link to shopa_translatelist.asp if the product has been added '************************************************************************************ Sub AddtranslateLink If which="" then exit sub if getconfig("xtranslate")<>"Yes" then exit sub response.write "
" response.write "" & getlang("langadminlanguages") & "" end sub %>
" GenerateselectNV YesNos,strhide,"hide",yesnocount, "" response.write ("" GenerateselectNV YesNos,strloggedin,"loggedin",yesnocount, "" response.write ("" GenerateselectNV YesNos,strhomepage,"homepage",yesnocount, "" response.write ("" if uploadurl<>"" then ' Response.write "
" & getlang("langupload") & "

" Response.write " " & getlang("langupload") & "" end if If imageurl<>"" then response.write " " & imageurl end if response.write "
"'" 'VPASP 600 - ADD HTML EDITOR If getconfig("xhtmleditor")="Yes" then addHTMLEditor fieldname, fieldvalue, "editform" else response.write "" end if response.write "