<%'------------------------- verifica autorização ---------------------------------- Response.Expires=-1000 Response.Buffer=True %> <% if session("lingua")="" then er=configuraLinguagem(linguaBase) else er=configuraLinguagem(session("lingua")) end if if session("acesso")="" then vAcesso=1 else vAcesso=session("acesso") end if if request.QueryString("tipo").count>0 then tipo=request.QueryString("tipo") elseif request.form("tipo").count>0 then tipo=request.form("tipo") else tipo="PRV" end if if request.QueryString("forum").count>0 then idforum=request.QueryString("forum") else response.redirect("foruns.asp") end if Dim connection set connection=server.createobject("adodb.connection") connection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(database) '------------------ Cabeçalho da Tabela -----------------------------------%>
     <%=dl.item("titulo")%>
<%'--------- Coluna da direita -----------%>
<%'--------- coluna da esquerda ----------%> <%'--------- FIM coluna da esquerda ------%> <%'------------------- if request.QueryString("action").count>0 then action=request.QueryString("action") Select Case action Case "ver" idr=request.QueryString("id") if session(varSlogin)="true" then sLinkNova=""&dl.item("responder")&"" Else sLinkNova=" " End if%>
<%response.write(dl.item("forum")&": "&TituloForum(idforum))%> <%=dl.item("forum")%> <%=sLinkNova%>
<% VerMensagens Case "responder" if session("nivel")>0 then idr=request.QueryString("idr")%>
<%response.write(dl.item("forum")&": "&TituloForum(idforum))%>   <%=""&dl.item("cancelar")%>
<%'response.write("responder") ColocarMensagem("responder") Response.write("
") VerMensagens else response.redirect("foruns.asp") End If Case "nova" if session("nivel")>0 then idr=0%>
<%response.write(dl.item("forum")&": "&TituloForum(idforum))%>   <%=""&dl.item("cancelar")%>
<%'response.write("responder") ColocarMensagem("nova") Response.write("
") else response.redirect("foruns.asp") End If Case "inserir" if session("nivel")>0 then idr= Request.Form("idr") titulo=Valtexto (request.form("titulo")) texto=Valtexto (request.form("texto")) data=now() login=session("username") nome=session("nome") email=session("email") if request.form("notificar").count>0 then segue=request.form("notificar") else segue=0 end if e=0 if titulo =" " then e=e+1 if texto =" " then e=e+1 if e > 0 then Response.write("
"&dl.item("esqueceuAlgo")&"

")%> <%=dl.item("voltar")%> <%Else ssql="Insert Into mensagens(idforum, idr, titulo, texto, data, login, nome, email, segue)" ssql=ssql&"VALUES(" ssql=ssql& idforum ssql=ssql&", " & idr ssql=ssql&", '" & titulo ssql=ssql&"', '" & texto ssql=ssql&"', '" & data ssql=ssql&"', '" & login ssql=ssql&"', '" & nome ssql=ssql&"', '" & email ssql=ssql&"', " & segue ssql=ssql& ")" 'response.write(ssql) connection.Execute(ssql) if idr=0 then Response.ReDirect "forum.asp?forum="&idforum else NotificaAutor idr,login Response.ReDirect "forum.asp?id="&idr&"&action=ver&forum="&idforum end if End If else response.redirect("foruns.asp") End If Case Else EscreveMensagens End Select Else EscreveMensagens End If connection.close %>
<%=textoRodape%>
<%'-------------------------------------------------------------------------------------------------- function ContaResposta(id) Dim rs ssql="SELECT COUNT(*) as quantas FROM mensagens WHERE idr="&id Set rs = connection.Execute(ssql) ContaResposta=rs("quantas") set rs=Nothing End function function ContaNovaResposta(id, data) a=data ano=datepart("yyyy",a) mes=datepart("m",a) dia=datepart("d",a) data=mes&"/"&dia&"/"&ano 'data formato uk: mm/dd/yyyy Dim rs ssql="SELECT COUNT(*) as quantas FROM mensagens WHERE idr="&id ssql=ssql&" AND (data>#"&DATA&"#)" 'response.Write("
"&ssql) Set rs = connection.Execute(ssql) ContaNovaResposta=rs("quantas") set rs=Nothing End function Sub ShowLogin %>
<%=dl.item("username")%>  
<%=dl.item("password")%>  
  ">
<%End sub %> <% sub EscreveMensagens if session(varSlogin)="true" then sLinkNova=""&dl.item("novaMensagem")&"" Else sLinkNova=" " End if Set rs = connection.Execute("SELECT * FROM mensagens WHERE idForum="&idforum&" AND idr=0")%>
<%response.write(dl.item("forum")&": "&TituloForum(idforum))%> <%=dl.item("foruns")%> <%=sLinkNova%>
<% do until rs.eof if ClasseLista="desc201-1" then ClasseLista="desc2A1-1" Else ClasseLista="desc201-1" End If if isdate(session("last_login")) then lastLogin=session("last_login") sMensagens=dl.item("total")&": "&ContaResposta(rs("id"))&"  " sMensagens=sMensagens&dl.item("novas")&": "&ContaNovaResposta(rs("id"),lastLogin) Else sMensagens=dl.item("total")&": "&ContaResposta(rs("id"))&"  " End If %> <%rs.movenext loop set rs=Nothing %>
  <%=dl.item("autor")%> <%=dl.item("assunto")%> <%=dl.item("data")%> <%=dl.item("respostas")%>
  <%=""& rs("login")& ""%> <%=""& rs("titulo")& ""%> <%=""& rs("data")& ""%> <%=sMensagens%>
