Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

C.Porto

[Resolvido] Busca por palavra e listar arquivos

Recommended Posts

Boa Tarde,

Estou desenvolvendo um sistema que busca de arquivos de imagem. Aqui está funcionando diretinho. Mas quando eu busca a palavra por exemplo "cha", ele nao retorne nenhum arquivos no diretorio, falando que "0 encontrados", mas tem arquivo de imagem chamado cha.

Alguem sabe aruumar para mim?

 

Aqui esta o codigo:

 

arquivo 01.asp = o usuario digita a palavra

 

<%@LANGUAGE="VBSCRIPT" CODEPAGE="1252"%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
<title>Untitled Document</title>
</head>

<body>
<table cellspacing=2 cellpadding=2 border=0 align="center">
	<tbody> 
		<tr valign=bottom align=middle> 
			<td width="172" bgcolor="#8CA6CE"><b><font color="#FFFFFF" size="2" face="Arial, Helvetica, sans-serif">Pesquisa:</font></b></td>
		</tr>
			<tr valign=top align=middle> 
				<td> 
					<table cellspacing=0 cellpadding=1 width=171 border=0 bgcolor=#8CA6CE>
						<tbody> 
			<tr> 
				<td width="100%"> <font face="verdana, arial, helvetica" size=-1><small> </small></font> 
	<table cellspacing=0 cellpadding=4 width="100%" bgcolor=#8CA6CE border=0>
						<tbody> 
			<tr> 
<!-- 
The chuck of code generates the search box. Every page that has a search box needs it. 
//-->
<form action="02.asp" method="post">
	<td align=left bgcolor="#FFFFFF"> 
		<input class="formcreate" type="text" name="txtKeyWord" size="22"><input class="formcreate" type="submit" value="Ir" name="search"> 
	</td>
</form>
<!--
End of the search form
//-->
</tr>
</tbody> 
</table>
</td>
</tr>
</tbody> 
</table>
</td>
</tr>
</tbody> 
</table>
</body>
</html>

 

arquivo: 02.asp = esse retorna a busca digitada

<%@LANGUAGE="VBSCRIPT" CODEPAGE="1252"%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">

<%

'Option Explicit

Response.Buffer = True

' Configure alguns objetos FileSystem
dim objFS, objFolder, objFiles, File, FileName, objCheckFile, strSitePath
set objFS = server.CreateObject("Scripting.FileSystemObject")

dim strListofFiles, arrFileList, strPageTitle, iReturnCount
dim objFolders

strListofFiles = ""
iReturnCount = 0

' Os valores de pesquisa, espaço de pesquisa, eo valor de retorno
dim strKeyWord, strFileContents, returnValue, arrKeyWords
dim bKeyWordFound, i, j

'diretorio = request.querystring("F:\ARQUIVOS PORTAL2\Banco de Imagens Oficial")
'if diretorio = "" then
'Obter o caminho físico para o diretório atual
strSitePath = Server.MapPath(".")


'Pegue os keyworlds e dividi-los em uma matriz
strKeyWord = Trim(request("txtKeyWord"))
arrKeyWords = split(strKeyWord," ")

' obter a lista de arquivos
Set objFolder = objFS.GetFolder(strSitePath)



'Sub que pega todos os "htm." & ". Html" arquivos na pasta e dado
'Recurses através de todas as subpastas.

sub getCompleteFileList(inFolder, Path)

dim oFiles, oFolders, Folder, sPath


'obter todos os arquivos e subpastas
Set oFiles = inFolder.Files
Set oFolders = inFolder.SubFolders

' Se temos uma subpasta precisamos do caminho parcial
if (Path <> "") then
sPath = Path + "\"
end if

'Adicione cada "htm." & ". Html" arquivo à lista
For Each File in oFiles
FileName = File.Name

if((Lcase(right(FileName,4)) = ".jpeg") OR (Lcase(right(FileName,5)) = ".jpeg" )) then
if (strListofFiles = "") then
strListofFiles = sPath + FileName
else 
strListofFiles = strListofFiles + "," + sPath + FileName
end if 
end if
Next

' Check all the subfolders for ".htm" & ".html" files
'checa todos os subpastas dos arquivos

For Each Folder in oFolders
if (Folder.Name <> "images" AND Folder.Name <> "stats") then 
call getCompleteFileList(Folder, sPath + Folder.Name)
end if
Next

' Clean up 
'Limpe

set File = Nothing
set oFiles = Nothing
set Folder = Nothing
set oFolders = Nothing

end sub

%>

<html>
<head>
	<title>Resultado de Busca </title>
	<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
