Ir para conteúdo
Fórum Script Brasil
  • 0

Cristiano 123

Cristiano123

Perguntado por Cristiano123,

 Share

Pergunta

Cristiano123

Cristiano123

Postado
Postado

Está saindo assim...

Cadastrada 04/09/15 por jm. A data real é 15 de setembro de 2004 então seria 15/09/04...

...não estou conseguindo achar como eu volto a data para a forma certa.

tem uma variaval chamada srtnewposted que recebe o newposted (data) quando a noticia é cadastrada... mas na hora de mostra-la tá mostrando errada.....

que faço?

Link para o comentário
Compartilhar em outros sites

6 respostass a esta questão

Posts Recomendados

  • 0
dark0

dark0

Postado
Postado

poste seu codigo aqui, pra gente ver..

Link para o comentário
Compartilhar em outros sites
  • 0
Cristiano123

Cristiano123

Postado
  • Autor
Postado

é mais ou menos assim...

Do While iRecordsShown < iPageSize And Not objRS.EOF

strNewsID = objRS.Fields("NewsID")

strNewsTitle = objRS.Fields("NewsTitle")

strnewsposted=objRS.Fields("Newsposted")

'onde newsposted é a data no banco

strText = strText & "<div><a href=""" & strRootURL & "?newsid=" & strNewsID & """>" & strNewsTitle & " </a> " & FormatDateTime(strNewsPosted, 2) & ""

If iAdminFlag Then

strText = strText & "&nbsp;(<a href=""" & strRootURL & "?mode=edit&newsid=" & strNewsID & """>Edit</a>/<a href=""" & strRootURL & "?mode=delete&newsid=" & strNewsID & """>Delete</a>)"

End If

strText = strText & "</div>" & vbCrLf

iRecordsShown = iRecordsShown + 1

objRS.MoveNext

Loop

If qPage > 1 And iRecordsShown = iPageSize Then

strText = strText & "<div align=""right""><a href=""" & strRootURL & "?mode=archive&page=" & qPage - 1 & """>Previous page</a>&nbsp;|&nbsp;"

ElseIf qPage > 1 And iRecordsShown < iPageSize Then

strText = strText & "<div align=""right""><a href=""" & strRootURL & "?mode=archive&page=" & qPage - 1 & """>Previous page</a></div>"

ElseIf qPage = 1 And iRecordsShown = iPageSize Then

strText = strText & "<div align=""right"">"

End If

If iRecordsShown = iPageSize Then

strText = strText & "<a href=""" & strRootURL & "?mode=archive&page=" & qPage + 1 & """>Next page</a></div>"

End If

End Sub

' ****************************************

' END OF ARCHIVE

Link para o comentário
Compartilhar em outros sites
  • 0
Cristiano123

Cristiano123

Postado
  • Autor
Postado

To mexendo em um banco de noticias e offline tá tudo funcionando, mas online quando eu logo e cadastro uma nova noticia ele dá erro na linha , nesta parte abaixo:

strSQL = "INSERT INTO " & strTableName & " (NewsPosted, UserTitle, UserURL, NewsTitle, NewsText) " &_

"VALUES (#" & Now() & "#, " &_

"'" & strUserTitle & "', " &_

"'" & fUserURL & "', " &_

"'" & fNewsTitle & "', " &_

"'" & fNewsText & "');"

objRS.Open strSQL, objConn

a mesma coisa acontece quando eu excluo ou altero a noticia.... porque ofline no meu pc tá tudo ok mas online tá dando pau....? vou por o codigo inteiro aqui em baixo para alguém me ajudar...... e outra coisa é a data que cadastro offline tá vindo como 09/15/2004 e não 15/09/2004....

<%

Option Explicit

Dim strDatabasePath, strLoginPassword, iPageSize, strTableName, strTableNameComment, strTitle

' ****************************************

' CONFIG VARIABLES

' ****************************************

strDatabasePath = Server.MapPath("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")

strLoginPassword = "jmonline123"

' The admin password for this smNews

' system. Default is "cheese".

iPageSize = 10

' 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 = "News JM"

' 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 & "<p align=""center""><a href=""" & strRootURL & """>Principal</a>&nbsp;|&nbsp;<a href=""" & strRootURL & "?mode=admin"">Administrador</a></p>"

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 & "<h2>Você está logado</h2>" & vbCrLf

