pagina news con solo banner scorrimento senza dettagli
Autore
Messaggio
lucapuccetti Utente
93 Discussioni
05 luglio 2004 alle 12:52:46 cari amici vi posto una paginamnews modificata che può essere utile. In pratica nella versione originale c'era la lista delle categorie e poi una tabella con top news e poi lo stesso numero di news scelte come top per tutte le categorie o per ogni categoria in pratica se si metteva 30 top news la pagina diventava lunghissima per tutti i dettagli delle singole news. ora con la modifica si ottiene una lista a scorrimento verticale e cliccando sul titolo si ottiene il dettaglio della news praticamente si possono mettere anche 50 news e la pagina rimane comunque assai contenuta in lunghezza. Esiste un solo problema cliccando sulla categoria compare una tabella allineata a destra e questo vorrei che qualcuno mi aiutasse a risolvere questo problemino estetico .
codice :
<% ' ************************************************************************ ' * ASP-Nuke: Free web portal in ASP * ' ************************************************************************ ' * Copyright (c) 2002-2003 by Gaetan Bouveret (webmaster@asp-nuke.com) * ' * http://www.asp-nuke.com * ' * * ' * This program is free software. You can redistribute it and/or modify * ' * it under the terms of the GNU General Public License as published by * ' * the Free Software Foundation; either version 2 of the License, or * ' * (at your option) any later version. * ' * * ' ************************************************************************ %> <% ' Display a news ' IN : iID (int) : news' id (table news, field nID) ' : bFull (boolean) : if news if fully displayed (header + text) ' : bCountIt (boolean) : if it's the first time user read it ' OUT : - Sub DisplayNews(iID, bFull, bCountIt) Dim oCn, oRs, oRs2, rSQL, sURL, tURL, tTemp, iNbWords Dim printell printell =" | <a href=""print.asp?print=news&pID=" & iID & """ target=""_blank""><img src=""" & GLOBAL_SITE_IMAGES_PATH & "print.gif"" align=""absbottom"" onclick="""" alt="""&GetTranslation("LANG_PRINT_NEWS")&""" border=""0""></a>" iID= Replace(iID," ","") iID= Replace(iID,"%20","") iID= Replace(iID,"'","''")
if (not isnumeric (iID)) then iID="1" End if response.write"<a href=""" & GLOBAL_SITE_PATH & "archivionews.asp"" class=""small"">ARCHIVIO</a> <a href=""" & GLOBAL_SITE_PATH & "cercanews.asp"" class=""small"">CERCA NEWS</a>"
Set oCn = DBConnexion(DB_MAIN)
rSQL = "SELECT nID, nTitle, nAuthor, nDate, nHeader, nText, nImage, nURL, nRead, nCategory, cTitle, vCode FROM news, categories, versions WHERE nCategory=cID AND nVersion=vID AND nValid=True AND nID=" & iID
Set oRs = DBRecordSet(oCn, rSQL) If Not oRs.EOF Then Response.Write " <a name=""news_" & oRs("nID") & """></a>" & vbCRLF CreateTopTable "news_" & oRs("nID"), CodeMessage(oRs("nTitle"), False) Response.Write "<span class=""small"">" & Replace(Replace(GetTranslation("LANG_POST_DATE_BY"), "%1%", GetDateLitteralDDMMYYYYHHMMSS(StringToDate(oRs("nDate")))), "%2%", "<a href=""" & GLOBAL_SITE_PATH & GLOBAL_SITE_PROFILE_PAGE & "?id=" & Server.URLEncode(oRs("nAuthor")) & """>" & Server.HTMLEncode(oRs("nAuthor")) & "</a>") Response.Write " " & Server.HTMLEncode(oRs("vCode")) & " - <a href=""" & GLOBAL_SITE_NEWS_PAGE & "?cat=" & oRs("nCategory") & """>" & Server.HTMLEncode(oRs("cTitle")) & "</a>" If oRs("nURL") <> "" Then sURL = Replace(LCase(oRs("nURL")), "http://", "") rSQL = "SELECT uTitle FROM urls WHERE uURL LIKE '%" & SQLEncrypt(sURL) & "%'" Set oRs2 = DBRecordSet(oCn, rSQL) Response.Write "<br>" & GetTranslation("LANG_SOURCE") & " : <a href=""" & GLOBAL_SITE_PATH & GLOBAL_SITE_GOTOURL_PAGE & "?url=http://" & Server.URLEncode(sURL) & """ target=""_blank"">" If Not oRs2.EOF Then Response.Write Server.HTMLEncode(oRs2("uTitle")) Else tURL = Split(sURL, "/") Response.Write Server.HTMLEncode(tURL(0)) End If Response.Write "</a>" & vbCRLF End If Response.Write "</span><br><br>" & vbCRLF
If oRs("nImage") <> "" Then Response.Write "<img src=""" If Left(LCase(oRs("nImage")), 7) <> "http://" Then Response.Write GLOBAL_SITE_IMAGES_NEWS_PATH Response.Write oRs("nImage") & """ align=""left"" border=""0"">" & vbCRLF End If
Response.Write CodeMessage(oRs("nHeader"), False) & vbCRLF If bFull Then Response.Write "<br><br>" & vbCRLF Response.Write CodeMessage(oRs("nText"), False) & vbCRLF
If bCountIt Then rSQL = "UPDATE news SET nRead=" & oRs("nRead")+1 & " WHERE nID=" & iID DBExecute oCn, rSQL End If End If
If bFull Then If bCountIt then CreateBottomTable GetTranslation("LANG_READ") & " : " & oRs("nRead")+1 & " | <a href=""" & GLOBAL_SITE_PATH & "Default.asp"">" & GetTranslation("LANG_BACK") & "</a>" & printell & vbCRLF
End If Else rSQL = "SELECT Count(cID) FROM Comments WHERE cItem=" & iID & " AND cType=" & CATEGORY_TYPE_NEWS & " AND cValid=True" Set oRs2 = DBRecordSet(oCn, rSQL)
tTemp = Split(oRs("nText")) If IsArray(tTemp) Then iNbWords = Ubound(tTemp) + 1 Else iNbWords = 0 End If CreateBottomTable "<a href=""" & GLOBAL_SITE_NEWS_PAGE & "?id=" & iID & """>" & GetTranslation("LANG_COMMENTS") & " : " & oRs2(0) & "</a> | " & GetTranslation("LANG_READ") & " : " & oRs("nRead") & " | <a href=""" & GLOBAL_SITE_PATH & GLOBAL_SITE_NEWS_PAGE & "?id=" & iID & """>" & GetTranslation("LANG_READ_MORE") & "</a> (" & Replace(GetTranslation("LANG_READ_MORE_WORDS"), "%1%", iNbWords) & ")" & vbCRLF End If End If
oCn.Close Set oCn = Nothing Set oRs = Nothing Set oRs2 = Nothing End Sub
' Display all current daily news for a special date ' IN : iID (int) : news' id (table news, field nID) ' : iCategory : news' category (table news, field nCategory) ' : bFull (boolean) : display all news (header + body) if true, just header if false ' OUT : - Sub DisplayNewsDate(dDate, iCategory, bFull) Dim oCn, oRs, oRs2, rSQL, sURL, tURL, iNewsID
Set oCn = DBConnexion(DB_MAIN)
rSQL = "SELECT nID, nTitle, nAuthor, nDate, nHeader, nText, nImage, nURL, nRead, nCategory, cTitle, vCode FROM news, categories, versions WHERE nCategory=cID AND nVersion=vID AND nDate LIKE '" & DateToString(dDate) & "%' AND nValid=True" If sXMLVersion <> "" Then rSQL = rSQL & " AND vCode='" & sXMLVersion & "'"
If iCategory <> "" and iCategory <> 0 Then rSQL = rSQL & " AND nCategory=" & iCategory
Set oRs = DBRecordSet(oCn, rSQL) While Not oRs.EOF iNewsID = oRs("nID") Response.Write " <a name=""news_" & iNewsID & """></a>" & vbCRLF CreateTopTable "news_" & iNewsID, CodeMessage(oRs("nTitle"), False) Response.Write "<span class=""small"">" & Replace(Replace(GetTranslation("LANG_POST_DATE_BY"), "%1%", GetDateLitteralDDMMYYYYHHMMSS(StringToDate(oRs("nDate")))), "%2%", "<a href=""" & GLOBAL_SITE_PATH & GLOBAL_SITE_PROFILE_PAGE & "?id=" & Server.URLEncode(oRs("nAuthor")) & """>" & Server.HTMLEncode(oRs("nAuthor")) & "</a>") Response.Write " " & Server.HTMLEncode(oRs("vCode")) & " - <a href=""" & GLOBAL_SITE_NEWS_PAGE & "?cat=" & oRs("nCategory") & """>" & Server.HTMLEncode(oRs("cTitle")) & "</a>" If oRs("nURL") <> "" Then sURL = Replace(LCase(oRs("nURL")), "http://", "") rSQL = "SELECT uTitle FROM urls WHERE uURL LIKE '%" & SQLEncrypt(sURL) & "%'" Set oRs2 = DBRecordSet(oCn, rSQL) Response.Write "<br>" & GetTranslation("LANG_SOURCE") & " : <a href=""" & GLOBAL_SITE_PATH & GLOBAL_SITE_GOTOURL_PAGE & "?url=http://" & sURL & """ target=_blank>" If Not oRs2.EOF Then Response.Write Server.HTMLEncode(oRs2("uTitle")) Else tURL = Split(sURL, "/") Response.Write Server.HTMLEncode(tURL(0)) End If Response.Write "</a>" & vbCRLF End If Response.Write "</span><br><br>" & vbCRLF
If oRs("nImage") <> "" Then Response.Write "<img src=""" If Left(LCase(oRs("nImage")), 7) <> "http://" Then Response.Write GLOBAL_SITE_IMAGES_NEWS_PATH Response.Write oRs("nImage") & """ align=""left"" border=""0"">" & vbCRLF End If
Response.Write CodeMessage(oRs("nHeader"), False) & vbCRLF If bFull Then Response.Write "<br><br>" & vbCRLF Response.Write CodeMessage(oRs("nText"), False) & vbCRLF
oCn.Close Set oCn = Nothing Set oRs = Nothing End Sub
' Display the top news (for one category) ' IN : iTop (int) : number of results wanted ' IN : iCategory (int) : category's wanted (0 if all) ' OUT : - Sub DisplayTopNews(iTop, iCategory) Dim oCn, oRs, rSQL Dim titreNews, texteNews, dateNews
Set oCn = DBConnexion(DB_MAIN)
rSQL = "SELECT TOP " & iTop & " nID FROM news, versions WHERE nVersion=vID AND (nDate < '" & DateTimeToString(Now()) & "') AND (nValid = True)"
If sXMLVersion <> "" Then rSQL = rSQL & " AND vCode='" & sXMLVersion & "'" If iCategory <> "" and iCategory <> 0 Then rSQL = rSQL & " AND (nCategory=" & iCategory & ")" rSQL = rSQL & " ORDER BY nDate DESC"
Set oRs = DBRecordSet(oCn, rSQL) If Not oRs.EOF Then While Not oRs.EOF DisplayNews oRs(0), False, False oRs.MoveNext WEnd End If
oCn.Close Set oCn = Nothing Set oRs = Nothing End Sub
' Display the top news list (links to news) ' IN : iTop (int) : number of results wanted ' : iCategory (int) : news' category (table news, field nCategory) ' OUT : - Sub DisplayTopNewsLinks(iTop, iCategory) Dim oCn, oRs, rSQL Dim titreNews, texteNews, dateNews, sCategory, sTitleCat
Set oCn = DBConnexion(DB_MAIN) If iCategory <> "" and iCategory <> 0 Then sCategory = "?cat=" & iCategory rSQL = "SELECT cTitle FROM categories WHERE cID=" & iCategory Set oRs = DBRecordSet(oCn, rSQL) If Not oRs.EOF Then sTitleCat = " - " & Server.HTMLEncode(oRs(0)) End If
rSQL = "SELECT TOP " & iTop & " nID, nDate, nTitle FROM news, versions WHERE nVersion=vID AND nDate < '" & DateTimeToString(Now()) & "' AND nValid=1" If sXMLVersion <> "" Then rSQL = rSQL & " AND vCode='" & sXMLVersion & "'" If sCategory <> "" Then rSQL = rSQL & " AND nCategory=" & iCategory rSQL = rSQL & " ORDER BY nDate DESC"
'fine modifica news scroll Else Response.Write GetTranslation("LANG_EMPTY_SECTION") End If CreateBottomTable ""
oCn.Close Set oCn = Nothing Set oRs = Nothing End Sub
' Display the navigation bar for news (previous and next day) ' IN : dDate (datetime) : actual date ' : iCategory (int) : news' category (table news, field nCategory) ' OUT : - Sub DisplayNewsNavigation(dDate, iCategory) Dim oCn, oRs, rSQL, jPrec, jSuiv, X, sCategory
Set oCn = DBConnexion(DB_MAIN)
If iCategory <> "" and iCategory <> 0 Then sCategory = "&cat=" & iCategory
rSQL = "SELECT TOP 1 nDate FROM news, versions WHERE nVersion=vID AND nDate < '" & DateToString(dDate) & "' AND nValid=1" If sXMLVersion <> "" Then rSQL = rSQL & " AND vCode='" & sXMLVersion & "'" If sCategory <> "" Then rSQL = rSQL & " AND nCategory=" & iCategory rSQL = rSQL & " ORDER BY nDate DESC"
Set oRs = DBRecordSet(oCn, rSQL)
If Not oRs.EOF Then jPrec = Left(oRs(0), 8)
rSQL = "SELECT TOP 1 nDate FROM news, versions WHERE nVersion=vID AND nDate > '" & DateToString(DateAdd("d", 1, dDate)) & "' AND nValid=True" If sXMLVersion <> "" Then rSQL = rSQL & " AND vCode='" & sXMLVersion & "'" If sCategory <> "" Then rSQL = rSQL & " AND nCategory=" & iCategory rSQL = rSQL & " ORDER BY nDate" Set oRs = DBRecordSet(oCn, rSQL) If Not oRs.EOF Then jSuiv = Left(oRs(0), 8)
oCn.Close Set oCn = Nothing Set oRs = Nothing End Sub
' Display all news' categories ' IN : iCategoryParent (int) : news' parent category id (table categories, field cParent) ' OUT : - Sub DisplayNewsCategories(iCategoryParent) Dim oCn, oRs, oRs2, rSQL, iLine, iNum response.write"<a href=""" & GLOBAL_SITE_PATH & "archivionews.asp"" class=""small"">ARCHIVIO</a> <a href=""" & GLOBAL_SITE_PATH & "cercanews.asp"" class=""small"">CERCA NEWS</a>"
Set oCn = DBConnexion(DB_MAIN)
If iCategoryParent = "" Then iCategoryParent = 0
If iCategoryParent <> 0 Then rSQL = "SELECT cId, cParent, cTitle, cDescription, cImage FROM categories WHERE cID=" & iCategoryParent Set oRs = DBRecordSet(oCn, rSQL)
If Not oRs.EOF Then CreateTopTable "NewsCategory", CodeMessage(oRs("cTitle"), True) If oRs("cImage") <> "" Then Response.Write "<img src=""" & Server.HTMLEncode(oRs("cImage") & "") & """ border=""0"" align=""left"">" End If Response.Write CodeMessage(oRs("cDescription"), True) Response.Write "<br><br><a href=""" & GLOBAL_SITE_NEWS_PAGE & "?cat=" & oRs("cParent") & """>" & GetTranslation("LANG_BACK") & "</a>" & vbCRLF CreateBottomTable "" End If End If
rSQL = "SELECT DISTINCT cId, cTitle FROM categories, news, versions WHERE cType=" & CATEGORY_TYPE_NEWS & " AND nVersion=vID AND nCategory=cID and cParent=" & iCategoryParent If sXMLVersion <> "" Then rSQL = rSQL & " AND vCode='" & sXMLVersion & "'" rSQL = rSQL & " ORDER BY cTitle" Set oRs = DBRecordSet(oCn, rSQL)
If Not oRs.EOF Then If iCategoryParent = 0 Then CreateTopTable "SearchNewsCategories", GetTranslation("LANG_NEWS") & " - " & GetTranslation("LANG_CATEGORIES") Else CreateTopTable "SearchNewsCategories", GetTranslation("LANG_NEWS") & " - " & GetTranslation("LANG_SUB_CATEGORIES") End If Response.Write GLOBAL_SITE_SUBTABLE & vbCRLF iLine = 1 iNum = 0
While Not oRs.EOF If iNum mod 2 = 0 Then Response.Write " <tr class=""tableline" & iLine & """>" & vbCRLF rSQL = "SELECT Count(nID) FROM news, versions WHERE nVersion=vID AND nValid=True AND nCategory=" & oRs("cID") If sXMLVersion <> "" Then rSQL = rSQL & " AND vCode='" & sXMLVersion & "'" Set oRs2 = DBRecordSet(oCn, rSQL) Response.Write " <td width=""50%""><a href=""" & GLOBAL_SITE_NEWS_PAGE & "?cat=" & oRs("cID") & """>" & Server.HTMLEncode(oRs("cTitle")) & "</a> (" & oRs2(0) & ")</td>" & vbCRLF If iNum mod 2 = 1 Then Response.Write " </tr>" & vbCRLF iLine = 1 + ((iLine-1) XOR 1) End If
iNum = iNum + 1 oRs.MoveNext WEnd If iNum mod 2 = 1 Then Response.Write " <td> </td>" & vbCRLF Response.Write " </tr>" & vbCRLF End If Response.Write "</table>" & vbCRLF CreateBottomTable "" End If
oCn.Close Set oCn = Nothing Set oRs = Nothing Set oRs2 = Nothing End Sub
' Display a line to let users post their news ' IN : iCat : news category ' OUT : - Sub DisplayAddNews(iCat) If sPseudo <> "" Then CreateTable "AddMemberNews", "", "<a href=""" & GLOBAL_SITE_NEWS_PAGE & "?do=new&cat=" & iCat & """>" & GetTranslation("LANG_ADD") & " - " & GetTranslation("LANG_NEWS") & "</a>", "" End If End Sub
' Edit news for members ' IN : sAuthor (string) : username ' : iCat : news category ' OUT : - Sub EditMemberNews(sAuthor, iCat) Dim oCn, oRs, rSQL, X
If iCat = 0 Then iCat = 1
If sAuthor <> "" Then Set oCn = DBConnexion(DB_MAIN)
rSQL = "SELECT cID, cTitle FROM categories WHERE cType=" & CATEGORY_TYPE_NEWS Set oRs = DBRecordSet(oCn, rSQL)
' Get the last date of news from a specific date ' IN : dDate (datetime) : actual date ' OUT : (datetime) : last known news date Function GetLastNewsDate(dDate) Dim oCn, oRs, rSQL
Set oCn = DBConnexion(DB_MAIN)
rSQL = "SELECT TOP 1 nDate FROM news, versions WHERE nVersion=vID AND nDate <= '" & DateToString(dDate) & " 23:59' AND nValid=1" If sXMLVersion <> "" Then rSQL = rSQL & " AND vCode='" & sXMLVersion & "'" rSQL = rSQL & " ORDER BY nDate DESC"
Set oRs = DBRecordSet(oCn, rSQL)
If Not oRs.EOF Then GetLastNewsDate = StringToDate(oRs(0)) Else GetLastNewsDate = Date End If
oCn.Close Set oCn = Nothing Set oRs = Nothing End Function
Sub DoNews() Dim iID
iID = Request.QueryString("id") If iID <> "" Then If Request.Cookies("news_" & iID) = "" Then Response.Cookies("news_" & iID) = "read" Else Response.Cookies("news_" & iID) = "stop" End If End If
If Request.Form("do") = "add" And Request.Form("nTitle") <> "" Then If AddMemberNews(Request.Form("nTitle"), Request.Form("nDate"), Request.Form("nAuthor"), Request.Form("nHeader"), Request.Form("nText"), Request.Form("nImage"), Request.Form("nURL"), Request.Form("nCategory"), Request.Form("nVersion")) Then sInfoPage = GetTranslation("LANG_NEWS") & " - " & GetTranslation("LANG_ADD_SUCCESS") Else sInfoPage = GetTranslation("LANG_NEWS") & " - " & GetTranslation("LANG_ADD_ERROR") End If End If End Sub
Sub DisplayNewsPage() Dim dDatePage, iCat, iNews
iCat = Request.QueryString("cat") If iCat <> "" and IsNumeric(iCat) Then iCat = CInt(iCat) Else iCat = 0 End If iNews = Request.QueryString("id")
If iNews <> "" Then If Request.Cookies("news_" & iNews) = "stop" Then DisplayNews iNews, True, False Else DisplayNews iNews, True, True End If ElseIf Request.QueryString("date") <> "" Then dDatePage = StringToDate(Request.QueryString("date")) DisplayNewsDate(dDatePage), iCat, False 'DisplayNewsNavigation dDatePage, iCat ElseIf Request.QueryString("do") = "new" Then EditMemberNews sPseudo, iCat Else DisplayNewsCategories(iCat) 'DisplayAddNews(iCat) DisplayTopNewsLinks GLOBAL_NEWS_LINKS_TOP, iCat 'DisplayTopNews GLOBAL_NEWS_LINKS_TOP, iCat 'DisplayNewsNavigation Date, iCat End If End Sub %>
saluti Luca
Log in
Cerca
Sostieni AspNuke
Un piccolo gesto per aiutarci a mantenere AspNuke.it online
Promo
MusicWebItalia.it Video Testi Traduzioni Spot Colonne sonore Accordi e Spartiti gratis.
Visitatori
Visitatori Correnti : 261 Membri : 0
Anna
Iscritti
Utenti: 18940
Ultimo iscritto : glauco Lista iscritti Messaggi privati: 3373Commenti: 2210Immagini: 39Downloads: 144Articoli: 49Pagine: 101Siti web: 558Notizie: 180Sondaggi: 11Preferiti: 5685033Post sui forum: 51195Libro degli ospiti: 4Eventi: 7
Anna
Versione stampabile | Questa pagina è stata eseguita in 0,1835938 secondi.
FUNZIONALITA' PERSONALIZZATE
pagina news con solo banner scorrimento senza dettagli
05 luglio 2004 alle 12:52:46 
