" dim message, message2, image if ContentId = "" then dim GetContentSQL, GetContentRS '700 - 2010.05.24 - Enhancement: MsSQL with double bytes (utf8) issues GetContentSQL = "select ContentId from content WHERE MessageType = "& sqlserverprefixn &"'" & tosql(MessageType,"Text") & "'" OpenRecordSet dbc, 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 ContentId=crs("ContentId") GetTemplate crs, Template '2021.01.14: Page Manager/Free text: Enhancement: Added column content dim content_var content_var = "" if not isnull(crs("column_content")) then if trim(crs("column_content")) <> "" then content_var = generate_freetext_columns_byvariable(crs("column_content")) crs("message2") = crs("message2") & content_var end if end if if Template<>"" then dim rc ShopTemplateWrite Template, crs, rc exit sub end if message=TranslateLanguage(dbc, "content", "message","ContentId", ContentId, crs("message")) message2=TranslateLanguage(dbc, "content", "message2","ContentId", ContentId, crs("message2")) image=crs("ContentImage") if isnull(image) then image="" '800 - 2015.07.01 - Page Manager: More Flexibility on templates ShopPageHeader htmlwrite "" '800 - 2015.07.01 - Page Manager: More Flexibility on templates ShopPageTrailer end sub sub GetTemplate (crs, Template) dim dbTemplate, suffix Template=GetTextField("Template") dbTemplate=crs("Template") if Template="" then if not isnull(dbTemplate) then Template=dbTemplate end if end if '800 - 2015.08.10 - Enahncement: To have global template specified for content pages if Template = "" then Template = getconfig("xcontent_templates") end if if Template="" then exit sub suffix=right(Template,3) if lcase(suffix)<>"htm" then Template="" end if end sub sub FormatImage (image) '800 - 2015.07.01 - Page Manager: More Flexibility on templates htmlwrite "" end sub 'get last non hidden news or whatever sub GenerateContentSQL (sql) dim allstr allstr = "*" initial_sql_excluded_field dbc, "content", allstr if ContentId > "" then sql="select "& allstr &" from content where ContentId=" & ContentId else '700 - 2010.05.24 - Enhancement: MsSQL with double bytes (utf8) issues sql="select "& allstr &" from content where MessageType="& sqlserverprefixn &"'" & tosql(MessageType,"Text") & "'" end if sql=sql & " and hide=0 " '700 - 2010.06.09 - Enhancement: Admin user activities, statstic, admin/front contents compatitable with adjustdate and adjusttime dim indatetime indatetime = getnowindate '2020.04.21 - Page/News/Blogs Manager: Better handling on start and end date conditions sql = sql & " and ((cNewsStartDate is null and cNewsEndDate is null) or (cNewsStartDate <= " & DateDelimit(indatetime) & " and cNewsEndDate >= " & DateDelimit(indatetime) & ") or (cNewsStartDate <= " & DateDelimit(indatetime) & " and cNewsEndDate is null) or (cNewsStartDate is null and cNewsEndDate >= " & DateDelimit(indatetime) & ")) " sql = sql & " and (content.contactid = '"& getsess("CustomerID") &"' or content.contactid = '' or content.contactid is null)" sql = sql & GenerateCustomerMatchSQL ("content.contentgroups","content.excontentgroups","content.loggedin","and") if GetConfig("xselectproductsbylanguage")="Yes" and GetSess("language")<>"" then '700 - 2010.05.24 - Enhancement: MsSQL with double bytes (utf8) issues sql=sql & " and (contentlanguage="& sqlserverprefixn &"'" & GetSess("language") & "'" sql=sql & " or contentlanguage is null)" end if '7.01 - 2010.10.05 - To support multistores to contents,blog,news if GetConfig("xproductmatch") = "Yes" then sql = sql & " and " GeneratecontentsProductmatchsql sql end if sql=sql & " order by ContentId desc" end sub '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 '6.50 - check that itemname has data in it before replacing if itemname > "" then workrecord=replace(itemname,"
",CR) workrecord=replace(itemname,"
",CR) end if if GetConfig("xemailRemoveHtml")<>"Yes" then RemoveHtml=workrecord exit function end if pos=1 morefields = True do while morefields = True pos=1 pos = InStr(pos, workrecord, "<") if pos > 0 then endpos = InStr(pos, workrecord, ">") if endpos=0 then morefields=false else length = endpos - pos + 1 token = Mid(workrecord, pos, length) workrecord=replace(workrecord,token,"") end if else morefields=false end if loop RemoveHtml=workrecord end function %>