strText = strText & Success("Logado com sucesso! <a href=""" & strRootURL & "?mode=admin"">Clique aqui</a> para continuar.") & vbCrLf

Exit Sub

Else

strText = strText & "<h2>Senha errada</h2>" & vbCrLf

strText = strText & Error("Senha incorreta. Por favor tente novamente. Clique em administrador") & vbCrLf

Exit Sub

End If

ElseIf iAdminFlag = False Then

strText = strText & "<h2>Acesso</h2>" & vbCrLf

strText = strText & "<form action=""" & strRootURL & "?mode=admin&action=login"" method=""post"">" & vbCrLf

strText = strText & "<div><strong>Nome::</strong>&nbsp;" & Input("text", "title", 10, Null, Null) & "</div>" & vbCrLf

strText = strText & "<div><strong>Senha::</strong>&nbsp;" & Input("password", "password", 10, Null, Null) & "</div>" & vbCrLf

strText = strText & Input("submit", "submit", Null, Null, "Logar") & vbCrLf

strText = strText & "</form>" & vbCrLf

Exit Sub

End If

strText = strText & "<h2>Administrador de notícias do JORNAL DE MONLEVADE</h2>" & vbCrLf

strText = strText & "<div><a href=""" & strRootURL & "?mode=edit"">Nova Noticia</a></div>" & vbCrLf

strText = strText & "<div><a href=""" & strRootURL & "?mode=archive"">Arquivo de noticias</a></div>" & vbCrLf

strText = strText & "<div><a href=""" & strRootURL & "?mode=display"">Noticias correntes</a></div>" & vbCrLf

strText = strText & "<div><a href=""" & strRootURL & "?mode=logout"">Deslogar</a></div>" & vbCrLf

End Sub

' ****************************************

' END OF ADMIN

' ****************************************

' ****************************************

' ARCHIVE

' ****************************************

Sub Archive()

Dim strNewsID, strNewsTitle, strnewsPosted

strSQL = "SELECT NewsID, NewsPosted, UserTitle, UserURL, NewsTitle, NewsText FROM " & strTableName & " ORDER BY NewsPosted DESC;"

iPageSize = iPageSize * 3

objRS.PageSize = iPageSize

objRS.CacheSize = iPageSize

objRS.Open strSQL, objConn, adOpenStatic

If objRS.EOF Then

Error("Não há notícias.")

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")

strnewsposted=objRS.Fields("Newsposted")

strText = strText & "<div><a href=""" & strRootURL & "?newsid=" & strNewsID & """>" & strNewsTitle & " </a> " & FormatDateTime(strNewsPosted, 2) & ""

If iAdminFlag Then

strText = strText & "&nbsp;(<a href=""" & strRootURL & "?mode=edit&newsid=" & strNewsID & """>Edit</a>/<a href=""" & strRootURL & "?mode=delete&newsid=" & strNewsID & """>Delete</a>)"

End If

strText = strText & "</div>" & vbCrLf

iRecordsShown = iRecordsShown + 1

objRS.MoveNext

Loop

If qPage > 1 And iRecordsShown = iPageSize Then

strText = strText & "<div align=""right""><a href=""" & strRootURL & "?mode=archive&page=" & qPage - 1 & """>Previous page</a>&nbsp;|&nbsp;"

ElseIf qPage > 1 And iRecordsShown < iPageSize Then

strText = strText & "<div align=""right""><a href=""" & strRootURL & "?mode=archive&page=" & qPage - 1 & """>Previous page</a></div>"

ElseIf qPage = 1 And iRecordsShown = iPageSize Then

strText = strText & "<div align=""right"">"

End If

If iRecordsShown = iPageSize Then

strText = strText & "<a href=""" & strRootURL & "?mode=archive&page=" & qPage + 1 & """>Next page</a></div>"

End If

End Sub

' ****************************************

' END OF ARCHIVE

' ****************************************

' ****************************************

' DELETE

' ****************************************

Sub Delete()

If iAdminFlag = False Then

strText = strText & Error("Access denied.")

Exit Sub

End If

If qNewsID = "" Then

strText = strText & Error("No NewsID specified.")

Exit Sub

End If

Dim qAction

qAction = LCase(Trim(Request.QueryString("action")))

If qAction = "sql" Then

Dim fNewsID, strSQL, fTool,fUserTitle

fNewsID = Trim(Request.Form("newsid"))

fTool = Trim(Request.Form("tool"))

fUsertitle = Trim(Request.Form("UserTitle"))

If fNewsID = "" Or fTool = "" Then

strText = strText & Error("Ocorreu um problema no cadastro da noticia. Por favor preencha todos os campos requisitados.")

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("Notícia " & fNewsID & " com o título" & fUserTitle & "foi deleteda.")

Exit Sub

Case "NODELETE":

strText = strText & Success("NewsID " & fNewsID & " não foi deletada.")

Exit Sub

End Select

End If

strText = strText & "<h2>Deletar</h2>" & vbCrLf

strText = strText & "<p>Tem certeza que deseja deletar a notícia " & qNewsID & "? <strong>Não há nenhuma maneira de recuperá-la após ser excluída...</strong></p>" & vbCrLf

strText = strText & "<form action=""" & strRootURL & "?mode=delete&action=sql"" method=""post"">" & vbCrLf

