[Resolvido] motor de busca

[xanburzum 169]

Este é um motor de busca que cria a sua própria barra de progresso e vai pesquisar recursivamente a pasta é colocado e um número infinito de sub-pastas para a expressão.

 

<%

function current_path()
  path=Request.ServerVariables("PATH_TRANSLATED") 
  for zz=1 to len(path) 
   z=(len(path)+1)-zz
   if mid(path,z,1)="\" then
    path=left(path,z)
    exit for
   end if
  next
  current_path=path
 end function
 
  'Check variável de sessão 
 stage=session("stage")
 if len(stage)=0 then
  session("stage")=0
  session("strPhrase")=""
  session("intMatches")=0
  session("arrMatches")=""
  session("arrMatchTitles")=""
  session("arrMatchPoints")=""
  session("arrMatchOrder")=""
  session("intResultsPosition")=0
  stage=0
 else
  
  strNewSearch=request.form("new")
  strPhrase=request.form("text")
  strShowResults=request.form("results")
  strNext=request.form("next")  
  strBack=request.form("back")  
  
  if len(strPhrase)=0 then
   strPhrase=session("strPhrase")
  else
   session("strPhrase")=strPhrase
  end if
  
  if len(strNext) then
   session("intResultsPosition")=session("intResultsPosition")+10
  end if
  
  if len(strBack) then
   session("intResultsPosition")=session("intResultsPosition")-10
  end if
  
  if strNewSearch="New search" or len(strPhrase)=0 then
   session("stage")=""
   session("strPhrase")=""
   session("intMatches")=0
   session("arrMatches")=""
   session("arrMatchTitles")=""
   session("intResultsPosition")=0
   session("arrMatchPoints")=""
   session("arrMatchOrder")=""
   stage=0
  end if
  
 end if
 
' Response.Write("Stage " & stage & "<p>")
  
'Variável de configuração do redirecionamento
 intRedirect=0
 intPercent=0
 intShowNavigation=0
 
 if stage>2 then
  arrFileList=session("arrFileList")
  intFileList=ubound(arrFileList,1)
  intPercent=100/(intFileList+1)*(stage-2)
  if len(strShowResults) then stage=4+intFileList end if
 end if
 
 if stage=1 then%>
  <div align="center">
  <%Response.Write("Building index...<p>")%>
  </div>
  <%intRedirect=1
  session("start_time")=timer
 end if
 
 no=0
 
 if stage=2 then 
'Índice de extensões de arquivo para verificar
  Dim arrFileExt(8)
  intFileExt=8
  arrFileExt(1)=".htm"
  arrFileExt(2)=".html"
  arrFileExt(3)=".asp"
  arrFileExt(4)=".cfm"
  arrFileExt(5)=".cfml"
  arrFileExt(6)=".jsp"
  arrFileExt(7)=".php"
  arrFileExt(8)=".shtml"
 
  'Declare FileSystemObject
  Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
 
'qual é a pasta raiz do nosso site?
  strRootFolder = current_path()

'conjunto objeto para a pasta raiz da Web
  Set objFolder = objFSO.GetFolder(strRootFolder)

  'Declare um objeto file
  Dim objFile

  dim arrFileList()

  intFileCount=0
  intFileMatches=0
  
  indexFiles objFolder,""
  
  function indexFiles(ByRef objFolder, byval path)
   For Each objFile in objFolder.Files
'  Response.Write objFile.Name & " (" & objFile.Size & " bytes)<BR>"   
    intFileCount=intFileCount+1
    for z=1 to intFileExt
     strFilename=objFile.Name
     if len(strFilename)>len(arrFileExt(z)) then
      if LCase(Right(strFilename,len(arrFileExt(z)))) = LCase(arrFileExt(z)) and LCase(strFilename)<>"dir3.asp" then
       intFileMatches=intFileMatches+1
       redim preserve arrFileList(intFileMatches)
        arrFileList(intFileMatches)=path & objFile.Name