</head>

	<body bgcolor="#FFFFFF" text="#000000">
			<table cellspacing=7 cellpadding=2 border=0 width="100%">
	<tbody> 
		<tr> 
				<td valign=top align=middle> 
			<table cellspacing=0 width="100%" border=0>
	<tbody> 
		<tr> 
				<td align=middle bgcolor=#3366cc> 
			<table cellspacing=0 cellpadding=2 width="100%" border=0>
	<tbody> 
		<tr> 
				<td align=middle bgcolor=#ffffff> 
			<table cellspacing=0 width="100%" border=0>
	<tbody> 
		<tr bgcolor="#F2F2F2"> 
				<td align=middle colspan=4 bgcolor="#F2F2F2"> 
	<div align="left"><b>Resultado de Busca</b></div>
			</td>
		</tr>
			<tr bgcolor="#F2F2F2"> 
				<td align=middle colspan=4 bgcolor="#FFFFFF"> 
	<div align="left"></div>
		<p align="left"> 
<!-- 
O início da pesquisa código html específico.
Ela precisa de um olhar e sentir atualização.
//-->
		</p>
	<table width="95%" border="0" cellspacing="1" cellpadding="1" align="center">
		<tr bgcolor="#330099"> 
			<td bgcolor="#FFFFFF"> 
	<div align="left">
		<font color="#FFFFFF"><b> <font color="#666666">Você procurou por: </font>
		<font color="#000000"> </font></b><font color="#000000"><font color="#FF0000"><%= strKeyWord%></font></font></font></div>
			</td>
		</tr>
<%

'Somente na busca nós temos pelo menos uma palavra-chave
if (strKeyWord <> "") then

'Chame o sub que recebe todos os arquivos
call getCompleteFileList(objFolder, "")

'Tome a corda grande ole o contém todos os arquivos separados por vírgulas e cortá-la.
arrFileList = split(strListofFiles,",")

For i=0 to UBound(arrFileList)

'Abra o arquivo atual e ler tudo em uma única seqüência.
'Se os arquivos são enormes isso poderia comer muito ou recursos.
Set objCheckFile = objFS.OpenTextFile(strSitePath + "\" + arrFileList(i),1,false,0)
strFileContents = objCheckFile.ReadAll

' Padrão, o sinalizador de pesquisa para false.
bKeyWordFound = false

' Para cada palavra-chave digitada pesquisar o arquivo.
for j = 0 to UBound(arrKeyWords) 
returnValue = InStr(1,strFileContents,arrKeyWords(j),1)

'Se o valor de retorno não é zerar a palavra-chave foi encontrada
'Definir o flage pesquisa para corte verdade e curto fora do circuito.
if (returnValue <> 0) then
bKeyWordFound = true
j = UBound(arrKeyWords)
end if
next

' Se uma palavra-chave foi encontrada incluir esse arquivo na lista.
if (bKeyWordFound) then

' Manter o controle do número de resultados e pegar o título da página para a exibição de pesquisa
iReturnCount = iReturnCount + 1

dim startChar, endChar
startChar = InStr(1,strFileContents,"<title>",1)
endChar = InStr(1,strFileContents,"</title>",1)

if (startChar = 0 OR endChar = 0 OR ((startChar + 7) > (endChar - 7))) then
%>
		<tr> 
<td><font face="Arial, Helvetica, sans-serif" size="2"><a href="<%= arrFileList(i) %>"><%= arrFileList(i) %></a> <%= arrFileList(i) %></font></td>
		</tr>
<% 
else 
strPageTitle = mid(strFileContents,InStr(1,strFileContents,"<title>",1) + 7, InStr(1,strFileContents,"</title>",1) - InStr(1,strFileContents,"<title>",1) - 7)

if (strPageTitle = "") then
strPageTitle = arrFileList(i)
end if
%>
		<tr> 
<td><font face="Arial, Helvetica, sans-serif" size="2"><a href="<%= arrFileList(i) %>"><%= strPageTitle%></a> <%= arrFileList(i) %></font></td>
		</tr>
<% 
end if
end if

' Feche o arquivo para que possamos abrir um outro. 
objCheckFile.Close
Next

end if
%>
		<tr> 
<td><font face="Arial, Helvetica, sans-serif" size="2" color="#999999"><%= iReturnCount%> Páginas Encontradas</font></td>
		</tr>
		<tr> 
<td> </td>
		</tr>
<%

' Limpar todos os objetos usados.
set objCheckFile = Nothing
set File = Nothing
set objFiles = Nothing
set objFolder = Nothing
set objFS = Nothing


%>
					</table>
<!-- O fim da busca em html -->
				</td>
			</tr>
	</tbody> 
					</table>
				</td>
			</tr>
	</tbody> 
					</table>
				</td>
			</tr>
	</tbody> 
					</table>
				</td>
			</tr>
	</tbody> 
					</table>
<p> </p>
	</body>
</html>

 

 

Espero q alguem me ajuda!

No aguardo! :)

Compartilhar este post


Link para o post
Compartilhar em outros sites

poste o trecho que esta fazendo a pesquisa...

 

e para otimizar a busca aconselho a usar banco de dados e fazendo a consulta pela SQL, fica mais rápido, ou usar um code tipo explorer, postei um miuto bom, você pode usá-lo.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Oi, xanburzum! Obg por me retorna a resposta!

 