strText = strText & Input("hidden", "newsid", Null, Null, qNewsID) & vbCrLf

strText = strText & "<div><strong>Não deletar:</strong>&nbsp;" & Input("radio", "tool", Null, Null, "nodelete") & "</div>" & vbCrLf

strText = strText & "<div><strong>Deletar......:</strong>&nbsp;" & Input("radio", "tool", Null, Null, "delete") & "</div>" & vbCrLf

strText = strText & Input("submit", "submit", Null, Null, " ok ") & vbCrLf

strText = strText & "</form>" & vbCrLf

End Sub

' ****************************************

' END OF DELETE

' ****************************************

' ****************************************

' DELETECOMMENT

' ****************************************

Sub DeleteComment()

If iAdminFlag = False Then

strText = strText & Error("Acesso não autorizado.")

Exit Sub

End If

Dim qCommentID

qCommentID = Trim(Request.QueryString("COMENTÁRIO INSERIDO"))

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("Ocorreu um problema no cadastro do comentário. Por favor preencha todos os campos requisitados.")

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 & " foi deletada.")

Exit Sub

Case "NODELETE":

strText = strText & Success("CommentID " & fCommentID & " não foi deletada.")

Exit Sub

End Select

End If

strText = strText & "<h2>Delete</h2>" & vbCrLf

strText = strText & "<p>Are you absolutely sure you want to delete CommentID " & qCommentID & "? <strong>There is no way to get it back once you do this.</strong></p>" & vbCrLf

strText = strText & "<form action=""" & strRootURL & "?mode=deletecomment&action=sql"" method=""post"">" & vbCrLf

strText = strText & Input("hidden", "commentid", Null, Null, CommentID) & vbCrLf

strText = strText & "<div><strong>Don't delete:</strong>&nbsp;" & Input("radio", "tool", Null, Null, "nodelete") & "</div>" & vbCrLf

strText = strText & "<div><strong>Delete:</strong>&nbsp;" & Input("radio", "tool", Null, Null, "delete") & "</div>" & vbCrLf

strText = strText & Input("submit", "submit", Null, Null, "Submit") & vbCrLf

strText = strText & "</form>" & 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 & "<h2>" & strNewsTitle

If iAdminFlag Then

