%Option Explicit%> <% '********************************************************************************** ' Version 6.50 Content management ' shopcontent.asp?type=news ' shopcontent.asp?type=news&template=xxx ' Allows you to add content using the content table ' VP-ASP 6.50 June 28, 2004 '********************************************************************************* Dim CatalogId, dbtable, idfield, contentdbc, dbc, crs, contentid Dim messagetype Dim template 'VP-ASP 6.08a - moved down below generate meta tags 'shoppageheader setSess "CurrentURL","shopcontent.asp" messagetype=GetTextfield("type") '-------------------------------------- ' VP-ASP Security Patch - 8 July 2008 '-------------------------------------- contentid = cleanchars(request("contentid")) if contentid > "" then if NOT isnumeric(contentid) then contentid="" shoppageheader HandleError "Content ID must be a numeric value" shoppagetrailer response.end end if end if if messagetype="" and contentid = "" then shoppageheader HandleError getlang("LangRecordNotFound") shoppagetrailer response.end end if shopopendatabase contentdbc WriteImpressions 'VP-ASP 6.08a - Generate Dynamic Meta tags setupdynamiccontent contentdbc, contentid, messagetype shoppageheader generatecontentsql sql 'debugwrite sql OpenRecordSet contentdbc, crs, sql If crs.eof then handleerror getlang("LangRecordNotFound") & " " & messagetype else if crs("loggedin") <> true then Formatcontent crs else if Getsess ("login") > "" then Formatcontent crs else shopwriteerror getlang("langcustadminloginrequired") end if end if end if closerecordset crs shopclosedatabase contentdbc shoppagetrailer '**************************************************** ' write a message '*************************************************** sub handleError (msg) shopwriteError msg end sub ' '*************************************************************** ' Use temaplte or just displaye it '************************************************************** Sub Formatcontent (crs) dim message, message2, image 'message=crs("message") if contentid = "" then dim getcontentsql, getcontentrs getcontentsql = "select contentid from content WHERE messagetype = '" & messagetype & "'" OpenRecordSet contentdbc, getcontentrs, getcontentsql if getcontentrs.eof then shoperrror "There has been an error retrieving the ID for this content." else contentid = getcontentrs("contentid") end if closerecordset getcontentrs end if message=translatelanguage(contentdbc, "content", "message","contentid", contentid, crs("message")) 'message2=crs("message2") message2=translatelanguage(contentdbc, "content", "message2","contentid", contentid, crs("message2")) contentid=crs("contentid") image=crs("contentimage") If isnull(image) then image="" 'VP-ASP 6.09 - Add breadcrumb / VP-ASP 6.50 - added config option to turn breadcrumb on/off if getconfig("xbreadcrumbs") = "Yes" then 'VP-ASP 6.50 - advanced session handling Response.write "
" response.write "" response.write "
" end sub '************************************************************************ ' get last non hidden news or whatever '*********************************************************************** Sub GenerateContentsql (sql) if contentid > "" then sql="select * from content where contentid=" & contentid else sql="select * from content where messagetype='" & messagetype & "'" end if sql=sql & " and hide=0 " If getconfig("xselectproductsbylanguage")="Yes" and getsess("language")<>"" then sql=sql & " and (contentlanguage='" & getsess("language") & "'" sql=sql & " or contentlanguage is null)" end if sql=sql & " order by contentid desc" end sub 'VP-ASP 6.08 - Impressions weren't writing correctly. Sub WriteImpressions contentdbc.execute("UPDATE content SET impressions = 0 WHERE impressions IS NULL") if contentid <> "" then 'increment content impressions contentdbc.execute("UPDATE content SET impressions = impressions + 1 WHERE contentid = " & contentid) Else If messagetype <> "" Then contentdbc.execute("UPDATE content SET impressions = impressions + 1 WHERE messagetype LIKE '" & messagetype &"'") End If End If End Sub 'VP-ASP 6.09 - added function to clean HTML from message to be used in breadcrumb Function Removehtml(itemname, CR) dim workrecord, firstchar, morefields, pos, endpos, length dim token If ucase(Getsess("emailformat"))="HTML" then Removehtml=itemname exit function end if 'VP-ASP 6.50 - check that itemname has data in it before replacing if itemname > "" then workrecord=replace(itemname,"