Consegui que ele lista todos os arquivos no diretorio. Mas eu nao conseguindo é, o usuario digita uma palavra e mostra o resultado.

 

Olha o trecho que eu consegui que mostra o resultado:

 


'Adicione cada "htm." & ". Html" arquivo à lista
For Each File in oFiles
FileName = File.Name
response.Write(FileName) + "<br>"

if((Lcase(right(FileName,4)) = ".jpeg") OR (Lcase(right(FileName,5)) = ".jpeg" ))  then

	if (strListofFiles = "") then
		strListofFiles = sPath + FileName
	else 
		strListofFiles = strListofFiles + "," + sPath + FileName
	end if 
	response.Write(strListofFiles) + "<br>"
end if
Next

 

Mas naõ consegui é o usuario digita e mostra o resultado. Como esse codigio:

 

strSitePath = Server.MapPath(".")
response.Write(strSitePath)


'Pegue os keyworlds e dividi-los em uma matriz
strKeyWord = Trim(request("txtKeyWord"))
arrKeyWords = split(strKeyWord," ")


' obter a lista de arquivos
Set objFolder = objFS.GetFolder(strSitePath)

 

Como o codigo em cima, o txtKeyWord é o input name do html.

Alguem me ajudaa?

 

Olha nao uso o banco, mas consegui mostra o arquivo do diretorio, porem ele retorna o monte de arquivo e não o usuario digita uma palavra especifica para mostra quantas existe esse arquivo apos o usario digita.

 

No aguardo!

 

:)

Compartilhar este post


Link para o post
Compartilhar em outros sites

plá amigo eu testei e consegui localizar arquivos que digitei, mas tem alguns exemplos que postei no fórum, dá uma pesquisada, olha um que sempre uso:

 

<% Option Explicit %>
<% 
'Set the response buffer to true.
Session.LCID="1046"
Response.Buffer = False 

'Dimension global variables
Dim fsoObject			'File system object
Dim fldObject			'Folder object	
Dim sarySearchWord		'Array to hold the words to be searched for
Dim strSearchWords		'Holds the search words
Dim blnIsRoot			'Set to true if we are searching in the root directory
Dim strFileURL			'Holds the path to the file on the site
Dim strServerPath		'Holds the server path to this script
Dim intNumFilesShown		'Holds the number of files shown so far
Dim intTotalFilesSearched	'Holds the number of files searched
Dim intTotalFilesFound		'Holds the total matching files found
Dim intFileNum			'Holds the file number
Dim intPageLinkLoopCounter	'Loop counter to display links to the other result pages
Dim sarySearchResults(1000,2)	'Two Dimensional Array holding the search results
Dim intDisplayResultsLoopCounter 'loop counter to diplay the results of the search
Dim intResultsArrayPosition	'Stores the array position of the array storing the results
Dim blnSearchResultsFound	'Set to true if search results are found
Dim strFilesTypesToSearch	'Holds the types of files to be searched
Dim strBarredFolders		'Holds the folders that you don't want searched
Dim strBarredFiles		'Holds the names of the files not to be searched
Dim blnEnglishLanguage		'Set to True if the user is using English



' -------------------------- Change the following line to the number of results you wish to have on each page ------------------------------------
Const intRecordsPerPage = 10 'change this to the number of results to show on each page

' --------------------- Place the names of the files types you want searching in the following line sepeararted by commas --------------------------
strFilesTypesToSearch = "htm,html,asp,shtml,txt,doc,gif,xml,xsl,aspx" 

' --------------------- Place the names of the folders you don't want searched in the following line spearated by commas --------------------------
strBarredFolders = "cgi_bin,_bin" 'cgi_bin and _bin have been put in here as examples, but you can put any folders in here

' ---------- Place the names of the files you don't want searched in the following line spearated by commas include the file extension -------------
strBarredFiles = "adminstation.htm,no_allowed.asp" 'adminstration.htm and not_allowed.asp have been put in as an examples

' -------------------- Set this boolean to False if you are not using an English language web site --------------------------------------------------
blnEnglishLanguage = True 'True = HTML Encode best for English sites \ False = no Emcoding best for non English sites

'-----------------------------------------------------------------------------------------------------


'Initalise variables
intTotalFilesSearched = 0

%>
<html>
<head>
<title>Busca</title>
<meta name="Description" content="Search the web site for pages or information that you are after">
<meta name="KeyWords" content="site search">



<!-- Check the from is filled in correctly before submitting -->
<script  language="JavaScript">
<!-- Hide from older browsers...

//Preload search icon
var search_icon_off = new Image(); 
search_icon_off.src = "site_search_icon_off.gif";

//Check the form before submitting
function CheckForm () {

//Check for a word to search
if (document.frmSiteSearch.search.value==""){
	alert("Porfavor entre com uma ou mais palavras para a busca.");
	document.frmSiteSearch.search.focus();
	return false;
}

return true
}
// -->
</script>

