Ir para conteúdo
Fórum Script Brasil

Cristiano123

Membros
  • Total de itens

    58
  • Registro em

  • Última visita

Tudo que Cristiano123 postou

  1. Cristiano123

    busca e select

    já. Eu quero é apenas exibir dentro de um option do select os campos cadastrados no banco de dados.
  2. Cristiano123

    busca e select

    estou querendo é montar uma busca no asp, buscando no acess e mostrando as cidades cadastradas num determinado banco apos clicar em venda (campo radio). 0
  3. Cristiano123

    busca e select

    Olá. Estou montando um baNCO DE DADOS e preciso fazer uma busca que faz o seguinte: quando o usuario escolher no campo radio = venda em baixo um campo select carrega e mostra as cidades cadastradas no banco. Tem jeito?
  4. Olá Galera, Estou tentando fazer uma coisa simples aqui e ainda não consegui........ tenho no banco um campo que armazena a função time quando se cadastra o registro. Queria ver como exibir em um box apenas assim o resultado: 12h30 . alguém sabe?
  5. Cristiano123

    Adaptar Slide

    ok... valeu mesmo... Vou tentar colocar os numeros dentro da transparencia tambem sem o fundo preto. No rodape da foto....
  6. Cristiano123

    Adaptar Slide

    vocÊ esqueceu de postar também o style.css
  7. Cristiano123

    Adaptar Slide

    Funcionou agora. Porque que ao passar de uma noticia para a outra dá tipo um efeito (que não é bom) de sobrepor o titulo da outra noticia.? Tipo na transição de uma noticia para outra....
  8. Cristiano123

    Adaptar Slide

    ok.... équase isto.... O titulo da noticia deveria vir de dentro do banco de dados... onde você colocou coloque o1º titulo aui... (dentro do javascript). Deveria era buscar no próprio banco de dados... tem jeito? De repente m ajuda ao seguinte... Criar uma camada transparente emcima da foto chmando o titulo do banco de dados
  9. Olá estou procurando algo que atenda para modificações tipo slide de noticia com .js e asp (buscando de um banco de dados) tipo o site do www.uai.com.br . alguém pode me ajudar. Já baixei vários mas nenhum com asp junto. apenas jquery.
  10. Cristiano123

    Adaptar Slide

    Olá amigos... tenho uma rotina que consegui na net e estou tentando adaptar para que a rotina leia dentro de um banco e exiba a imagen e titulo e os numeros 1,2,3,4,5. O slide funciona mas quando adpto no banco não dá.... não estou conseguindo adaptar porque esta buscando dentro de um javascript e preciso buscar num banco de dados asp. Ve funcionando (sem o banco) no link: http://dreamcss.blogspot.com/2009/04/creat...ry-sliders.html alguém dá um maozinha? Valeu... Segue a rotina principal: <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en"> <head> <title>jquery sliders</title> <link rel="stylesheet" href="style.css" type="text/css" media="screen" /> <script type="text/javascript">var _siteRoot='index.html',_root='index.html';</script> <script type="text/javascript" src="js/jquery.js"></script> <script type="text/javascript" src="js/scripts.js"></script> </head> <body> <!--/top--> <div id="header"><div class="wrap"> <div id="slide-holder"> <div id="slide-runner"> <a href=""><img id="slide-img-1" src="images/nature-photo.png" class="slide" alt="" /></a> <a href=""><img id="slide-img-2" src="images/nature-photo1.png" class="slide" alt="" /></a> <a href=""><img id="slide-img-3" src="images/nature-photo2.png" class="slide" alt="" /></a> <a href=""><img id="slide-img-4" src="images/nature-photo3.png" class="slide" alt="" /></a> <a href=""><img id="slide-img-5" src="images/nature-photo4.png" class="slide" alt="" /></a> <a href=""><img id="slide-img-6" src="images/nature-photo4.png" class="slide" alt="" /></a> <a href=""><img id="slide-img-7" src="images/nature-photo6.png" class="slide" alt="" /></a> <div id="slide-controls"> <p id="slide-client" class="text"><strong>post: </strong><span></span></p> <p id="slide-desc" class="text"></p> <p id="slide-nav"></p> </div> </div> <!--content featured gallery here --> </div> <script type="text/javascript"> if(!window.slider) var slider={};slider.data=[{"id":"slide-img-1","client":"nature beauty","desc":"nature beauty photography"},{"id":"slide-img-2","client":"nature beauty","desc":"add your description here"},{"id":"slide-img-3","client":"nature beauty","desc":"add your description here"},{"id":"slide-img-4","client":"nature beauty","desc":"add your description here"},{"id":"slide-img-5","client":"nature beauty","desc":"add your description here"},{"id":"slide-img-6","client":"nature beauty","desc":"add your description here"},{"id":"slide-img-7","client":"nature beauty","desc":"add your description here"}]; </script> </div></div><!--/header--> </body> </html>
  11. é porque estou fazendo isto junto com um jquery com noticias slide. No jquery funciona as paginas mas quando acrecento o banco dentro aí não consigo mais ir para o proximo e anterior. como faço então.
  12. fiz isto mas não está dando... <% if tp="prev" then rs.moveprevious end if if tp="next" then rs.movenext end if response.write("<form method=post action='teste1.asp'>") response.write("<input type=hidden name='tp' value='prev'>") response.write("<input type=hidden name='cod' value='" & codigo & "'>") response.write("<input type=hidden name='txtcat' value='" & request.form("txtcat") & "'>") response.write("<input type=submit value='<< Anterior'>") response.write("</form>") response.write("<form method=post action='teste1.asp'>") response.write("<input type=hidden name='tp' value='next'>") response.write("<input type=hidden name='cod' value='" & codigo & "'>") response.write("<input type=hidden name='txtcat' value='" & request.form("txtcat") & "'>") response.write("<input type=submit value='Proximo >>'>") response.write("</form>") %>
  13. <a href='teste1.asp?PagAtual=" & PagAtual - 1 & "'>Anterior</a> - <a href='teste1.asp?PagAtual=" & PagAtual + 1 & "'>Próximo</a>
  14. to entendendo ...antes eu tinha vários botoes submit. agora terei apenas um submit e varios if com as condiçoes. Não é.
  15. mas para testar os checkbox? Só insert naqueles que marquei os campos....
  16. com faço com que um formulario cadastre após preencher os campos (titulo, noticia, imagem, etc) em marcar vários checkbox no final do formulario e quando enviar seja cadastrado em vários bancos de dados. tipo preenchi o titulo, noticia, imagem e no final marquei no checkbox gerais, marquei o checkbox policia e enviei e ele cadastre no banco gerais e policia Esto meio com difculdade com isto. Alguém ajuda? :wacko:
  17. Cristiano123

    ticker

    Olá estou precisando adaptar um ticker de noticias com flash + asp tipo o www.defatoonline.com.br alguém sabe onde encontro algo que possa me ajudar? :rolleyes:
  18. Olá galera to precisando de um tutorial para abrir várias páginas em pdf na web, tipo aquele efeito que se clica no canto e muda de paginas. alguém sabe como?
  19. Cristiano123

    CPf no banco

    quase ok................. mas a rotina abaixo só entra no cpf já cadastrado............. <% Dim nome,cpf strquery = "SELECT * FROM banco WHERE cpf = '" & request.form("cpf") & "'" Set objRs=objconn.Execute(strquery) If objrs.BOF And objrs.EOF Then strquery="INSERT INTO banco(nome,cpf) VALUES ('"&nome&"','"&cpf&"')" Set objRs=objconn.Execute(strquery) response.redirect "insere.asp" else response.write "<script>alert('ESTE CPF JÁ ESTÁ CADASTRADO');</script>" end if %>
  20. Cristiano123

    CPf no banco

    Beleza............ tamos quase lá................. Agora tá passando e cadastrando mas onde tá o erro que ele não verifica que já existe o cpf.... segue o codigo: <!--#include file="bum.asp" --> <html> <head> <title>Inserido no site</title> <% Dim nome,cpf nome=request("t1") cpf=request("t2") strquery = "SELECT * FROM banco WHERE cpf = '" & request.form("cpf") & "'" Set objRs=objconn.Execute(strquery) If objrs.BOF And objrs.EOF Then strquery="INSERT INTO banco(nome,cpf) VALUES ('"&nome&"','"&cpf&"')" Set objRs=objconn.Execute(strquery) response.redirect "insere.asp" else response.write "<script>alert('ESTE CPF JÁ ESTÁ CADASTRADO');</script>" end if %>
  21. Cristiano123

    CPf no banco

    Parece que ele não tá entrando é no IF.....e vai direto pro script do final e não cadastra no banco
  22. Cristiano123

    CPf no banco

    beleza funcionou o cadastro............. mas se repito o cpf ele não dá a mensagem do cpf já cadastrado....................o que faço
  23. Cristiano123

    CPf no banco

    está dando erro na linha do select Tipo de erro: Microsoft OLE DB Provider for ODBC Drivers (0x80040E07) [Microsoft][Driver ODBC para Microsoft Access] Tipo de dados imcompatível na expressão de critério. /cpf/inserido.asp, line 10 Tipo de navegador: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1) Página: POST 45 bytes to /cpf/inserido.asp POST Data: t1=a&t2=02735682641&Submit=ENVIAR+PARA+O+SITE Hora: terça-feira, 3 de março de 2009, 00:22:01
  24. Cristiano123

    CPf no banco

    O que estou errando? Tenho um formulario que entra com nome e cpf e testa se já existe no banco de dados, se não existir irá prosseguir no cadastro, senao dará usuário já cadastgrado.... <html> <head> <title>Inserido no site</title> <% Dim nome,cpf nome=request("t1") cpf=request("t2") strquery = "SELECT * FROM banco WHERE cpf = "& request.form("cpf") Set objRs=objconn.Execute(strquery) If objrs.BOF=objrs.EOF then strquery="INSERT INTO banco(nome,cpf) VALUES ('"&nome&"','"&cpf&"')" response.redirect "insere.asp" else response.write "<script>alert('ESTE CPF JÁ ESTÁ CADASTRADO'); return false</script>" end if %>
  25. Cristiano123

    Cristiano 123

    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>
×
×
  • Criar Novo...