Buscador basado en los Meta Tags

vgaray · #1 (**permalink**) 01/03/2002, 19:22

El siguiente código es un buscador de páginas el cual buscará una palabra clave (keyword) dentro de los Meta tags de las mismas.

A.-) Tienes que tener instalada la version 5.5+ del Vbscript (msdn.microsoft.com/scripting)

B.-) Debes especificar sobre cual directorio se hará la busqueda.

B.-) Favor de editar la variable 'clave' para buscar alguna otra palabra a buscar

C.-) También debes especificar sobre cuantos archivos se hará la busqueda.

Lo que obtendrás al final es un listado que te mostrará las páginas que contienen la palabra clave con la sig. información.

1.-) El número de páginas consecutivo halladas.

2.-) El título de la pagina.

3.-) Los Meta Tags y su contendio.

4.-) La URL.

5.-) La cantidad de veces que se encontró la palabra clave buscada.

------------------------------------

<%
Path = server.mappath("/documentos")
ReDim Exts(1)
Exts(0) = ".htm"
Exts(1) = ".html"
clave = "funcion"

Redim Resultados(100,20) 'El primer indice es el maximo de archivos con coincidencias encontradas
Session("Encontrados") = 0
Session("Totales") = 0

Response.Write ""
Response.Write "Resultado de la busqueda de la clave: "
Response.Write "" & clave & " en el sitio: " & "http://" & Request.ServerVariables("HTTP_HOST") & " <hr size='1'>"
Inicio = Now()
Call Buscar_aqui(Path,Exts,clave) 'empieza a buscar en dir especifico sobre archivo con extension exts()
Call Mostrar_resultados
Finalizo = Now()
Response.Write " Tomarón " & datediff("s",Inicio,Finalizo) & " segundo(s) para revisar sobre " & Session("Totales") & " documentos disponibles."
Response.Write ""
%>

vgaray · #2 (**permalink**) 01/03/2002, 19:27