strText = strText & "&nbsp;(<a href=""" & strRootURL & "?mode=edit&newsid=" & qNewsID & """>Edit</a>/<a href=""" & strRootURL & "?mode=delete&newsid=" & qNewsID & """>Delete</a>)"

End If

strText = strText & "</h2>" & vbCrLf

'esta era a copia da linha abaixo com link para a página do autor strText = strText & "<div>Cadastrada " & FormatDateTime(strNewsPosted, 2) & " por <a href=""" & strUserURL & """>" & strUserTitle & "</a>.</div>" & vbCrLf

strText = strText & "<div>Cadastrada " & FormatDateTime(strNewsPosted, 2) & " por " & strUserTitle & "</div>" & vbCrLf

strText = strText & "<div><em>(notícia número: <strong>" & qNewsID & "</strong>.)</em></div>" & 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;"

objRS.PageSize = iPageSize

objRS.CacheSize = iPageSize

objRS.Open strSQL, objConn, adOpenStatic

If objRS.EOF Then

Error("Não há itens.")

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")

strText = strText & "<h2><a href=""" & strRootURL & "?newsid=" & strNewsID & """>" & strNewsTitle & "</a>"

If iAdminFlag Then

strText = strText & "&nbsp;(<a href=""" & strRootURL & "?mode=edit&newsid=" & strNewsID & """>Edit</a>/<a href=""" & strRootURL & "?mode=delete&newsid=" & strNewsID & """>Delete</a>)"

End If

strText = strText & "</h2>" & vbCrLf

'esta é a cópia da linha abaixo com link para a página do autor strText = strText & "<div>Cadastrada " & FormatDateTime(strNewsPosted, 2) & " por <a href=""" & strUserURL & """>" & strUserTitle & "</a>.</div>" & vbCrLf

strText = strText & "<div>Cadastrada " & FormatDateTime(strNewsPosted, 2) & " por " & strUserTitle & ".</div>" & vbCrLf

strText = strText & strNewsText & vbCrLf

iRecordsShown = iRecordsShown + 1

objRS.MoveNext

Loop

strText = strText & "<div align=""right""><a href=""" & strRootURL & "?mode=archive"">Banco de Notícias do JM</a></div>"

End Sub

' ****************************************

' END OF DISPLAY

' ****************************************

' ****************************************

' DISPLAYCOMMENT

' ****************************************

Sub DisplayComment()

Dim qAction

qAction = LCase(Trim(Request.QueryString("action")))

If qAction = "sql" Then

Dim fNewsID, fUserTitle, fUserURL, fCommentTitle, fCommentText, strSQL

fNewsID = Trim(Request.Form("newsid"))

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 fUserTitle = "" Or fUserURL = "" Or fCommentTitle = "" Or fCommentText = "" Then

strText = strText & Error("Ocorreu um problema no cadastro da noticia. Por favor preencha todos os campos requisitados.")

Exit Sub

End If

strSQL = "INSERT INTO " & strTableNameComment & " (NewsID, CommentPosted, UserTitle, UserURL, CommentTitle, CommentText) " &_

"VALUES (" & fNewsID & ", " &_

"#" & Now() & "#, " &_

"'" & fUserTitle & "', " &_

"'" & fUserURL & "', " &_

"'" & fCommentTitle & "', " &_

"'" & fCommentText & "');"

objRS.Close

objRS.Open strSQL, objConn

strText = strText & Success("Comment added successfully.")

Exit Sub

qNewsID = fNewsID

Call Display()

Exit Sub

End If

Dim strCommentID, strCommentPosted, strUserTitle, strUserURL, strCommentTitle, strCommentText, iCommentNumber

objRS.Close

strSQL = "SELECT CommentID, NewsID, CommentPosted, UserTitle, UserURL, CommentTitle, CommentText FROM " & strTableNameComment & " WHERE NewsID = " & qNewsID & ";"

objRS.Open strSQL, objConn, adOpenStatic

Do While Not objRS.EOF

iCommentNumber = iCommentNumber + 1

strCommentID = objRS.Fields("CommentID")

strCommentPosted = objRS.Fields("CommentPosted")

strUserTitle = objRS.Fields("UserTitle")

strUserURL = objRS.Fields("UserURL")

strCommentTitle = objRS.Fields("CommentTitle")

strCommentText = objRS.Fields("CommentText")

strText = strText & "<a name=""" & iCommentNumber & """></a>" & vbCrLf

strText = strText & "<h4>" & strCommentTitle

If iAdminFlag Then

strText = strText & "&nbsp;(<a href=""" & strRootURL & "?mode=editcomment&commentid=" & strCommentID & """>Edit</a>/<a href=""" & strRootURL & "?mode=deletecomment&commentid=" & strCommentID & """>Delete</a>)"

End If

strText = strText & "</h4>" & vbCrLf

strText = strText & "<div>Posted on " & strCommentPosted & " by <a href=""" & strUserURL & """>" & strUserTitle & "</a>.</div>" & vbCrLf

strText = strText & strCommentText

objRS.MoveNext

Loop

Call EditComment()

End Sub

' ****************************************

' END OF DISPLAYCOMMENT

' ****************************************

' ****************************************

' EDIT

' ****************************************

Sub Edit()

If iAdminFlag = False Then

strText = strText & Error("Access denied.")

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("Ocorreu um problema no cadastro da noticia. Por favor preencha todos os campos requisitados.")

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("Atualizada com sucesso.")

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("Notícia cadastrada com successo.")

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 & "<table border=""0""><form action=""" & strRootURL & "?mode=edit&action=sql"" method=""post""><tbody>" & vbCrLf

