<%
'#################################################################################
'## Copyright (c) 2001 Sean McGivern
'##
'## 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 any later version.
'##
'## All copyright notices regarding smNews must remain intact in the
'## scripts and in the outputted HTML. The "powered by" text with a
'## link back to http://www.tombstone.org.uk/sm/news/ in the footer
'## of the pages MUST remain visible when the pages are viewed on
'## the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful,
'## but WITHOUT ANY WARRANTY; without even the implied warranty of
'## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
'## GNU General Public License for more details.
'##
'## You should have received a copy of the GNU General Public License
'## along with this program; if not, write to the Free Software
'## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
'##
'## Correspondence and Questions can be sent to:
'## sean@tombstone.org.uk
'##
'#################################################################################
Option Explicit
Dim strDatabasePath, cnpath, strLoginPassword, iPageSize, strTableName, strTableNameComment, strTitle
' ****************************************
' CONFIG VARIABLES
' ****************************************
'strDatabasePath = Server.MapPath("/natan19/news/sm.mdb")
'strDatabasePath = Server.MapPath("/news/sm.mdb")
' The physical path to the database for
' this smNews system. To use a virtual
' path, use Server.MapPath. Default is
' Server.MapPath("/fpdb/smnews.mdb")
set strDatabasePath = Server.CreateObject("adodb.connection")
cnpath=server.mappath("/")
cnpath=left(cnpath, len(cnpath)-3) & "dados\release.mdb"
strDatabasePath.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & cnpath
' Set gb_text = Server.CreateObject("ADODB.Recordset")
strLoginPassword = "fati2mile8"
' The admin password for this smNews
' system. Default is "cheese".
iPageSize = 50
' The number of news items to display on
' each page. Default is 10.
strTableName = "News"
' The name of the database table which
' this smNews system will store its news
' items in. Default is "News".
strTableNameComment = "NewsComments"
' The name of the database table which
' this smNews system will store its
' comments in. Default is "NewsComments".
strTitle = "Release da Fatima Guedes"
' The name of your site. Default is
' "smNews BETA 0.2".
' ****************************************
' END OF CONFIG VARIABLES
' ****************************************
Dim objConn
Set objConn = Server.CreateObject("ADODB.Connection")
Dim objRS
Set objRS = Server.CreateObject("ADODB.Recordset")
Dim iAdminFlag, strConnectionString, strRootURL, strSQL, strText, strUserTitle
iAdminFlag = False
strRootURL = LCase(Request.ServerVariables("SCRIPT_NAME"))
strSQL = ""
strText = ""
strUserTitle = Trim(Request.Cookies("smNews")("UserTitle"))
If Trim(Request.Cookies("smNews")("Password")) = strLoginPassword Then
iAdminFlag = True
End If
strConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDatabasePath & ";"
objConn.Open strConnectionString
Const adOpenStatic = 3
Dim qMode, qNewsID
qMode = LCase(Trim(Request.QueryString("mode")))
qNewsID = Trim(Request.QueryString("newsid"))
If qMode = "" Then
qMode = "display"
End If
If qNewsID = "" Then
qNewsID = Null
End If
' strText = strText & "
"
Select Case UCase(qMode)
Case "ADMIN":
Call Admin()
Case "ARCHIVE":
Call Archive()
Case "DELETE":
Call Delete()
Case "DELETECOMMENT":
Call DeleteComment()
Case "DISPLAY":
Call Display()
Case "EDIT":
Call Edit()
Case "EDITCOMMENT":
Call EditComment()
Case "LOGOUT":
Call Logout()
End Select
' ****************************************
' ADMIN
' ****************************************
Sub Admin()
Dim qAction
qAction = LCase(Trim(Request.QueryString("action")))
If iAdminFlag = False And qAction = "login" Then
Dim fLoginPassword, fUserTitle
fLoginPassword = Trim(Request.Form("password"))
fUserTitle = Trim(Request.Form("title"))
If fLoginPassword = strLoginPassword Then
Response.Cookies("smNews")("UserTitle") = fUserTitle
Response.Cookies("smNews")("Password") = fLoginPassword
Response.Cookies("smNews").Expires = Now() + 9999
strText = strText & "
" & vbCrLf
End Sub
' ****************************************
' END OF ADMIN
' ****************************************
' ****************************************
' ARCHIVE
' ****************************************
Sub Archive()
Dim strNewsID, strNewsTitle
' MUDAR ORDEM
'strSQL = "SELECT NewsID, NewsPosted, UserTitle, UserURL, NewsTitle, NewsText FROM " & strTableName & " ORDER BY NewsPosted DESC;" ' novos entram em cima
strSQL = "SELECT NewsID, NewsPosted, UserTitle, UserURL, NewsTitle, NewsText FROM " & strTableName & " ORDER BY NewsPosted;" ' novos entram em baixo
iPageSize = iPageSize * 3
objRS.PageSize = iPageSize
objRS.CacheSize = iPageSize
objRS.Open strSQL, objConn, adOpenStatic
If objRS.EOF Then
Error("No h News para mostrar.")
Exit Sub
End If
Dim qPage, iRecordsShown
qPage = Trim(Request.QueryString("page"))
If qPage = "" Then
qPage = 1
End If
objRS.AbsolutePage = qPage
Do While iRecordsShown < iPageSize And Not objRS.EOF
strNewsID = objRS.Fields("NewsID")
strNewsTitle = objRS.Fields("NewsTitle")
' aqui mesmo, tambm retirei link do titulo que linkava comentarios
'strText = strText & "
"
ElseIf qPage = 1 And iRecordsShown = iPageSize Then
strText = strText & "
"
End If
If iRecordsShown = iPageSize Then
strText = strText & "Next page
"
End If
End Sub
' ****************************************
' END OF ARCHIVE
' ****************************************
' ****************************************
' DELETE
' ****************************************
Sub Delete()
If iAdminFlag = False Then
strText = strText & Error("Acesso negado.")
Exit Sub
End If
If qNewsID = "" Then
strText = strText & Error("No h News especificada.")
Exit Sub
End If
Dim qAction
qAction = LCase(Trim(Request.QueryString("action")))
If qAction = "sql" Then
Dim fNewsID, strSQL, fTool
fNewsID = Trim(Request.Form("newsid"))
fTool = Trim(Request.Form("tool"))
If fNewsID = "" Or fTool = "" Then
strText = strText & Error("Houve um problema no processamento do seu formulrio. Verifique os campos requeridos se esto preenchidos corretamente e tente outra vez.")
Exit Sub
End If
Select Case UCase(fTool)
Case "DELETE":
strSQL = "DELETE FROM " & strTableName & " " &_
"WHERE NewsID = " & fNewsID & ";"
objRS.Open strSQL, objConn
strSQL = "DELETE FROM " & strTableNameComment & " " &_
"WHERE NewsID = " & fNewsID & ";"
objRS.Open strSQL, objConn
strText = strText & Success("A News " & fNewsID & " foi deletada. Voltar administrao.")
Exit Sub
Case "NODELETE":
strText = strText & Success("A News " & fNewsID & " no foi deletada. Voltar administrao.")
Exit Sub
End Select
End If
strText = strText & "
Deletar
" & vbCrLf
strText = strText & "
Tem certeza que deseja este Release " & qNewsID & "? Aps deletar no tem como recuperar.
" & vbCrLf
strText = strText & "" & vbCrLf
End Sub
' ****************************************
' END OF DELETE
' ****************************************
' ****************************************
' DELETECOMMENT
' ****************************************
Sub DeleteComment()
If iAdminFlag = False Then
strText = strText & Error("Access denied.")
Exit Sub
End If
Dim qCommentID
qCommentID = Trim(Request.QueryString("commentid"))
If qCommentID = "" Then
strText = strText & Error("No CommentID specified.")
Exit Sub
End If
Dim qAction
qAction = LCase(Trim(Request.QueryString("action")))
If qAction = "sql" Then
Dim fCommentID, strSQL, fTool
fCommentID = Trim(Request.Form("commentid"))
fTool = Trim(Request.Form("tool"))
If fNewsID = "" Or fTool = "" Then
strText = strText & Error("There was a problem processing the form input. Please check all required fields are correctly filled in and try again.")
Exit Sub
End If
Select Case UCase(fTool)
Case "DELETE":
strSQL = "DELETE FROM " & strTableNameComment & " " &_
"WHERE CommentID = " & fCommentID & ";"
objRS.Open strSQL, objConn
strText = strText & Success("CommentID " & fCommentID & " was deleted.")
Exit Sub
Case "NODELETE":
strText = strText & Success("CommentID " & fCommentID & " was not deleted.")
Exit Sub
End Select
End If
strText = strText & "
Delete
" & vbCrLf
strText = strText & "
Are you absolutely sure you want to delete CommentID " & qCommentID & "? There is no way to get it back once you do this.
" & vbCrLf
strText = strText & "" & vbCrLf
End Sub
' ****************************************
' END OF DELETECOMMENT
' ****************************************
' ****************************************
' DISPLAY
' ****************************************
Sub Display()
Dim strNewsID, strNewsPosted, strUserTitle, strUserURL, strNewsTitle, strNewsText
If qNewsID <> "" Then
strSQL = "SELECT NewsID, NewsPosted, UserTitle, UserURL, NewsTitle, NewsText FROM " & strTableName & " WHERE NewsID = " & qNewsID & ";"
objRS.Open strSQL, objConn, adOpenStatic
strNewsID = objRS.Fields("NewsID")
strNewsPosted = objRS.Fields("NewsPosted")
strUserTitle = objRS.Fields("UserTitle")
strUserURL = objRS.Fields("UserURL")
strNewsTitle = objRS.Fields("NewsTitle")
strNewsText = objRS.Fields("NewsText")
'strText = strText & "
" & strNewsTitle
strText = strText & "" & strNewsTitle
If iAdminFlag Then
strText = strText & " (Editar / Deletar | voltar)"
End If
'strText = strText & "
(Unique ID number for this news item: " & qNewsID & ".)
" & vbCrLf
strText = strText & strNewsText & vbCrLf
Call DisplayComment()
Exit Sub
End If
'strSQL = "SELECT NewsID, NewsPosted, UserTitle, UserURL, NewsTitle, NewsText FROM " & strTableName & " ORDER BY NewsPosted DESC;" ' novos entram em cima
strSQL = "SELECT NewsID, NewsPosted, UserTitle, UserURL, NewsTitle, NewsText FROM " & strTableName & " ORDER BY NewsPosted;" ' novos entram embaixo
objRS.PageSize = iPageSize
objRS.CacheSize = iPageSize
objRS.Open strSQL, objConn, adOpenStatic
If objRS.EOF Then
Error("No h News para mostrar.")
Exit Sub
End If
Dim iRecordsShown
objRS.AbsolutePage = 1
Do While iRecordsShown < iPageSize And Not objRS.EOF
strNewsID = objRS.Fields("NewsID")
strNewsPosted = objRS.Fields("NewsPosted")
strUserTitle = objRS.Fields("UserTitle")
strUserURL = objRS.Fields("UserURL")
strNewsTitle = objRS.Fields("NewsTitle")
strNewsText = objRS.Fields("NewsText")
' A linha abaixo era que estava anteriormente, com link
'strText = strText & "
" & strNewsTitle & ""
' Tamanho da font do titulo
'strText = strText & "" & strNewsTitle & ""
strText = strText & "" & strNewsTitle & ""
If iAdminFlag Then
strText = strText & " (Editar / Deletar | voltar)"
End If
strText = strText & "" '& vbCrLf
' Abaixo eu retirei de quem posta a news
'strText = strText & "
" & vbCrLf
strText = strText & strCommentText
objRS.MoveNext
Loop
Call EditComment()
End Sub
' ****************************************
' END OF DISPLAYCOMMENT
' ****************************************
' ****************************************
' EDIT
' ****************************************
Sub Edit()
If iAdminFlag = False Then
strText = strText & Error("Acesso negado.")
Exit Sub
End If
Dim qAction
qAction = LCase(Trim(Request.QueryString("action")))
If qAction = "sql" Then
Dim fNewsID, fUserURL, fNewsTitle, fNewsText, strSQL
fNewsID = Trim(Request.Form("newsid"))
fUserURL = SQLText(Trim(Request.Form("userurl")))
fNewsTitle = SQLText(Trim(Request.Form("newstitle")))
fNewsText = SQLMemo(Trim(Request.Form("newstext")))
If fUserURL = "" Or fNewsTitle = "" Or fNewsText = "" Then
strText = strText & Error("Houve um problema no processamento do seu formulrio. Verifique os campos requeridos se esto preenchidos corretamente e tente outra vez.")
Exit Sub
End If
If fNewsID <> "" Then
strSQL = "UPDATE " & strTableName & " " &_
"SET UserURL = '" & fUserURL & "', " &_
"NewsTitle = '" & fNewsTitle & "', " &_
"NewsText = '" & fNewsText & "' " &_
"WHERE NewsID = " & fNewsID & ";"
objRS.Open strSQL, objConn
strText = strText & Success("Release atualizada com sucesso. Voltar administrao")
Exit Sub
Else
strSQL = "INSERT INTO " & strTableName & " (NewsPosted, UserTitle, UserURL, NewsTitle, NewsText) " &_
"VALUES (#" & Now() & "#, " &_
"'" & strUserTitle & "', " &_
"'" & fUserURL & "', " &_
"'" & fNewsTitle & "', " &_
"'" & fNewsText & "');"
objRS.Open strSQL, objConn
strText = strText & Success("Release adicionada com sucesso. Voltar administrao")
Exit Sub
End If
End If
Dim strUserURL, strNewsTitle, strNewsText
If qNewsID <> "" Then
strSQL = "SELECT NewsID, NewsPosted, UserTitle, UserURL, NewsTitle, NewsText FROM " & strTableName & " WHERE NewsID = " &qNewsID & ";"
objRS.Open strSQL, objConn, adOpenStatic
strUserURL = FormText(objRS.Fields("UserURL"))
strNewsTitle = FormText(objRS.Fields("NewsTitle"))
strNewsText = FormMemo(objRS.Fields("NewsText"))
Else
strUserURL = Null
strNewsTitle = Null
strNewsText = Null
End If
strText = strText & "
" & vbCrLf
strText = strText & "
Voltar administrao" & vbCrLf
End Sub
' ****************************************
' END OF EDIT
' ****************************************
' ****************************************
' EDITCOMMENT
' ****************************************
Sub EditComment()
Dim qCommentID
qCommentID = Trim(Request.QueryString("commentid"))
If iAdminFlag = False And qCommentID <> "" Then
strText = strText & Error("Access denied.")
Exit Sub
End If
Dim qAction
qAction = LCase(Trim(Request.QueryString("action")))
If qAction = "sql" Then
Dim fCommentID, fUserTitle, fUserURL, fCommentTitle, fCommentText, strSQL
fCommentID = Trim(Request.Form("commentid"))
fUserTitle = SQLText(Trim(Request.Form("usertitle")))
fUserURL = SQLText(Trim(Request.Form("userurl")))
fCommentTitle = SQLText(Trim(Request.Form("commenttitle")))
fCommentText = SQLMemo(Trim(Request.Form("commenttext")))
If fCommentID = "" Or fUserTitle = "" Or fUserURL = "" Or fNewsTitle = "" Or fNewsText = "" Then
strText = strText & Error("There was a problem processing the form input. Please check all required fields are correctly filled in and try again.")
Exit Sub
End If
strSQL = "UPDATE " & strTableNameComment & " " &_
"SET UserTitle = '" & fUserTitle & "', " &_
"UserURL = '" & fUserURL & "', " &_
"CommentTitle = '" & fCommentTitle & "', " &_
"CommentText = '" & fCommentText & "' " &_
"WHERE CommentID = " & fCommentID & ";"
objRS.Open strSQL, objConn
strText = strText & Success("Comment updated successfully.")
Exit Sub
End If
Dim strCommentTitle, strUserTitle, strUserURL, strCommentText
If qCommentID <> "" Then
strSQL = "SELECT CommentID, NewsID, CommentPosted, UserTitle, UserURL, CommentTitle, CommentText FROM " & strTableNameComment & " WHERE CommentID = " & qCommentID & ";"
objRS.Open strSQL, objConn, adOpenStatic
strUserTitle = FormText(objRS.Fields("UserTitle"))
strUserURL = FormText(objRS.Fields("UserURL"))
strCommentTitle = FormText(objRS.Fields("CommentTitle"))
strCommentText = FormMemo(objRS.Fields("CommentText"))
Else
strUserTitle = Null
strUserURL = Null
strCommentTitle = Null
strCommentText = Null
End If
strText = strText & "
" & vbCrLf
End Sub
' ****************************************
' END OF EDITCOMMENT
' ****************************************
' ****************************************
' END OF LOGOUT
' ****************************************
Sub Logout()
Response.Cookies("smNews")("UserTitle") = ""
Response.Cookies("smNews")("Password") = ""
Response.Cookies("smNews").Expires = Now()
strText = strText & "
Sair da administrao do Release da Fatima Guedes
" & vbCrLf
strText = strText & Success("Sada concluida com sucesso! Clique aqui para ver a " & strTitle & ". O layout apresentado a seguir diferente do site OK. somente para visualizao. Voc tambm pode ver direto no site, s atualizar a home.") & vbCrLf
End Sub
' ****************************************
' END OF LOGOUT
' ****************************************
' ****************************************
' FUNCTIONS
' ****************************************
Function Error(strErrorMessage)
Error = "
" & strErrorMessage & "
"
End Function
' Formats errors in a nice way.
Function FormMemo(strFormMemo)
If strFormMemo <> "" Then
strFormMemo = Replace(strFormMemo, "''", "'")
strFormMemo = Replace(strFormMemo, "
", "")
FormMemo = strFormMemo
End If
End Function
' Formats a memo field from the database
' for use in a form field.
Function FormText(strFormText)
If strFormText <> "" Then
strFormText = Replace(strFormText, "''", "'")
strFormText = Replace(strFormText, "<", "<")
strFormText = Replace(strFormText, ">", ">")
FormText = strFormText
End If
End Function
' Formats a text field from the database for use
' in a form field.
Function Input(strInputType, strInputName, strInputWidth, strInputHeight, strInputValue)
Dim strInput
strInputType = LCase(strInputType)
strInputName = LCase(strInputName)
Select Case UCase(strInputType)
Case "TEXTAREA":
strInput = ""
Case Else:
strInput = " "hidden" And strInputType <> "submit" And strInputType <> "radio" And strInputType <> "checkbox" Then
strInput = strInput & "size=""" & strInputWidth & """ "
End If
If strInputType = "text" Or strInputType = "password" Then
strInput = strInput & "maxlength=""50"" "
End If
If strInputValue <> "" Then
strInput = strInput & "value=""" & strInputValue & """ "
End If
strInput = strInput & "/>"
End Select
Input = strInput
End Function
' Creates a form field.
Function SQLText(strSQLText)
strSQLText = Replace(strSQLText, "'", "''")
strSQLText = Replace(strSQLText, "<", "<")
strSQLText = Replace(strSQLText, ">", ">")
SQLText = strSQLText
End Function
' Formats text for use in UPDATE and
' INSERT INTO statements.
Function SQLMemo(strSQLMemo)
strSQLMemo = Replace(strSQLMemo, "'", "''")
strSQLMemo = Replace(strSQLMemo, Chr(13), "")
strSQLMemo = Replace(strSQLMemo, Chr(10) & Chr(10), "
"
SQLMemo = strSQLMemo
End Function
' Formats textareas for use in UPDATE and
' INSERT INTO statements.
Function Success(strSuccessMessage)
Success = "
" & strSuccessMessage & "
"
End Function
' Formats success messages in a nice way.
' ****************************************
' END OF FUNCTIONS
' ****************************************
' Isto abaixo estava no final da pgina
'strText = strText & "