-------------------------------------------------------------------------------------------------------------------------
Coloque um sistema de Meta-Busca no seu site
por Otávio Dias
Hoje vou postar um código muito interessante que faz uma busca no sistema Google e retorna o resultado no arquivo ASP. Esse código pode ser totalmente personalizado, se adaptando aos padrões do seu site. O sistema foi desenvolvido por mim em ASP e XML sem o uso de APIs ou similares, também não é preciso de cadastro algum no Google.
busca.asp
<%
strHTMLbusca = strHTMLbusca & "<title>Sistema de Meta-Busca baseado no Google</title>"
strHTMLbusca = strHTMLbusca & "<style type=""text/css"">"
strHTMLbusca = strHTMLbusca & "<!--"
strHTMLbusca = strHTMLbusca & "a:link { color: #0430b2; text-decoration: underline}" & Vbnewline
strHTMLbusca = strHTMLbusca & "a:visited { color: #0430b2; text-decoration: underline }" & Vbnewline
strHTMLbusca = strHTMLbusca & " a:hover { color: #0430b2; text-decoration: none }" & Vbnewline
strHTMLbusca = strHTMLbusca & "-->" & Vbnewline
strHTMLbusca = strHTMLbusca & "</style> " & Vbnewline
strHTMLbusca = strHTMLbusca & " <form method=get><table border=0 cellSpacing=0 width=""100%""><TR><TD colSpan=4 height=42><DIV align=center><font face=tahoma><h2><B>Sistema de Meta-Busca baseado no <font color=""#0103d7"">G</font><font color=""#ee1200"">o</font><font color=""#fcd836"">o</font><font color=""#0103d7"">g</font><font color=""#12b204"">l</font><font color=""#ee1200"">e</font></B></h2></td></tr></table><font style=font-size:11px;font-family:tahoma>"
strHTMLbusca = strHTMLbusca & "<center><input name=""pesquisa"" type=""text"" size=50 style=font-family:tahoma;font-size:11px value=""" & request("pesquisa") & """> <input type=""submit"" value="" Pesquisar "" style=font-family:tahoma;font-size:11px><br><br>"
Class BuscaGoogle
Private strHTML
Private xml
Private strHTMLbits
Private strHTMLcontador
Private strHTMLcontadorbits
Public Function Run
if request("pagina") <> "" then
npepagina = "&start=" & request("pagina")
end if
Set xml = Server.CreateObject("Microsoft.XMLHTTP")
xml.Open "GET", "http://www.google.com/search?hl=pt&ie=ISO-8859-1&q=" & request("pesquisa") & "&btnG=Pesquisa+Google&lr=lang_pt" & npepagina , False
xml.Send
strHTML = RSBinaryToString(xml.responseBody)
strHTMLbits = Split (strHTML, "</table><div><p>", -1, 1)
strHTML = strHTMLbits(1)
strHTMLbits = Split (strHTML, "<form method=GET action=/search>", -1, 1)
strHTML = strHTMLbits(0)
strHTMLcontador = RSBinaryToString(xml.responseBody)
strHTMLcontadorbits = Split (strHTMLcontador, "<td bgcolor=#3366cc align=right nowrap><font size=-1 color=#ffffff>", -1, 1)
strHTMLcontador = strHTMLcontadorbits(1)
strHTMLcontadorbits = Split(strHTMLcontador, "segundos.</font></td></tr><tr><td bgcolor=ffffff nowrap colspan=2>", -1, 1)
strHTMLcontador = strHTMLcontadorbits(0)
End Function
Public Property Get output
output = strHTML
output = replace(output, "<font size=-1>", "<font style=font-size:11px>")
output = replace(output, "Em cache</a>", "</a></b>")
output = replace(output, "Páginas Semelhantes</a>", "</a></b>")
output = replace(output, "- </font>", "</b></font>")
output = replace(output, "</a> -", "</a></b>")
output = replace(output, "<font color=#008000>", "<font color=A0A0A0 style=font-size:11px><b>")
output = replace(output, "<a", "<a target=_new")
output = replace(output, "<img src=/intl/pt/nav_current.gif width=16 height=26 alt=""""><br>", "")
output = replace(output, "<img src=/intl/pt/nav_page.gif width=16 height=26 alt="""" border=0><br>", "")
output = replace(output, "<img src=/intl/pt/nav_previous.gif width=68 height=26 alt="""" border=0><br>", "")
output = replace(output, "<img src=/intl/pt/nav_next.gif width=100 height=26 alt="""" border=0><br>", "")
output = replace(output, "<img src=/intl/pt/nav_last.gif width=46 height=26 alt=""""><br>", "")
output = replace(output, "<a target=_new href=/search?q=", "<font style=font-size:11px> <a href=busca.asp?pesquisa=")
output = replace(output, "&hl=pt&lr=lang_pt&ie=UTF-8&start=", "&pagina=")
output = replace(output, "&sa=N>", ">")
output = replace(output, "Página de Resultados: ", "Páginas: ")
output = replace(output, "<img src=/intl/pt/nav_first.gif width=18 height=26 alt="""">", "")
output = replace(output, "<span class=i>", " <font style=font-size:11px></b>")
output = replace(output, "</span>", "</b>")
output = replace(output, "<td> <font style=font-size:11px></b>", "<td valign=top align=center><font style=font-size:11px></b> ")
output = replace(output, "</div><br clear=all><div class=n>", "<br><br><br><br>")
output = replace(output, "<span class=b><b>Mais</b></b></a>", "<b>Próxima</b>")
output = replace(output, "<br clear=all><br><table border=0 cellpadding=3 cellspacing=0 align=center><tr><td nowrap>", "<br><br><br><hr size=1><center><a href=""http://www.virtuastore.com.br"" style=text-decoration:none;color:red><b>© VirtuaStore Sistemas de Comércio Eletrônico</b></a><br></center>")
output = replace(output, "<td valign=bottom nowrap><font style=font-size:11px>Páginas:", "<td valign=top nowrap><font style=font-size:11px>Páginas:")
End Property
Public Property Get outputcontador
outputcontador = strHTMLcontador
outputcontador = replace(outputcontador, "Dica: Na maioria dos navegadores, basta teclar Enter em vez de clicar no botão de pesquisa.", "")
End Property
Function RSBinaryToString(xBinary)
Dim Binary
If VarType(xBinary)=8 Then Binary = MultiByteToBinary(xBinary) Else Binary = xBinary
Dim RS, LBinary
Const adLongVarChar = 201
Set RS = CreateObject("ADODB.Recordset")
LBinary = LenB(Binary)
If LBinary>0 Then
RS.Fields.Append "mBinary", adLongVarChar, LBinary
RS.Open
RS.AddNew
RS("mBinary").AppendChunk Binary
RS.Update
RSBinaryToString = RS("mBinary")
Set RS=Nothing
Else
RSBinaryToString = ""
End If
Set RS=Nothing
End Function
Function MultiByteToBinary(MultiByte)
Dim RS, LMultiByte, Binary
Const adLongVarBinary = 205
Set RS = CreateObject("ADODB.Recordset")
LMultiByte = LenB(MultiByte)
If LMultiByte>0 Then
RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
RS.Open
RS.AddNew
RS("mBinary").AppendChunk MultiByte & ChrB(0)
RS.Update
Binary = RS("mBinary").GetChunk(LMultiByte)
End If
Set RS = Nothing
MultiByteToBinary = Binary
End Function
End Class
if request("pesquisa") = "" then
else
set objbusca = New BuscaGoogle
objbusca.Run
strHTMLbusca = strHTMLbusca & "</center><table width=""100%""><tr><td colspan=2><hr size=1></td></tr><tr><td><font style=font-size:11px>Pesquisando por:<b> " & request("pesquisa") & "</b></td><td align=right><font style=font-size:11px>" & objbusca.outputcontador & " segundos.</td></tr><tr><td colspan=2><hr size=1></td></tr></table><br>"
strHTMLbusca = strHTMLbusca & objbusca.output
set objbusca = nothing
end if
Response.write strHTMLbusca
%>
Para utilizar este código basta copiar e colar.
Qualquer dúvida poste uma mensagem no fórum VirtuaStore.
Boa Programação!
------------------------------------------------------------------------------------
Qualquer duvida entrem em contato...
Abraços,
t+