strText = strText & Input("hidden", "newsid", Null, Null, qNewsID) & vbCrLf

strText = strText & "<tr><td valign=""top"" width=""20%"">"

strText = strText & "<div><strong>Titulo:</strong></div><div><em>(Maximo de 50 caracteres.)</em></div>"

strText = strText & "</td><td valign=""top"">"

strText = strText & Input("text", "newstitle", 20, Null, strNewsTitle)

strText = strText & "</td></tr>" & vbCrLf

strText = strText & "<tr><td valign=""top"" width=""20%"">"

strText = strText & "<div><strong>Autor:</strong></div><div><em>(Autor. Maximo de 50 caracteres.)</em></div>"

strText = strText & "</td><td valign=""top"">"

strText = strText & Input("text", "userurl", 20, Null, strUserURL)

strText = strText & "</td></tr>" & vbCrLf

strText = strText & "<tr><td valign=""top"" width=""20%"">"

strText = strText & "<div><strong>Texto da notícia:</strong></div>"

strText = strText & "</td><td valign=""top"">"

strText = strText & Input("textarea", "newstext", 40, 10, strNewsText)

strText = strText & "</td></tr>" & vbCrLf

strText = strText & "<tr><td valign=""top"" width=""20%"">"

strText = strText & Input("submit", "submit", Null, Null, "Cadastrar")

strText = strText & "</td></tr>" & vbCrLf

strText = strText & "</tbody></form></table>" & 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("Ocorreu um problema no cadastro da noticia. Por favor preencha todos os campos requisitados.")

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 & "<table border=""0""><form action=""" & strRootURL

If qCommentID <> "" Then

strText = strText & "?mode=editcomment&action=sql"" method=""post""><tbody>" & vbCrLf

Else

strText = strText & "?newsid=" & qNewsID & "&action=sql"" method=""post""><tbody>" & vbCrLf

End If

strText = strText & Input("hidden", "commentid", Null, Null, qCommentID) & vbCrLf

strText = strText & Input("hidden", "newsid", Null, Null, qNewsID) & vbCrLf

strText = strText & "<tr><td valign=""top"" width=""20%"">"

strText = strText & "<div><strong>Title:</strong></div><div><em>(Maximum fifty characters.)</em></div>"

strText = strText & "</td><td valign=""top"">"

strText = strText & Input("text", "commenttitle", 20, Null, strCommentTitle)

strText = strText & "</td></tr>" & vbCrLf

strText = strText & "<tr><td valign=""top"" width=""20%"">"

strText = strText & "<div><strong>Your Name:</strong></div><div><em>(Maximum fifty characters.)</em></div>"

strText = strText & "</td><td valign=""top"">"

strText = strText & Input("text", "usertitle", 20, Null, strUserTitle)

strText = strText & "</td></tr>" & vbCrLf

strText = strText & "<tr><td valign=""top"" width=""20%"">"

strText = strText & "<div><strong>Your URL:</strong></div><div><em>(The link surrounding your name. Maximum fifty characters.)</em></div>"

strText = strText & "</td><td valign=""top"">"

strText = strText & Input("text", "userurl", 20, Null, strUserURL)

strText = strText & "</td></tr>" & vbCrLf

strText = strText & "<tr><td valign=""top"" width=""20%"">"

strText = strText & "<div><strong>Text:</strong></div>"

strText = strText & "</td><td valign=""top"">"

strText = strText & Input("textarea", "commenttext", 40, 10, strCommentText)

strText = strText & "</td></tr>" & vbCrLf

strText = strText & "<tr><td valign=""top"" width=""20%"">"

strText = strText & Input("submit", "submit", Null, Null, "Submit")

strText = strText & "</td></tr>" & vbCrLf

strText = strText & "</tbody></form></table>" & 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 & "<h2>Deslogado</h2>" & vbCrLf