'       Response.Write arrFileList(intFileMatches)& "<p>"
       exit for
      end if
     end if
    next
   Next
  
   For Each Folder In objFolder.SubFolders
 '  response.Write(Folder.name &"<p>")
   indexFiles Folder,path & folder.name & "\"
   next  
  end function
  
  session("arrFileList")=arrFileList
  intRedirect=1
 end if
 
 if stage>2 then
  if session("intMatches")>0 then
   arrMatches=session("arrMatches")
   arrMatchTitles=session("arrMatchTitles")
   arrMatchPoints=session("arrMatchPoints")
   arrMatchOrder=session("arrMatchOrder")
  end if
  
  intCounter=stage-2
  if intCounter<=intFileList then
   Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
   set file=objFSO.OpenTextFile(current_path() & arrFileList(intCounter))

	strSearchThis = file.ReadAll
	if instr(LCase(strSearchThis), LCase(session("strPhrase"))) > 0 then
	 session("intMatches")=session("intMatches")+1
	 redim preserve arrMatches(session("intMatches")+1)
     redim preserve arrMatchTitles(session("intMatches")+1)
	 redim preserve arrMatchPoints(session("intMatches")+1)
	 redim preserve arrMatchOrder(session("intMatches")+1)
	 arrMatchOrder(session("intMatches"))=session("intMatches")
	 arrMatches(session("intMatches"))=arrFileList(intCounter)
	 arrMatchTitles(session("intMatches"))="{No Title}"
	 
	 strNewSearch=strSearchThis
	 do
	  a=instr(LCase(strNewSearch), LCase(session("strPhrase")))
	  if a=0 then exit do
	  arrMatchPoints(session("intMatches"))=arrMatchPoints(session("intMatches"))+1
	  strNewSearch=right(strNewSearch,len(strNewSearch)+1-(a+len(session("strPhrase"))))
	 loop
	 
	 'arrFileList(intCounter)
	 intStart=instr(LCase(strSearchThis),LCase("<Title>"))
	 if intStart then
	  intStart=intStart+7
      arrMatchTitles(session("intMatches"))=mid(strSearchThis,intStart,(instr(LCase(strSearchThis),LCase("</Title>"))-intStart))
      if len(arrMatchTitles(session("intMatches")))=0 then
       arrMatchTitles(session("intMatches"))= "{No Title}"
       'arrFileList(intCounter)
      end if
	 end if
	end if
	
	session("arrMatches")=arrMatches
    session("arrMatchTitles")=arrMatchTitles
    session("arrMatchPoints")=arrMatchPoints
    session("arrMatchOrder")=arrMatchOrder
       
   file.close   
   intRedirect=1
  else
   intMatches=session("intMatches")
   arrMatchTitles=session("arrMatchTitles")
   arrMatches=session("arrMatches")
   arrMatchPoints=session("arrMatchPoints")
   arrMatchOrder=session("arrMatchOrder")

'   if 1=0 then
    'sort
    highest=0
    for z=1 to intMatches
     if arrMatchPoints(z)>highest then highest=arrMatchPoints(z) end if
    next
    
    do
    changed=0
     for z=2 to intMatches
      if arrMatchPoints(arrMatchOrder(z))>arrMatchPoints(arrMatchOrder(z-1)) then
       temp=arrMatchOrder(z)
       arrMatchOrder(z)=arrMatchOrder(z-1)
       arrMatchOrder(z-1)=temp
       changed=1
      end if
     next
     if changed=0 then exit do
    loop
'   end if
   
   %>
   <div align="center">
   <%intLoopStart=session("intResultsPosition")+1
   intLoopEnd=intLoopStart+9
   if intLoopEnd>session("intMatches") then intLoopEnd=session("intMatches") end if
   Response.Write("Results "& intLoopStart & "-" & intLoopEnd & " of "& session("intMatches") & "<p>")
   intShowNavigation=1%>
   <%' Response.Write(timer-session("start_time")) %>
   <table border=1>
    <tr>
     <td>
      Matches
     </td>
     <td>
      Bet
     </td>
    </tr>
   <%for z=intLoopStart to intLoopEnd%>
    <tr>
     <td>
      <a href="<%=arrMatches(arrMatchOrder(z))%>"><%=arrMatchTitles(arrMatchOrder(z))%></a>
     </td>
     <td>
      <%=CInt(100/highest*arrMatchPoints(arrMatchOrder(z)))%>%
     </td>
    </tr>
   <%next%>
   </table>
   </div>
  <%'session("stage")=0
  'session("strPhrase")=""
  'session("intMatches")=0
  'session("arrMatches")=""
  'session("arrMatchTitles")=""
  'stage=0
  no=1 
  end if
 end if
%>

<%if intRedirect then
  session("stage")=session("stage")+1%>  
 <body onload="window.location='dir3.asp'">
<%end if%>

<p></p>

<div align="center">
 <form action="dir3.asp" method="post" id=form1 name=form1>
  <%if stage>0 and stage<3+intFileList then 
   Response.Write(CInt(intPercent) & "% of search completed...<p>") 
   Response.Write("Matches found : " & session("intMatches") & "<p>")
   %>
   <p>
   <table width="250" height="20" border="1">
    <tr>
     <td bgcolor="blue" width="<%=CInt(intPercent)%>%"> </td>
     <td width="<%=100-CInt(intPercent)%>%"> </td>
    </tr>
   </table>
   <p>
   <% 
   if session("intMatches")>0 then%>
    <input type="submit" value="Show results" name=results></input>
    <p>
    <p>
   <%end if
  end if
   if intShowNavigation then%>
    <p>
    <table width="100%">
     <tr>
      <td width="50%">
       <%if intLoopStart>1 then%>
        <input type="submit" value="Previous" name=Back ></input>
       <%end if%>
      </td>
      <td width="50%">
       <%if intLoopEnd<session("intMatches") then%>
         <div align="right">
         <input type="submit" value="Next" name=next ></input>
         </div>
       <%end if%>
      </td>
     </tr>
    </table>
    <p>
   <%end if%>
  <input type="submit" value="New search" name=new></input>
  <%if stage=0 and no=0 then%>
   <p>
   Digite aqui sua frase de busca...<p>
   <input type="text" name=text></input><p>
   <input type="submit" value="Search" name=search></input> 
   <%session("stage")=1
   end if%>
 </form>

</div>