<%@ Language=VBScript%>
<%Option Explicit%>
<%
dim content
content = destaquesxmlCache()
if content <> "" then
xmlheader()
Response.Write content
end if
function xmlheader()
With Response
.Buffer = True
.Expires = -1000
.AddHeader "pragma", "no-cache"
.ContentType="text/xml; charset=ISO-8859-1"
.Write("")
End With
end function
Function destaquesxmlCache()
dim objDestaques
dim rst
dim xml
dim xslfile
dim IdDestaque
dim xmlfotos
dim rstfotos
dim xmlnoticias
dim rstnoticias
dim IdRefNoticia
dim search
dim enderecorss
dim key
key = IdToKeyUH(c_sCacheFuncUH, "RSS", "")
xml= getCachebyKeyExpires(key)
if XML = "" then
set objDestaques = server.CreateObject("ArdinaUH_bus.clsUHNoticia")
set rst = objDestaques.getLastMessages(CONNECTIONSTRING, 1)
set objDestaques = nothing
search = Request.QueryString("q")
if not rst.eof then
xml = RecordsetToXMLStream(rst)
xml = "" & _
xml & _
""
else
xml = ""
end if
Set rst = Nothing
AddToCacheExpires XML, key, c_cacheExpire
end if
if xml <> "" then
xslfile = c_rootpath & "\styles\rss\rssuh.xsl"
enderecorss = c_enderecowebsite & "rss/rss.asp"
if search <> "" then
enderecorss = c_enderecowebsite & "rss/rss.asp?q=" & search
end if
destaquesxmlCache = merge(xml,xslfile, _
Array("title", "link", "description", "language", "generator", "copyright", "category", "docs", "image_url", "image_title", "image_link", "ttl", "URLRss", "Search"), _
Array(c_nomejornal, c_enderecowebsite, c_nomejornal, "pt-pt", "Ardina.com", "", "Jornais", "", "/images/logo.gif", c_nomejornal, c_enderecowebsite, "60", enderecorss, search))
end if
end Function
Function destaquesxml()
dim objDestaques
dim rst
dim xml
dim xslfile
dim IdDestaque
dim xmlfotos
dim rstfotos
dim xmlnoticias
dim rstnoticias
dim IdRefNoticia
dim search
dim enderecorss
set objDestaques = server.CreateObject("ArdinaUH_bus.clsUHNoticia")
set rst = objDestaques.getLastMessages(CONNECTIONSTRING, 1)
set objDestaques = nothing
search = Request.QueryString("q")
if not rst.eof then
xml = RecordsetToXMLStream(rst)
xml = "" & _
xml & _
""
xslfile = c_rootpath & "\styles\rss\rssuh.xsl"
enderecorss = c_enderecowebsite & "rss/rss.asp"
if search <> "" then
enderecorss = c_enderecowebsite & "rss/rss.asp?q=" & search
end if
destaquesxml = merge(xml,xslfile, _
Array("title", "link", "description", "language", "generator", "copyright", "category", "docs", "image_url", "image_title", "image_link", "ttl", "URLRss", "Search"), _
Array(c_nomejornal, c_enderecowebsite, c_nomejornal, "pt-pt", "Ardina.com", "", "Jornais", "", "/images/logo.gif", c_nomejornal, c_enderecowebsite, "60", enderecorss, search))
end if
Set rst = Nothing
end Function
Function RecordsetToXMLStream(rs) 'As String
Const adPersistXML = 1
Dim stmXML
Set stmXML = server.CreateObject("ADODB.Stream")
If Not rs.EOF Then
rs.Save stmXML, adPersistXML ' needs ADO 2.5
RecordsetToXMLStream = stmXML.ReadText
Else
RecordsetToXMLStream = ""
End If
'Response.Write RecordsetToXMLStream
Set stmXML = Nothing
End Function
%>