<%end sub %> <% sub VerMensagens if isdate(session("last_login")) then lastLogin=session("last_login") sMensagens=dl.item("respostas")&": "&ContaResposta(idr)&"  " sMensagens=sMensagens&dl.item("novas")&": "&ContaNovaResposta(idr,lastLogin) Else sMensagens=dl.item("respostas")&": "&ContaResposta(idr)&"  " End If Set rs = connection.Execute("SELECT * FROM mensagens WHERE id="&idr) if not rs.eof then if isdate(session("last_login")) AND (cdate(rs("data"))>cdate(session("last_login"))) then sNova="! " else sNova="" end if %>
<%=sNova&rs("titulo")%>
<%=replace(rs("texto"), chr(10), "
")%>
<% response.write(dl.item("inseridopor")&": ") if session(varSlogin)="true" then response.write("") response.write(rs("nome")) if session(varSlogin)="true" then response.write("") response.write(" - "&dl.item("data")&": "&rs("data")) if rs("email")<>"" and rs("email")<>" " then response.write("
"&rs("email")&"") end if %>
<%=sMensagens%>

<%=dl.item("respostas")%>:
<%End If Set rs = connection.Execute("SELECT * FROM mensagens WHERE idr="&idr&" ORDER BY id ASC") do until rs.eof if isdate(session("last_login")) AND (cdate(rs("data"))>cdate(session("last_login"))) then sNova="! " else sNova="" end if %>
<%=sNova&rs("titulo")%>
<%=replace(rs("texto"), chr(10), "
")%>
<% response.write(dl.item("inseridopor")&": ") if session(varSlogin)="true" then response.write("") response.write(rs("nome")) if session(varSlogin)="true" then response.write("") response.write(" - "&dl.item("data")&": "&rs("data")) if rs("email")<>"" and rs("email")<>" " then response.write("
"&rs("email")&"") end if %>

<%rs.movenext loop set rs=Nothing %> <%end sub %> <%function TituloForum(idforum) Dim rs ssql="SELECT topico FROM foruns WHERE id="&idforum Set rs = connection.Execute(ssql) if not rs.eof then TituloForum=rs("topico") end if set rs=Nothing end function sub ColocarMensagem(action)%>
<%if action="nova" then%> <%end if%>
<% nome=session("nome") email=session("email") If action="responder" then Set rs = connection.Execute("SELECT * FROM mensagens WHERE id="&idr&" ORDER BY id DESC") if not rs.eof then titulo="Re:"&rs("titulo") End If if not rs.eof then titulo="Re:"&rs("titulo") End If response.write(""&dl.item("responder")&"") Elseif action="nova" then response.write(""&dl.item("novaMensagem")&"") End if%>
<%=dl.item("nome")&": "%> <%=nome%>
<%=dl.item("email")&": "%> <%=email%>
<%=dl.item("assunto")&": "%>
<%=dl.item("mensagem")&": "%>
 
  <%=dl.item("notificar")%>
">
<%end sub Function valTexto(texto) texto=replace(texto,"<","<") texto=replace(texto,">",">") texto=replace(texto,"'", "''") texto=replace(texto,"%", "") if texto="" then texto=" " valTexto=texto End Function %> <%Sub formularioPesquisa response.write(dl.item("pesquisaTxt1"))&":"%>


">
<%End sub Sub NotificaAutor(idr, resplogin) Set rs = connection.Execute("SELECT * FROM mensagens WHERE id="&idr) if not rs.eof then if rs("segue")=1 then titulo=rs("titulo") email=rs("email") nome=rs("nome") '--cria objexto e e inicializa fixos--------------------- textoBase=nome&","&Chr(10)&Chr(10)&dl.item("notificaTxt21") textoBase=textoBase&": "&titulo&Chr(10)&dl.item("notificaTxt22")&": "&resplogin Set Mailer = Server.CreateObject("SMTPsvg.Mailer") Mailer.CharSet = 2 Mailer.FromName = "Forum" Mailer.FromAddress= forumEmail Mailer.RemoteHost = "localhost" Mailer.Subject = titulo '--envia mensagem para o utilizador seleccionado -- Mailer.AddRecipient nome, email Mailer.BodyText = textoBase if Mailer.SendMail then response.write("Enviado
") else Response.Write ("Erro no Envio: " & Mailer.Response&"
") end if Mailer.ClearBodyText Mailer.ClearRecipients Set Mailer=Nothing end if end if set rs=nothing End Sub %>