</head>
<body bgcolor="#FFFFFF" text="#000000" link="#0000CC" vlink="#0000CC" alink="#FF0000">
<h1 align="center"><font size="4" face="Verdana, Arial, Helvetica, sans-serif"><strong> 
 Busca</strong></font></h1>

<form method="get" name="frmSiteSearch" action="site_search.asp" onSubmit="return CheckForm();">
 <table cellpadding="0" cellspacing="0" width="90%" align="center">
   <tr> 

  <td height="66" width="165" align="right" rowspan="3" valign="middle"><img src="site_search_icon_on.gif" width="58" height="52" align="absmiddle" alt="Search the Web Site" name="searchIcon">   </td>
     <td height="66" width="15" align="right" rowspan="3" valign="middle"> </td>
     <td class="arial" height="4" width="571"> <font size="1" face="Verdana, Arial, Helvetica, sans-serif"><strong>Pesquisa 
       no Site:</strong> </font></td>
   </tr>
   <tr> 
     <td class="normal" height="2" width="571">
     <input type="TEXT" name="search" maxlength="50" size="36" value="<% =Request.QueryString("search") %>">
       <input type="submit" value="Pesquisa >>" name="submit">
       </td>
   </tr>
   <tr> 
     <td class="normal" height="34" width="571" valign="top"> <font size="1" face="Verdana, Arial, Helvetica, sans-serif">Pesquisa 
       em: 
       <input type="radio" name="mode" value="allwords" CHECKED>
       Todas as palavras 
       <input type="radio" name="mode" value="anywords">
       Qualquer palavra 
       <input type="radio" name="mode" value="phrase">
       Frase</font></td>
   </tr>
 </table>
</form>

<%

'Read in all the search words into one variable
strSearchWords = Trim(Request.QueryString("search"))

'If the site is in English then use the server HTML encode method
If blnEnglishLanguage = True Then
'Replace any HTML tags with the HTML codes for the same characters (stops people entering HTML tags)
strSearchWords = Server.HTMLEncode(strSearchWords)

'If the site is not english just change the script tags
Else
'Just replace the script tag <> with HTML encoded < and >
strSearchWords = Replace(strSearchWords, "<", "<", 1, -1, 1)
strSearchWords = Replace(strSearchWords, ">", ">", 1, -1, 1)
End If

'Slit each word to be searched up and place in an array
sarySearchWord = Split(Trim(strSearchWords), " ")



'Read the file number to show from
intFileNum = CInt(Request.QueryString("FileNumPosition"))

'Set the number of files shown so far to the file number read in above
intNumFilesShown = intFileNum


'Create the file system object
Set fsoObject = Server.CreateObject("Scripting.FileSystemObject")


'If there is no words entered by the user to search for then dont carryout the file search routine
If NOT strSearchWords = "" Then


'Get the path and the root folder to be searched
Set fldObject = fsoObject.GetFolder("C:\Inetpub\wwwroot")

'Read in the server path to this ASP script
strServerPath = fldObject.Path & "\"

'Set to true as this is searching the root directory
blnIsRoot = True

'Call the search sub prcedure
Call SearchFile(fldObject)			

'Reset server variables
Set fsoObject = Nothing
Set fldObject = Nothing	


'Call the Bubble Sort procedure to sort the results into highest matches first
Call SortResultsByNumMatches(sarySearchResults, intTotalFilesFound)


'Display the HTML table with the results status of the search or what type of search it is
Response.Write vbCrLf & "	<table width=""98%"" border=""0"" cellspacing=""1"" cellpadding=""1"" align=""center"" bgcolor=""#CCCCCC"">"
Response.Write vbCrLf & " 	  <tr>"

'Display that there where no matching records found
If blnSearchResultsFound = False Then 
	Response.Write vbCrLf & " 	    <td> Pesquisa nos arquivos por: <b>" & strSearchWords & "</b>.    Desculpe nenhum resultado encontrado.</td>"   

'Else Search went OK so display how many records found
Else	
	Response.Write vbCrLf & " 	    <td> Pesquisa nos arquivos por: <b>" & strSearchWords & "</b>.    Mostrando resultados " & intFileNum + 1 & " - " & intNumFilesShown & " of " & intTotalFilesFound & ".</td>"	    
End If

'Close the HTML table with the search status
Response.Write vbCrLf & "	  </tr>"
Response.Write vbCrLf & "	</table>"


'HTML table to display the search results or an error if there are no results
Response.Write vbCrLf & "	<table width=""95%"" border=""0"" cellspacing=""1"" cellpadding=""1"" align=""center"">"
Response.Write vbCrLf & "	 <tr>" 
Response.Write vbCrLf & "	  <td>"   

'If no results are found then display an error message
If blnSearchResultsFound = False Then 

	'Write HTML displaying the error
	Response.Write vbCrLf & "	  <br>"
	Response.Write vbCrLf & "	   Sua Pesquisa - <b>" & strSearchWords & "</b> - não existe nenhuma ocorrência em nossos arquivos."
   	Response.Write vbCrLf & "	   <br><br>"
   	Response.Write vbCrLf & "	   Sugestão:"
   	Response.Write vbCrLf & "	   <br>"
   	Response.Write vbCrLf & "	   <ul><li>Faça uma outra pesquisa com as palavras corretas.<li>Tente diferentes palavras.<li>Tente palavras mais comuns.<li>Tente outras palavras</ul>"

