<% 'coloca www para não indexar sem Sub ColocaWWW() if instr(Request.ServerVariables("SERVER_NAME"),"www.") = 0 then if Instr(Request.ServerVariables("QUERY_STRING"),"404;") = 0 then if Request.ServerVariables("QUERY_STRING") <> "" then query_string = "?" & Request.ServerVariables("QUERY_STRING") ELse query_string = "" ENd if if Request.ServerVariables("SCRIPT_NAME") = "/index.asp" or Request.ServerVariables("SCRIPT_NAME") = "/default.asp" then SCRIPT_NAME = "" Else SCRIPT_NAME = Request.ServerVariables("SCRIPT_NAME") End if if query_string <> "" AND SCRIPT_NAME = "" then query_string = "/" & query_string End if URL = "http://www." & Request.ServerVariables("SERVER_NAME") & SCRIPT_NAME & query_string & "" Else URL = "http://www." & Replace(Request.ServerVariables("QUERY_STRING"),left(Request.ServerVariables("QUERY_STRING"),11),"") URL = Replace(URL,":80","") End if Response.Redirect(URL) End if End Sub ' IIf implementation Function MM_IIf(condition, ifTrue, ifFalse) If condition = "" Then MM_IIf = ifFalse Else MM_IIf = ifTrue End If End Function Function Nome_Url(ByVal Palavra) cacento = "àáâãäèéêëìíîïòóôõöùúûüÀÁÂÃÄÈÉÊËÌÍÎÒÓÔÕÖÙÚÛÜçÇñÑ^~ºª°´`'?!.,#/“”:+–%$()" sacento = "aaaaaeeeeiiiiooooouuuuAAAAAEEEEIIIOOOOOUUUUcCnN" texto = "" If Palavra <> "" Then For x = 1 To Len(Palavra) letra = Mid(Palavra, x, 1) pos_acento = InStr(cacento, letra) If pos_acento > 0 Then letra = Mid(sacento, pos_acento, 1) End If texto = texto & letra Next texto = LCASE(texto) Nome_Url = Replace(texto," ","-") End If End Function Function FormtData(Data,TipoFormatacao) Select Case TipoFormatacao Case 0 ' Data Básica FormtData = Right("0" & Day(Data),2) &"/"& Right("0" & Month(Data),2) &"/"& Year(Data) Case 1 ' Data escrita FormtData = Right("0" & Day(Data),2) &" DE "& Ucase(Server.HTMLEncode(Monthname(Month(Data)))) &" DE "& Year(Data) Case 2 ' Hora FormtData = Right("0" & Hour(Data),2) &"h"& Right("0" & Minute(Data),2) Case 3 ' Hora noticia postada FormtData = Right("0" & Day(Data),2) &"/"& Right("0" & Month(Data),2) &"/"& Year(Data) &" - "& FormtData(Data,2) End Select End Function 'Function PontoMid(Texto,Tamanho) ' If Len(Texto) > Tamanho Then ' PontoMid = Mid(Texto,1,Tamanho) & "..." ' Else ' PontoMid = Texto ' End If 'End Function 'CODIGO: Function AntiInject(Str) Str = trim(Str) Str = lcase(Str) Str = replace(Str,"=","") Str = replace(Str,"'","") Str = replace(Str,"""""","") Str = replace(Str," or ","") Str = replace(Str," and ","") Str = replace(Str,"(","") Str = replace(Str,")","") Str = replace(Str,"<","[") Str = replace(Str,">","]") Str = replace(Str,"update","") Str = replace(Str,"-shutdown","") Str = replace(Str,"--","") Str = replace(Str,"'","") Str = replace(Str,"#","") Str = replace(Str,"$","") Str = replace(Str,"%","") Str = replace(Str,"¨","") Str = replace(Str,"&","") Str = replace(Str,"'or'1'='1'","") Str = replace(Str,"--","") Str = replace(Str,"insert","") Str = replace(Str,"drop","") Str = replace(Str,"delet","") Str = replace(Str,"xp_","") Str = replace(Str,"select","") Str = replace(Str,"*","") AntiInject = Str End function Function DataZ(data) DataZ = day(data)&"/"&month(data)&"/"&year(data)&" "&hour(data)&":"&minute(data)&":"&second(data) End Function Function maiuscula(str) MeuArray = Split(str," ") for i = LBound(MeuArray) to UBound(MeuArray) resultado = resultado & UCase(LEFT(MeuArray(i),1)) & LCase(RIGHT(MeuArray(i),Len(MeuArray(i))-1)) & " " next maiuscula = resultado End Function 'função para enviar objeto post function postHTML (strUrl, strData) 'conteudo que sera mandado : strData 'url que sera enviado Set xmlHttp = Server.Createobject("MSXML2.ServerXMLHTTP") xmlHttp.Open "POST", strUrl, False xmlHttp.setRequestHeader "User-Agent", "asp httprequest" xmlHttp.setRequestHeader "content-type", "application/x-www-form-urlencoded" xmlHttp.Send strData postHTML = xmlHttp.responseText xmlHttp.abort() set xmlHttp = Nothing end function 'função para enviar objeto get function getHTML (strUrl, strData) 'conteudo que sera mandado : strData 'url que sera enviado Set xmlHttp = Server.Createobject("MSXML2.ServerXMLHTTP") xmlHttp.Open "GET", strUrl, False xmlHttp.setRequestHeader "User-Agent", "asp httprequest" xmlHttp.setRequestHeader "content-type", "application/x-www-form-urlencoded" xmlHttp.Send strData getHTML = xmlHttp.responseText xmlHttp.abort() set xmlHttp = Nothing end function 'pega valor de um querystring, porem estando com url amigavel ou url em format string Function PegaQueryString(ByVal url, ByVal nome) if url = "" then url = Request.ServerVariables("QUERY_STRING") End if 'concerta url url = Replace(url,"404;","") url = Replace(url,":80","") url = Replace(url,"%20"," ") url = Replace(url,"%40","@") if Instr(url,nome & "=") > 0 then Aux = Instr(url,nome & "=") Aux = Mid(url,Aux) if Instr(Aux,"&") > 0 then Aux = Mid(Aux, 1, Instr(Aux,"&") - 1) End if Aux = Replace(Aux, nome & "=", "") PegaQueryString = Aux Else PegaQueryString = "" End if End Function 'apaga todas as tags html Function LimpaHTML(TXtNoticia) Do While True ini = InStr(1,TXtNoticia,"<") If ini = 0 Then Exit Do fim = InStr(ini,TXtNoticia,">") parcial = Mid(TXtNoticia,ini,fim-ini+1) TXtNoticia = Replace(TXtNoticia,parcial,"") Loop LimpaHTML = TXtNoticia End Function 'funcao para cortar um pedaço do texto, caso seja maior que o tamanho requerido coloca ... Function PontoMid(ByVal Texto,ByVal Primeiro,ByVal Tamanho) Texto = Mid(Texto, Primeiro) If Len(Texto) > Tamanho Then if Mid(Texto,Tamanho,1) = " " then PontoMid = Mid(Texto,1,Tamanho - 1) Else PontoMid = Mid(Texto,1,Tamanho) if Instr(Tamanho + 1,Texto," ") > 0 then PontoMid = PontoMid & Mid(Texto,Tamanho + 1,Instr(Tamanho + 1,Texto," ") - Tamanho) Else PontoMid = Texto End if End if PontoMid = PontoMid & "..." Else PontoMid = Texto End If End Function Function FormatData(Data,Mascara) if isDate(Data) = true then Dim Mes(12) Formatada = Mascara Mes(1) = "Janeiro" Mes(2) = "Fevereiro" Mes(3) = "Março" Mes(4) = "Abril" Mes(5) = "Maio" Mes(6) = "Junho" Mes(7) = "Julho" Mes(8) = "Agosto" Mes(9) = "Setembro" Mes(10) = "Outubro" Mes(11) = "Novembro" Mes(12) = "Dezembro" Formatada = Replace(Formatada,"[DD]",Right("0" & Day(Data),2)) Formatada = Replace(Formatada,"[MM]",Right("0" & Month(Data),2)) Formatada = Replace(Formatada,"[MM2]",Mes(Month(Data))) Formatada = Replace(Formatada,"[YYYY]",Year(Data)) Formatada = Replace(Formatada,"[YY]",Mid(Year(Data),3,2)) Formatada = Replace(Formatada,"[h]",Right("0" & Hour(Data),2)) Formatada = Replace(Formatada,"[m]",Right("0" & Minute(Data),2)) Formatada = Replace(Formatada,"[s]",Right("0" & Second(Data),2)) FormatData = Formatada else FormatData = null end if End Function 'Sub ChamFil(Top,Sessao) ' ' Set NoticiasCapa_cmd = Server.CreateObject ("ADODB.Command") ' NoticiasCapa_cmd.ActiveConnection = MM_Loja_STRING ' NoticiasCapa_cmd.CommandText = "SELECT TOP "&Top&" noticias.*, categoria.categorianome, categoria.categoriacor, categoria.categoriaid from noticias inner join categoria on (noticias.noticiacategoria = categoria.categoriaid) WHERE (noticias.NoticiaNoar <= CURRENT_TIMESTAMP) AND (noticias.SessaoID = "&Sessao&") ORDER BY noticias.Noticianoar DESC" ' NoticiasCapa_cmd.Prepared = true ' ' Set NoticiasCapa = NoticiasCapa_cmd.Execute ' NoticiasCapa_numRows = 0 'End Sub ' 'Function tipochamada(arquivo,largura,altura,url) 'ponto = InStrRev (arquivo,".",-1,1) 'ext = lcase(mid(arquivo,(ponto + 1),len(arquivo))) 'Select case ext 'case "swf" 'banner = "" 'case "jpg","jpeg","gif" 'banner = "" 'case else 'banner = arquivo 'end Select 'tipochamada=banner 'End Function %>