BUSCAR.ASP
<%
Response.Buffer = True
%>
<!--#include file="depurar.asp" -->
<%
redim path(3)
path(1)= server.mappath("../carpeta1") 'en donde se hará la busqueda
Path(2) = server.mappath("../carpeta2") 'en donde se hara la busqueda
Path(3) = server.mappath("../carpeta3") 'en donde se hara la busqueda
Exts = "htm,html,asp" 'extensiones de los archivos sobre los que se hará la busqueda
clave = Request.Form("clave") 'clave a buscar
Redim Resultados(1000,1) 'se podrán registrar hasta 1000 posibles resultados
Session("Encontrados") = 0
Session("Totales") = 0
Inicio = Now()
resx = 0
for x= 1 to 3
%>
<%
Call Buscar(Path(x),Exts,clave) 'empieza la busqueda
next
cuantos = Session("encontrados")
call DualSorter(cuantos) 'se ordena o se 'rankean' los resultados
call Crear_Archivo_resultados
If cuantos>0 then
tomaron = datediff("s",Inicio,Now())
Response.Redirect "mostrar.asp?clave=" & clave & "&Tomaron=" & Tomaron & "&Totales=" & Session("Totales")& "&Inicio=1"
Else
Response.Write "<center><Font face='verdana,arial,helvetica' size='2'>"
Response.Write "<b>http://" & Request.ServerVariables("HTTP_HOST") & "</b><br><hr size='2'>"
Response.Write "No se encontrarón archivos que contengan la palabra clave:<b> " & clave & "</b><br>"
Response.Write "<a href='Default.asp'> >> Pulsa aquí para realizar otro busqueda <<</a></center></font>"
End if
%>
<%
Function Buscar(PathSpec,Exts,clave)
If right(PathSpec,8)<>"_vti_cnf" then
Set Fso = CreateObject("Scripting.FileSystemObject" ;)
Set FolderInfo = Fso.GetFolder(PathSpec)
Set FileList = FolderInfo.Files
'resx = 0
For Each File in FileList 'obtener todo el listado de archivo de dir actual
Session("Totales") = Session("Totales") + 1
FileName = UCase(Cstr(File.Name))
If InStr(1, Exts, fso.GetExtensionName(file.Name), vbTextCompare) > 0 Then
page = contenido(PathSpec & "/" & FileName) 'solo una vez se accesa el archivo
Session("Coincidencias")= 0
If buscar_todo(page,clave) then
Session("Encontrados") = Session("Encontrados") + 1
Resultados(resx,0) = "<font size='2'><A HREF=""" & FormatURL(PathSpec) & "/" & FileName & """>"
Resultados(resx,0) = Resultados(resx,0) & Titulo(page) & "<a/></font><br>"
metas = obtener_metas(page) ' obtener todos los meta tags de la página
If len(metas)>0 then
j2 = Split(metas,"|",-1,1)
k = 1
Metas = Ubound(j2)
For m=0 to Ubound(j2)
Resultados(resx,0) = Resultados(resx,0) & j2(m)
k = k + 1
Next
End if
if File.Size < 1024 Then
tam = File.Size & " Bytes"
ElseIf File.Size < 1048576 Then
tam = Round(FileSizeTotal/1024, 2) & " KB"
Else
tam = Round((FileSizeTotal/1024)/1024.1, 2) & " MB"
End if
Resultados(resx,0) = Resultados(resx,0) & tam & " Archivo creado el: " & File.DateCreated & " Ultima modificación: " & File.DateLastModified & "<br>"
Resultados(resx,1) = Session("Coincidencias")
resx = resx + 1
End if
End if
Next
Set f = Fso.GetFolder(PathSpec)
Set fc = f.SubFolders
For Each Folder in fc 'recursividad dentro de los directorios
Call Buscar(PathSpec & "\" & Folder.Name,Exts,clave)
Next
End if
End Function
%>
<%
Sub Crear_Archivo_resultados
set fso = Server.CreateObject("scripting.FileSystemObje ct")
Arch_temp = Server.MapPath(Session.SessionId & ".txt")
set File = fso.CreateTextFile(Arch_temp, true,false)
For k=0 to Session("Encontrados")-1
File.WriteLine(Resultados(k,0))
File.WriteLine(Resultados(k,1))
Next
File.Close
Set file = nothing
Set fso = nothing
End sub
%>
<%
Function Contenido(page) 'obtengo el contenido del archivo y lo pongo en una variable
Set objFSO2 = Server.CreateObject("Scripting.FileSystemObje ct")
Set objFile = objFSO2.OpenTextFile(page)
strContents = objFile.ReadAll
objFile.Close
Set objFile = Nothing
Set objFSO2 = Nothing
Contenido = strContents
End Function
%>
<%
Function Buscar_todo(page,clave) ' si existe la clave, busco de caso contrario paso al sig archivo
Dim regEx, Match, Matches
Set regEx = New RegExp
regEx.Pattern = clave
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(page)
If Matches.Count > 0 then
Buscar_todo = True
Else
Buscar_todo = False
End if
For Each Match in Matches
Session("Coincidencias") = Session("Coincidencias") + 1 'servira para el ranking
Next
End Function
%>
<%
Function Titulo(page)
i=instr(1,page, "<title>",1)
if i>0 THEN
f=INSTR(1,page, "</title>",1)
Titulo= Resaltar(mid (page, i+7, f-i-7), clave)
ELSE
Titulo = "Página sin titulo"
end if
'Set objRegExp = New RegExp
'strMatch = "<title>(.*?)<\/title>"
'objRegExp.Pattern = strMatch
'objRegExp.IgnoreCase = True
'objRegExp.Global = True
'Set objMatches = objRegExp.Execute(page)
'If objMatches.Count > 0 then
'Titulo = Resaltar(Mid(objMatches(0).Value, 8, Len(objMatches(0).Value) - 15),clave)
'Else
' Titulo = "Página sín título"
'End If
'Set objRegExp = Nothing
End Function
%>
<%
Function obtener_metas(page) ' para leer todos los meta tags
Linea = Split(page,vbLf, -1, 1)
for r = 0 to UBound(Linea)
If Instr(Linea(r),"<META") then
lineas = Split(Linea(r),chr(34),-1,1)
On error resume next
If Len(Lineas(1))>0 and Len(Lineas(3))>0 then
obtener_metas = obtener_metas & "<b>" & Lineas(1) & "</b> " & resaltar(Lineas(3),clave) & "<br>" & "|"
End if
End if
Next
End Function
%>
<%
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,"<font color=GREEN><i><b>" & match.value & "</b></i></font>")
Next
resaltar = texto_a_afectar
End Function
%>
<%
Function FormatURL(strPath)
ipos=instr(1,strpath,"Html",1)
str=mid(strpath,ipos+4,len(strpath))
formatURL = "http://www.tusitio.com" & str
'formatURL =replace(direccion,"html/","")
'FormatURL = Replace(str,"\","/")
End Function
%>
<% 'function taken from www.4guysfromrolla.com para sortear el array
Sub DualSorter(tantos)
column = tantos
DimensionToSort = 1
OtherDimension = 0
For row = 0 To tantos-1
StartingKeyValue = Resultados ( row, DimensionToSort )
StartingOtherValue = Resultados ( row, OtherDimension )
NewStartingKey = Resultados ( row, DimensionToSort )
NewStartingOther = Resultados ( row, OtherDimension )
swap_pos = row
For j = row + 1 to tantos-1
If Resultados ( j, DimensionToSort ) > NewStartingKey Then
swap_pos = j
NewStartingKey = Resultados ( j, DimensionToSort )
NewStartingOther = Resultados ( j, OtherDimension )
End If
Next
If swap_pos <> row Then
Resultados ( swap_pos, DimensionToSort ) = StartingKeyValue
Resultados ( swap_pos, OtherDimension ) = StartingOtherValue
Resultados ( row, DimensionToSort ) = NewStartingKey
Resultados ( row, OtherDimension ) = NewStartingOther
End If
Next
End Sub
%>
<html>
<body>
<p align="left">
<font color="#FF0000" face="Comic Sans MS" size="2">Aprendiz
de todo y maestro de nada[/CODE]</p>
</body>
</html>