strText = strText & Success("Deslogado com sucesso! <a href=""" & strRootURL & """>Clique aqui</a> para voltar a principal do " & strTitle & ".") & vbCrLf

End Sub

' ****************************************

' END OF LOGOUT

' ****************************************

' ****************************************

' FUNCTIONS

' ****************************************

Function Error(strErrorMessage)

Error = "<p class=""error"">" & strErrorMessage & "</p>"

End Function

' Formats errors in a nice way.

Function FormMemo(strFormMemo)

If strFormMemo <> "" Then

strFormMemo = Replace(strFormMemo, "''", "'")

strFormMemo = Replace(strFormMemo, "</p><p>", Chr(10) & Chr(10))

strFormMemo = Replace(strFormMemo, "<br />", Chr(10))

strFormMemo = Replace(strFormMemo, "<p>", "")

strFormMemo = Replace(strFormMemo, "</p>", "")

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, "&lt", "<")

strFormText = Replace(strFormText, "&gt", ">")

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 = "<textarea name=""" & strInputName & """ rows=""" & strInputHeight & """ cols=""" & (strInputWidth/2) + 10 & """>"

If strInputValue <> "" Then

strInput = strInput & strInputValue

End If

strInput = strInput & "</textarea>"

Case Else:

strInput = "<input type=""" & strInputType & """ name=""" & strInputName & """ "

If strInputType <> "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, "<", "&lt")

strSQLText = Replace(strSQLText, ">", "&gt")

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), "</p><p>")

strSQLMemo = Replace(strSQLMemo, Chr(10), "<br />")

strSQLMemo = "<p>" & strSQLMemo & "</p>"

SQLMemo = strSQLMemo

End Function

' Formats textareas for use in UPDATE and

' INSERT INTO statements.

Function Success(strSuccessMessage)

Success = "<p class=""success"">" & strSuccessMessage & "</p>"

End Function

' Formats success messages in a nice way.

' ****************************************

' END OF FUNCTIONS

' ****************************************

strText = strText & "<h6 align=""right"">Escrito por <a href=""mailto:marcioc@robynet.com.br"">WebMaster</a></h6>"

objConn.Close

Set objConn = Nothing

%>

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">

<html>

<head>

<title>

<%= strTitle %>

</title>

<style type="text/css">

<!--

p, div, li { font-family: Verdana, Helvetica, sans-serif; font-size: x-small; color: #000000 }

h2 { font-family: Verdana, Helvetica, sans-serif; font-size: large; color: #000000; text-decoration: underline; background-color: #ffffff; background-image: none; padding: 0.1em; padding-bottom: 0em; margin-bottom: 0em }

h4 { font-family: Verdana, Helvetica, sans-serif; font-size: x-small; font-weight: bold; color: #000000; background-color: #ffffff; background-image: none; padding: 0em; margin-bottom: 0em }

h6 { font-family: Verdana, Helvetica, sans-serif; font-size: smallest; color: #000000; background-color: #f1f1f1; background-image: none }

hr {color: #000000}

a {color: #000066; text-decoration: underline }

a:active {color: #006666; text-decoration: underline }

a:visited {color: #000066; text-decoration: underline }

a:hover {color: #006666; text-decoration: underline }

.error { color: #ff0000; font-weight: bold }

.success { color: #006600; font-weight: bold }

.botao {

font-family: Arial, Helvetica, sans-serif;

font-size: 10px;

font-style: normal;

background-color: #ffffff;

border: thin outset;}

BODY{ font-family: verdana,arial,helvetica,sans-serif;

scrollbar-face-color: #FFFFFF; scrollbar-highlight-color: #000066;

scrollbar-3dlight-color: #FFFFFF; scrollbar-darkshadow-color: #FFFFFF;

scrollbar-shadow-color: #000066; scrollbar-arrow-color: #000066;

scrollbar-track-color: #F7F7FE;}

-->

</style>

</head>

<body>

<%= strText %>

</body>

</html>

Link para o comentário
Compartilhar em outros sites
  • 0
dark0

dark0

Postado
Postado

Seus dois tópicos foram Juntados.

Por favor, não crie varios topicos sobre a mesma duvida.

Isso é considerado Flood, e não é permitido aqui.

Obrigado.

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.

×
 Share
Ir para lista de Perguntas


  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,3k
×
×
  • Criar Novo...