<%
'continua
Function Buscar_aqui(PathSpec,Exts,clave)
If right(PathSpec,8)<>"_vti_cnf" then
Session("Totales") = Session("Totales") + 1
If Session("Totales") > Ubound(Resultados,1) then
Exit Function
End if
Set Fso = CreateObject("Scripting.FileSystemObject&quot ;)
Set FolderInfo = Fso.GetFolder(PathSpec)
Set FileList = FolderInfo.Files
resx = 0
For Each File in FileList
Name = Cstr(File.Name)
FileName = UCase(Name)
For i = 0 to UBound(Exts)
If Instr(FileName,Ucase(Exts(i))) Then
de_esta_pagina = FormatURL(PathSpec) & "/" & FileName
If len(obtener_metas(de_esta_pagina))>1 then
Session("Encontrados") = Session("Encontrados") + 1
Session("Coincidencias")= 0
Resultados(resx,0) = Obtener_titulo(de_esta_pagina) & " "
metas = obtener_metas(de_esta_pagina)
If len(metas)>0 then
j2 = Split(metas,"|",-1,1)
k = 1
Metas = Ubound(j2)
For m=0 to Ubound(j2)
Resultados(resx,k) = j2(m)
k = k + 1
Next
End if
Resultados(resx,metas+1) = "Url: " & "<A HREF=""" & FormatURL(PathSpec) & "/" & FileName & """>" & Lcase("http://" & Request.ServerVariables("HTTP_HOST") & FormatURL(PathSpec) & "/" & FileName) & "</A> "
Resultados(resx,metas+2) = "Se encontrarón " & Session("Coincidencias") & " ocurrencias de la clave en el título ó los meta tags de esta página."
resx = resx + 1
End if
End If
Next
Next
Set f = Fso.GetFolder(PathSpec)
Set fc = f.SubFolders
For Each Folder in fc
Call Buscar_aqui(PathSpec & "\" & Folder.Name,Exts,clave)
Next
End if

End Function
%>

vgaray · #3 (**permalink**) 01/03/2002, 19:29

<%
'Continua
Sub mostrar_resultados
For k=0 to Session("Encontrados")-1
If len(Resultados(k,k))<1 then
Exit For
End if
Response.Write k+1 & " de " & Session("Encontrados") & " "
For info=0 to Ubound(Resultados,2)
If Len(Resultados(k,info))>0 Then
Response.Write Resultados(k,info)
End if
Next
Response.Write " <hr align='left' width='75%' size='1' color='#FFB650'> "
Next
End sub
%>

<%
Function buscar_completamente(de_esta_pagina,clave) ' si existe la clave, busco de caso contrario paso al sig archivo
Set objFSO2 = Server.CreateObject("Scripting.FileSystemObje ct")
Set objFile = objFSO2.OpenTextFile(Server.MapPath(de_esta_pagina ))
do until objFile.AtEndOfStream
Linea = objFile.ReadLine
If encontrar_cualquier_variante(linea,clave) then ' buscar cualquier variante de 'clave' en el archivo
buscar_completamente = True
exit function
Else
buscar_completamente = False
End if
loop
objFile.Close
Set objFile = Nothing
Set objFSO2 = Nothing
End Function
%>

<%
Function encontrar_cualquier_variante(linea,clave) 'buscar en toda la pagina para buscar más a fondo
Dim regEx, Match, Matches
Set regEx = New RegExp
regEx.Pattern = clave
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(linea)
encontrar_cualquier_variante = False
For Each Match in Matches
encontrar_cualquier_variante = True
Next
End Function
%>

vgaray · #4 (**permalink**) 01/03/2002, 19:32

<%
'continua
Function Obtener_titulo(de_esta_pagina)
Set objFSO2 = Server.CreateObject("Scripting.FileSystemObje ct")
Set objFile = objFSO2.OpenTextFile(Server.MapPath(de_esta_pagina ))
On error resume next
strContents = objFile.ReadAll
objFile.Close
Set objFile = Nothing
Set objFSO2 = Nothing
Set objRegExp = New RegExp
strMatch = "<title>(.*?)<\/title>"
objRegExp.Pattern = strMatch
objRegExp.IgnoreCase = True
objRegExp.Global = True
Set objMatches = objRegExp.Execute(strContents)
If objMatches.Count > 0 then
Obtener_titulo = "Título: " & resaltar(Mid(objMatches(0).Value, 8, Len(objMatches(0).Value) - 15),clave)
Else
Obtener_titulo = "Página sín título"
End If
Set objRegExp = Nothing
End Function
%>

<%
Function obtener_metas(de_esta_pagina)
Set objFSO2 = Server.CreateObject("Scripting.FileSystemObje ct")
Set objFile = objFSO2.OpenTextFile(Server.MapPath(de_esta_pagina ))
do until objFile.AtEndOfStream
Linea = objFile.ReadLine
If Instr(Linea,"<META") then
lineas = Split(Linea,chr(34),-1,1)
On error resume next
If Len(Lineas(1))>0 and Len(Lineas(3))>0 then
obtener_metas = obtener_metas & "" & Lineas(1) & " " & resaltar(Lineas(3),clave) & " " & "|"
End if
End if
loop
objFile.Close
Set objFile = Nothing
Set objFSO2 = Nothing
End Function
%>
<%
Function FormatURL(strPath)
iPos = InStr(1,strPath,"wwwroot",1)
str = Mid(strPath,iPos+7,Len(strPath))
FormatURL = Replace(str,"\","/")
End Function
%>

vgaray · #5 (**permalink**) 01/03/2002, 19:38

<%
'Finaliza

Function resaltar(texto_a_afectar,palabra_a_resaltar) 'funcion para resaltar algun texto incluido en otro
Dim regEx, Match, Matches
Set regEx = New RegExp
regEx.Pattern = palabra_a_resaltar
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(texto_a_afectar)
For Each Match in Matches
texto_a_afectar = replace(texto_a_afectar,Match.Value,"" & match.value & "")
Session("Coincidencias") = Session("Coincidencias") + 1 'contador de coincidencias (ocurrencias)
Next
resaltar = texto_a_afectar
End Function
%>

Al encontrarse la palabra clave, este será resaltada en color azul.

Bueno, esta es la versión 0.

En la siguiente, intentaré de decrementar el acceso a los archivo y ordenar los resultados por 'ranking', el cual será basado en la cantidad de veces que la palabra clave fué encontrada en el archivo. Asi mismo incluiré que busque dentro de <body>...</body> ya que ahora no lo hace.

Si alguién ofrece hosting, agradeceré me diga para subir ahi un archivo .zip con las siguientes versiones. Gracias

Nota: Ahora esta demasiado explicado (el código) pero más adelante optimizaré el tamaño del mismo.

Se aceptan ideas.

---------------------
Tan libre como gratuito!!!

RootK · #6 (**permalink**) 02/03/2002, 01:50

Muchas gracias por el tip amigo, todavía no lo pruebo..

Saludos...;)

<html><center><embed src="http://www.angelfire.com/on/cobainss/Movie1.swf" height=80 width=200> </embed></center></html>

zafnath · #7 (**permalink**) 02/03/2002, 11:31

Yo crei que ese tipo de meta no lo detecta un indexador por se ASP bueno eso creia hasta ahora !

<div align="center" onselectstart="return false" style="cursor: default"><embed src="http://geocities.com/unpocode/e-developer.swf" type="application/x-shockwave-flash" width="177.5" height="33.7" play="true" wmode="transparent" menu="false" loop

vgaray · #8 (**permalink**) 06/03/2002, 09:59

Saludos.

En esta nueva versión:
1.-) Se disminuyo el acceso a los archivos
2.-) Se hace una busqueda completa sobre el archivo
3.-) Muestra todos los Meta Tags que contenga el archvio
4.-) Muestra la cantidad de veces que se encuentra la palabra 'clave' a buscar sobre los archivos
5.-) Basado en el punto anterior, se despliega un listado ordenado descentemente por 'ranking'.

En la próxima versión se agregará la paginación de resultados.

http://www.vgaray.com/codigos/search.zip

---------------------
Tan libre como gratuito!!!

vgaray · #9 (**permalink**) 11/03/2002, 16:13

Saludos.

En esta versión del buscador interno para tu web. Se agregó la opción de páginación de resultados.

Ojala lo prueben y me digan como mejorarlo.

http://www.vgaray.com/Codigos/Search.zip

---------------------
Tan libre como gratuito!!!

akela · #10 (**permalink**) 11/03/2002, 19:36

Maestro de Maestros!!!!

que otra cosillas interensante tienes por ahí?

epa2 · #11 (**permalink**) 29/07/2002, 10:47

oye garay, en tu página no encuentro nada de tu código, solo un enlace de un banner.

¿está tu código en zip todavía por ahí?

Contesta.