'Else display the results
Else

	'Loop round to display each result within the search results array
	For intDisplayResultsLoopCounter = (intFileNum + 1) to intNumFilesShown

		Response.Write vbCrLf & "	     <br>"
		Response.Write vbCrLf & "	    " & sarySearchResults(intDisplayResultsLoopCounter,1)
		Response.Write vbCrLf & "	     <br>"
	Next
End If

'Close the HTML table displaying the results
Response.Write vbCrLf & "	    </td>"
Response.Write vbCrLf & "	  </tr>"
Response.Write vbCrLf & "	</table>"

End If


'Display an HTML table with links to the other search results
If intTotalFilesFound > intRecordsPerPage then

'Display an HTML table with links to the other search results
Response.Write vbCrLf & "	<br>"
Response.Write vbCrLf & "	<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""0"" align=""center"">"
Response.Write vbCrLf & " 	  <tr>"
Response.Write vbCrLf & " 	    <td>"
Response.Write vbCrLf & "		<table width=""100%"" border=""0"" cellpadding=""0"" cellspacing=""0"">"
Response.Write vbCrLf & "		  <tr>"
Response.Write vbCrLf & "		    <td width=""50%"" align=""center"">"

Response.Write vbCrLf & "		Results Page:  "


'If the page number is higher than page 1 then display a back link    	
If intNumFilesShown > intRecordsPerPage Then 
	Response.Write vbCrLf & "		 <a href=""site_search.asp?FileNumPosition=" &  intFileNum - intRecordsPerPage  & "&search=" & Replace(strSearchWords, " ", "+") & "&mode=" & Request.QueryString("mode") & """ target=""_self""><< Prev</a> "   	     	
End If     	


'If there are more pages to display then display links to all the search results pages
If intTotalFilesFound > intRecordsPerPage Then 

	'Loop to diplay a hyper-link to each page in the search results    	
	For intPageLinkLoopCounter = 1 to CInt((intTotalFilesFound / intRecordsPerPage) + 0.5)

		'If the page to be linked to is the page displayed then don't make it a hyper-link
		If intFileNum = (intPageLinkLoopCounter * intRecordsPerPage) - intRecordsPerPage Then
			Response.Write vbCrLf & "		     " & intPageLinkLoopCounter
		Else

			Response.Write vbCrLf & "		      <a href=""site_search.asp?FileNumPosition=" &  (intPageLinkLoopCounter * intRecordsPerPage) - intRecordsPerPage & "&search=" & Replace(strSearchWords, " ", "+") & "&mode=" & Request.QueryString("mode") & """ target=""_self"">" & intPageLinkLoopCounter & "</a>  "			
		End If
	Next
End If


