% function FormattaLaData(GiornoEsaminato)
' GiornoEsaminato è l'orario base a cui si fa riferimento
'--Data Formattata--
Giorno=Day(GiornoEsaminato)
Mese=Month(GiornoEsaminato)
Anno=Year(GiornoEsaminato)
IF Giorno<10 THEN Giorno="0"&Giorno
IF Mese<10 THEN Mese="0"&Mese
select case Mese
case "01"
Mese="Gennaio"
case "02"
Mese="Febbraio"
case "03"
Mese="Marzo"
case "04"
Mese="Aprile"
case "05"
Mese="Maggio"
case "06"
Mese="Giugno"
case "07"
Mese="Luglio"
case "08"
Mese="Agosto"
case "09"
Mese="Settembre"
case "10"
Mese="Ottobre"
case "11"
Mese="Novembre"
case "12"
Mese="Dicembre"
case else
Mese="...."
end select
DataFormattata=Giorno&" - "&Mese&" - "&Anno
'--Orario Formattato--
Ora=Hour(GiornoEsaminato)
Minuti=Minute(GiornoEsaminato)
Secondi=Second(GiornoEsaminato)
IF Ora<10 THEN Ora="0"&Ora
IF Minuti<10 THEN Minuti="0"&Minuti
IF Secondi<10 THEN Secondi="0"&Secondi
OrarioFormattato=Ora&"."&Minuti&"."&Secondi
'--
IF OrarioFormattato<>"00.00.00" THEN
FormattaLaData=DataFormattata&" ore "&OrarioFormattato
ELSE
FormattaLaData=DataFormattata
END IF
end function
spacer="
"
reqID=request.querystring("ID")
IF reqID="" THEN %>
<% response.end
END IF %>
<% postscelto=request.querystring("ID")
Dim conn
Set conn = Server.CreateObject("ADODB.Connection")
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&PercorsoDatabase1&nome_DB_forum
IF request.querystring("caption")<>"" THEN 'se vengo dal motore di ricerca
'conto il numero di post direttamente dal contatore del messaggio iniziale
SQL_query = "SELECT ReplyCount As TotaleMessaggi FROM FORUM_MESSAGES WHERE ThreadParent=("+request.querystring("ThreadParent")+") and ParentMessage=0"
Set rs = Conn.Execute(SQL_query)
TotaleMessaggi=rs("TotaleMessaggi")
rs.close
set rs=nothing
'--
SQL_query = "SELECT * FROM FORUM_MESSAGES WHERE ID=("+reqID+") ORDER BY DatePosted"
ELSE
'conto il numero di post per trovare gli ultimi
SQL_query = "SELECT COUNT(*) As TotaleMessaggi FROM FORUM_MESSAGES WHERE ThreadParent=("+postscelto+")"
Set rs = Conn.Execute(SQL_query)
TotaleMessaggi=rs("TotaleMessaggi")
rs.close
set rs=nothing
'--
SQL_query = "SELECT ID As idultimo FROM FORUM_MESSAGES WHERE ThreadParent=("+postscelto+") ORDER BY DatePosted DESC"
Set rs = Conn.Execute(SQL_query)
idultimo=rs("idultimo")
rs.close
set rs=nothing
'fine conta numero post per trovare gli ultimi
SQL_query = "SELECT * FROM FORUM_MESSAGES WHERE ThreadParent=("+postscelto+") ORDER BY DatePosted"
END IF
Set rs = Conn.Execute(SQL_query)
fondo1="bgcolor=#F0F0F0"
DBtopic=rs("Topic")
DBtopicKey=Replace(DBtopic," ",",")
DBtopicKey=Replace(DBtopicKey,"%","")
DBtopicKey=Replace(DBtopicKey,chr("34"),"") ' ""
DBtopicKey=Replace(DBtopicKey,chr("39"),"") ' '
DBtopicKey=Replace(DBtopicKey,chr("60"),"") ' <
DBtopicKey=Replace(DBtopicKey,chr("62"),"") ' >
DBtopicKey=Replace(DBtopicKey,chr("37"),"") ' %
%>
<%=DBtopic%>
<% ChiavePersonalizzata="on" %>
<% contatore=1
while NOT rs.EOF %>
<%
IF (contatore/2)=int(contatore/2) THEN
colorefondo="bgcolor=#F0F0F0"
ELSE
colorefondo="bgcolor=#F0F0F0"
END IF
fondox=fondox&"$"&colorefondo
DBblocco=DBblocco&"$"&rs("blocco")
DBID=DBID&"$"&rs("ID")
DBcont=DBcont&"$"&contatore
DBdata=DBdata&"$"&rs("DatePosted")
DBemoticon=DBemoticon&"$"&rs("emoticons")
DBmessaggio=DBmessaggio&"$"&rs("comments")
DBAuthorName=DBAuthorName&"$"&rs("AuthorName")
DBthreadparent=DBthreadparent&"$"&rs("ThreadParent")
DBAuthorID=DBAuthorID&"$"&rs("AuthorID")
contatore=contatore+1
rs.movenext
WEND
arrfondox=split(fondox,"$")
arrblocco=split(DBblocco,"$")
arrID=split(DBID,"$")
arrcont=split(DBcont,"$")
arrdata=split(DBdata,"$")
arremoticon=split(DBemoticon,"$")
arrmessaggio=split(DBmessaggio,"$")
arrAuthorName=split(DBAuthorName,"$")
arrthreadparent=split(DBthreadparent,"$")
arrauthorid=split(DBAuthorID,"$")
%>
<%
DBtopicTXT=LCase(DBtopic)
L_DBtopicTXT=Len(DBtopicTXT)
%><% IF L_DBtopicTXT<24 THEN %>
<% for i=LBound(arrID)+1 to UBound(arrID) %>
<%
'--condizione blocco reply per censura primo messaggio
controllo_primo_messaggio=arrblocco(1) 'ricavo lo stato di censura del primo messaggio
IF controllo_primo_messaggio="S" THEN thread_bloccato="si"
'response.write
'il "si" serve per bloccare i reply
'--fine condizione blocco reply per censura prima messaggio
comments=arrmessaggio(i)
'se includo il replace testo origino la possibilità di tag html
sMsg = comments
'qui sotto rimpiazzo i codici con le emoticons
sMsg=HTMLFORMATico(sMsg) ' se si arriva dal motore di ricerca
chiave=request.querystring("chiave")
IF request.querystring("caption")<>"" THEN
sMsg = replace(sMsg, chiave, ""&chiave&"", 1, -1, 1)
END IF
' fine arrivo da motore di ricerca
'--evidenzia i link--
'sMsg=testo da analizzare
KeyStr="http://" 'stringa da analizzare
KeyLocale="scattando" 'condiziona la creazione dei link, se contengono questa stringa vengono creati, altrimenti no.
Separatore=" "
SeparatoreHTML=" "
LunghezzaMaxParola=60
IF instr(sMsg,KeyStr)>0 THEN
sMsg=Replace(sMsg,SeparatoreHTML," "&SeparatoreHTML&" ",1,-1,1) 'se il link è tra i codici gli si mette 2 spazi prima e dopo
ArrLink1=split(SMsg,Separatore)
for L=LBound(ArrLink1) to UBound(ArrLink1)
ParolaCiclo=ArrLink1(L)
'response.write ArrLink1(L)&" "&vbCrLf
IF instr(ParolaCiclo,KeyStr)>0 AND instr(ParolaCiclo,KeyLocale)>0 THEN
ParolaCicloTXT=ParolaCiclo
LParolaCiclo=Len(ParolaCiclo)
IF LparolaCiclo>LunghezzaMaxParola THEN
ParolaCicloTXT=left(ParolaCiclo,LunghezzaMaxParola)
ParolaCicloTXT=ParolaCicloTXT&"..."
END IF
sMsg=Replace(sMsg,ParolaCiclo,""&ParolaCicloTXT&"",1,1,1) 'il secondo 1 indica il numero di volte in cui sostituire, -1 significa "sempre"
END IF
next
END IF
'--/evidenzia i link--
%>