'If it is Not the last of the search results than display a next link     	
If intTotalFilesFound > intNumFilesShown then   	
	Response.Write vbCrLf & "		 <a href=""site_search.asp?FileNumPosition=" &  intNumFilesShown  & "&search=" & Replace(strSearchWords, " ", "+") & "&mode=" & Request.QueryString("mode") & """ target=""_self"">Next >></a>"	   	
End If      	


'Finsh HTML the table      	
Response.Write vbCrLf & "		    </td>"      	
Response.Write vbCrLf & "		  </tr>"
Response.Write vbCrLf & "		</table>"		
Response.Write vbCrLf & "	    </td>"
Response.Write vbCrLf & "	  </tr>"
Response.Write vbCrLf & "	</table>"


End If 

%>
<br>
<div align="center">  
 <table width="98%" border="0" cellspacing="1" cellpadding="1" bgcolor="#CCCCCC" align="center">
   <tr> 

     <td width="47%" height="18"><font size="1" face="Verdana, Arial, Helvetica, sans-serif"> Total 
       de documentos encontrados:</font> 
       <% = intTotalFilesSearched  %>
     </td>
       <td width="53%" align="right" height="18"><%				  
'***** START WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ****** 
Response.Write("		Powered By - <a href=""xanburzum"" target=""_blank"">www.freecode.com.br</a>")
'***** END WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ****** 
%>
      </td>
     </tr>
   </table>
   <!-- Swap animated search icon for still icon -->
   <script langauge="JavaScript">document.searchIcon.src = search_icon_off.src</script>
   <br>
</div>
<br>
</body>
</html>
<%



'Sub procedure to do the search
Public Sub SearchFile(fldObject)

'Dimension local variabales
Dim objRegExp				'Regular Expersions object
Dim objMatches				'Holds the matches collection of the regular expresions object
Dim filObject				'File object
Dim tsObject				'Text stream object
Dim subFldObject			'Sub folder object
Dim strFileContents			'Holds the contents of the file being searched	
Dim strPageTitle			'Holds the title of the page
Dim strPageDescription			'Holds the description of the page
Dim strPageKeywords			'Holds the keywords of the page
Dim intSearchLoopCounter		'Loop counter to search all the words in the array
Dim intNumMatches			'Holds the number of matches
Dim blnSearchFound			'Set to true if the search words are found	

'Error handler
On Error Resume Next

'Set the error object to 0
Err.Number = 0

'Create the regular expresions object
Set objRegExp = New RegExp

'If an error has occured then the server does not support Regular Expresions
If Err.Number <> 0 Then 
	Response.Write("<br>Erro: O Servidor não suporta Regular Expessions object<br>Porfavor faça o download da versão alternativa em http://www.webwizguide.info/asp/sample_scripts/site_search_script.asp")

	'Reset error object
	Err.Number = 0
End If

'Loop to search each file in the folder
For Each filObject in fldObject.Files


	'Check the file extension to make sure the file is of the extension type to be searched
	If InStr(1, strFilesTypesToSearch, fsoObject.GetExtensionName(filObject.Name), vbTextCompare) > 0 Then

	  	'Check to make sure the file about to be searched is not a barred file if it is don't search the file
		If NOT InStr(1, strBarredFiles, filObject.Name, vbTextCompare) > 0 Then		  	

	  		'Initalise the search found variable to flase
		 	blnSearchFound = False

	  		'Initalise the number of matches variable
	  		intNumMatches = 0		  	

	  		'Set the regular exprsion object to read all cases of the occurance not just the first
	  		objRegExp.Global = True

	  		'Set the regular expression object to ignore case
	  		objRegExp.IgnoreCase = True



		  	'Open the file for searching
		    	Set tsObject = filObject.OpenAsTextStream

			'Read in the contents of the file
		   	strFileContents = tsObject.ReadAll		

			'Read in the title of the file
			strPageTitle = GetFileMetaTag("<title>", "</title>", strFileContents)

			'Read in the description meta tag of the file
			strPageDescription = GetFileMetaTag("<meta name=""description"" content=""", """>", strFileContents)

		 	'Read in the keywords of the file
		 	strPageKeywords = GetFileMetaTag("<meta name=""keywords"" content=""", """>", strFileContents)



		 	'Set the pattern using regular expressions to srip any HTML tags
		 	objRegExp.Pattern = "<[^>]*>"

		 	'Strip HTML tags from the contects of the file to be searched
		 	strFileContents = objRegExp.Replace(strFileContents,"")

		 	'Put the tittle, description and the keywords back into the file to be searched
		 	strFileContents = strFileContents & " " & strPageTitle & " " & strPageDescription & " " & strPageKeywords



		 	'If the user has choosen to search by phrase 
		 	If Request.QueryString("mode") = "phrase" Then

		 		'Set the pattern to search for
		 		objRegExp.Pattern = "\b" & strSearchWords & "\b"

		 		'Search the file for the phrase
		 		Set objMatches = objRegExp.Execute(strFileContents)

		 		'Check to see if the phrase has been found
		 		If objMatches.Count > 0 Then

		 			'Get the number of times the phrase is matched
		 			intNumMatches = objMatches.Count

		 			'If the search is found then set the search found variable to true
		 			blnSearchFound = True
		 		End If


		 	'Else the search is either by all or any words
		 	Else

		 		'If the search is by all words then initialise the search found variable to true
			 	If Request.QueryString("mode") = "allwords" then blnSearchFound = True


			 	'Loop round to search for each word to be searched
			 	For intSearchLoopCounter = 0 to UBound(sarySearchWord)

			 		'Set the pattern to search for
			 		objRegExp.Pattern = "\b" & sarySearchWord(intSearchLoopCounter) & "\b"

			 		'Search the file for the search words
			 		Set objMatches = objRegExp.Execute(strFileContents)

				    	'Check to see if any of the words have been found
				    	If objMatches.Count > 0 Then 

				    		'Get the number of times the search word is matched
		 				intNumMatches = intNumMatches + objMatches.Count

			    			'If the search word is found and the search is for any words then set the search found variable to true
			    			If Request.QueryString("mode") = "anywords" then blnSearchFound = True

			    		Else
			    			'If the search word is not found and the search is for all words then set the search found variable back to false as one of the words has not been found
			    			If Request.QueryString("mode") = "allwords" then blnSearchFound = False

			    		End If
			    	Next
		    	End If


		    	'Calculate the total files searched
		    	intTotalFilesSearched = intTotalFilesSearched + 1



		    	'If the page contains no title then Page Title variable the appropriate message to display
		    	If strPageTitle = "" Then strPageTitle = "Sem Titulo"

		    	'If the page contains no title then Page Description variable the appropriate message to display
		    	If strPageDescription = "" Then strPageDescription = "Descrição do arquivo (pagina)"



		    	'If the search found variable is true then display the results
		    	If blnSearchFound = True Then


				'Calculate the total files found 
				intTotalFilesFound = intTotalFilesFound + 1


				'Check that the file shown is between the the files shown so far and the maximum files to show per page
				If  intNumFilesShown < (intRecordsPerPage + intFileNum) and intTotalFilesFound > intNumFilesShown Then

					'Calculate the number of results shown
					intNumFilesShown = intNumFilesShown + 1

				End If	



		       		'Place the search results into the saerch results array
		       		'Calculate the array position of the results array
		       		intResultsArrayPosition = intResultsArrayPosition + 1


		       		'Set the search results found boolean to true
		       		blnSearchResultsFound = True

				'If the file is in the root directory then
				If blnIsRoot = True Then


					'Place the search results into the search results array
					sarySearchResults(intResultsArrayPosition,1) = "<a href=""./" &  filObject.Name & """ target=""_self"">" & strPageTitle & "</a>" 


		       		'Else it is not in the root directiory
		       		Else
		       			'Place the search results into the search results array
		       			sarySearchResults(intResultsArrayPosition,1) = "<a href=""./" & strFileURL  & fldObject.Name & "/" & filObject.Name & """ target=""_self"">" & strPageTitle & "</a>"			   			   								

				End If						

				'Place the rest of the search results in the search results array
				sarySearchResults(intResultsArrayPosition,1) = sarySearchResults(intResultsArrayPosition,1) & vbCrLf & "        <br>" & strPageDescription
				sarySearchResults(intResultsArrayPosition,1) = sarySearchResults(intResultsArrayPosition,1) & vbCrLf & "        <font size=""2"" color=""#0000FF""><br><i>Search Matches " & intNumMatches & "  -  Last Updated " & FormatDateTime(filObject.DateLastModified, VbLongDate) & "  -  Size " & CInt(filObject.Size / 1024) & "kb</i></font>"



				'Read in the number of search word matches into the second part of the two dimensional array
				sarySearchResults(intResultsArrayPosition,2) = intNumMatches

	      		End If

			'Close the text stream object
	    		tsObject.Close
		End If
	End If
Next

'Reset the Regular Expression object
Set objRegExp = Nothing


'Loop to search through the sub folders within the site
For Each subFldObject In FldObject.SubFolders

	'Check to make sure the folder about to be searched is not a barred folder if it is then don't search
	If NOT InStr(1, strBarredFolders, subFldObject.Name, vbTextCompare) > 0 Then

		'Set to false as we are searching sub directories
		blnIsRoot = False


		'Get the server path to the file
		strFileURL = fldObject.Path & "\"

		'Turn the server path to the file into a URL path to the file
		strFileURL = Replace(strFileURL, strServerPath, "")

		'Replace the NT backslash with the internet forward slash in the URL to the file
		strFileURL = Replace(strFileURL, "\", "/")

		'Encode the file name and path into the URL code method
		strFileURL = Server.URLEncode(strFileURL)

		'Just incase it's encoded any backslashes
		strFileURL = Replace(strFileURL, "%2F", "/")

		'Call the search sub prcedure to search the web site
		Call SearchFile(subFldObject)
	End If
Next



'Reset server variables
Set filObject = Nothing
Set tsObject = Nothing
Set subFldObject = Nothing
End Sub




'Sub procedure to sort the array using a Bubble Sort to place highest matches first
Private Sub SortResultsByNumMatches(ByRef sarySearchResults, ByRef intTotalFilesFound)

'Dimension variables
Dim intArrayGap 		'Holds the part of the array being sorted
Dim intIndexPosition		'Holds the Array index position being sorted
Dim intTempResultsHold		'Temperary hold for the results if they need swapping array positions		
Dim intTempNumMatchesHold	'Temperary hold for the number of matches for the result if they need swapping array positions
Dim intPassNumber		'Holds the pass number for the sort


'Loop round to sort each result found
For intPassNumber = 1 To intTotalFilesFound

	'Shortens the number of passes
	For intIndexPosition = 1 To (intTotalFilesFound - intPassNumber)

		'If the Result being sorted hass less matches than the next result in the array then swap them
		If sarySearchResults(intIndexPosition,2) < sarySearchResults((intIndexPosition+1),2) Then


			'Place the Result being sorted in a temporary variable
			intTempResultsHold = sarySearchResults(intIndexPosition,1)

			'Place the Number of Matches for the result being sorted in a temporary variable
			intTempNumMatchesHold = sarySearchResults(intIndexPosition,2)


			'Do the array position swap

			'Move the next Result with a higher match rate into the present array location
			sarySearchResults(intIndexPosition,1) = sarySearchResults((intIndexPosition+1),1)

			'Move the next Number of Matches for the result with a higher match rate into the present array location
			sarySearchResults(intIndexPosition,2) = sarySearchResults((intIndexPosition+1),2)

			'Move the Result from the teporary holding variable into the next array position
			sarySearchResults((intIndexPosition+1),1) = intTempResultsHold

			'Move the Number of Matches for the result from the teporary holding variable into the next array position
			sarySearchResults((intIndexPosition+1),2) = intTempNumMatchesHold			
		End If
	Next			
Next					
End Sub




'Function to read in the files meta tags
Private Function GetFileMetaTag(ByRef strStartValue, ByRef strEndValue, ByVal strFileContents)

'Dimension Variables
Dim intStartPositionInFile	'Holds the start position in the file
Dim intEndPositionInFile	'Holds the end position in the file


'Get the start position in the file of the meta tag
intStartPositionInFile = InStr(1, LCase(strFileContents), strStartValue, 1)


'If no description or keywords are found then you may be using http-equiv= instead of name= in your meta tags
If intStartPositionInFile = 0 And InStr(strStartValue, "name=") Then

	'Swap name= for http-equiv= 
	strStartValue = Replace(strStartValue, "name=", "http-equiv=")

	'Check again for keywords or description
	intStartPositionInFile = InStr(1, LCase(strFileContents), strStartValue, 1)		
End If


'If there is a description then the position in file will be over 0
If NOT intStartPositionInFile = 0 Then

	'Get the end position of the HTML meta tag
	intStartPositionInFile = intStartPositionInFile + Len(strStartValue)

	'Get the position in file of the closing tag for the meta tag
	intEndPositionInFile = InStr(intStartPositionInFile, LCase(strFileContents), strEndValue, 1)

	'Read in the meta tag from the file for the function to return
	GetFileMetaTag = Trim(Mid(strFileContents, intStartPositionInFile, (intEndPositionInFile - intStartPositionInFile)))

'If the is no meta tag then the GetFileMetaTag function returns a null value
Else
	GetFileMetaTag = ""

End If

End Function
%>

Compartilhar este post


Link para o post
Compartilhar em outros sites

Boa tarde, amigo!

Obg por retorna novamente!

Olha esse codigo,ao executar, deu erro falando que "Expected end of statement" significa: "Final esperado de declaração". Eu olhei pelo codigo e coloquei End If mas apareceu o resultado Final esperado de declaração!

O que é que tem para colocar ai?

 

If NOT strSearchWords = "" Then        
'Get the path and the root folder to be searched        
Set fldObject = fsoObject.GetFolder("C:\Inetpub\wwwroot")                
'Read in the server path to this ASP script        
strServerPath = fldObject.Path & "\"                
'Set to true as this is searching the root directory       
blnIsRoot = True                        
'Call the search sub prcedure        
Call SearchFile(fldObject)                                      
'Reset server variables        
Set fsoObject = Nothing        
Set fldObject = Nothing                         
'Call the Bubble Sort procedure to sort the results into highest matches first        
Call SortResultsByNumMatches(sarySearchResults, intTotalFilesFound)                                
'Display the HTML table with the results status of the search or what type of search it is        
Response.Write vbCrLf & "       <table width=""98%"" border=""0"" cellspacing=""1"" cellpadding=""1"" align=""center"" bgcolor=""#CCCCCC"">"        Response.Write vbCrLf & "         <tr>"

 

No aguardo na sua resposta!

Compartilhar este post


Link para o post
Compartilhar em outros sites

estranho este code esta funcionando normalmente...

mas me passe o numero do código do erro e numero da inha

Compartilhar este post


Link para o post
Compartilhar em outros sites

Os codigos estão ai:

 

Response.Write vbCrLf & " <table width=""98%"" border=""0"" cellspacing=""1"" cellpadding=""1"" align=""center"" bgcolor=""#CCCCCC"">"        	              
Response.Write vbCrLf & "<tr>"

 

Mas as linhas é 167, porque eu arrumei quando copiei e colei.

 

Uma duvida amigo,sabe no formulario que voce colocou <form ....... action="site_search.asp">, esse eu sei, mas qual é a parte do codigo do site_search?

 

Eu acho é o desse aqui depois da tag </html>

 

<%
'Sub procedure to do the search
Public Sub SearchFile(fldObject)        
'Dimension local variabales       
Dim objRegExp                          
'Regular Expersions object       
Dim objMatches ......................

 

estou certo, amigo?

 

Opa, consegui esse linha....

Agora a parte tbm tem q esta Final de linha esperando da declaração...

 

Response.Write vbCrLf & "Sua Pesquisa - <b>" & strSearchWords & "</b> - não existe nenhuma ocorrência em nossos arquivos."

 

Vou tentar conseguir essa parte...

 

E quanto a isso, me responde xanburzun,no formulario que voce colocou <form ....... action="site_search.asp">, esse eu sei, mas qual é a parte do codigo do site_search?

 

----

 

 

opá, consegui novamente a linha que eu postei !!!

 

Agora,me responde so essa pergunta, xanburzun,no formulario que voce colocou <form ....... action="site_search.asp">, esse eu sei, mas qual é a parte do codigo do site_search?

é declarada depois da tag </html> ???

Compartilhar este post


Link para o post
Compartilhar em outros sites

ele gera o HTML dinamicamente

Compartilhar este post


Link para o post
Compartilhar em outros sites

×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.