Ir para conteúdo

POWERED BY:

Arquivado

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

Fábio BN

não busca palavras compostas

Por , em ASP Clássico

Recommended Posts

Fábio BN    17

Fábio BN
Postado

Oi pessoal, estou com uma dúvida numa busca.

 

Exemplo, o meu código busca palavras exatas e frases exatas, mas não busca palavras compostas tratando elas indivudualmente.

 

Exemplo: Se eu digitar na busca a palavra ( Mart ) Iá trazer todas as palavras que tenham "Mart" exatas, ou palavras que tenham Mart e mais alguma coisa, como Martelo. Até aqui tudo bem.

 

- A dúvida é, Como fazer o sistema buscar palavras digitadas se forma compostas, exemplo: A pessoa digita, "Martelo" e "Tempero". Como fazer para o sistema buscar as duas palavras juntas e listar?

 

- Lembrando, que se a pessoa escrever ( Martelo de Carne ) a palavra "de" não deve ser buscada, senão irá trazer muitos resultados falsos em tela! Como fazer então buscar comportas eliminando palavras como "de" ou "para". etc...

 

Meu código atual é:

sql = ("select * from tabela where estoque = "&estoque&" and produto like '%"&trim(busca)&"%' order by produto ")

Abraços - Fábio!

 

 

 

 

 

Compartilhar este post

Link para o post
Compartilhar em outros sites

xanburzum    169

xanburzum
Postado

dá uma olhada no fórum que coloquei um exemplo onde o user escolhe o tipo de busca, palavra exata, frase ou personalizar a busca (Todas as palavras, Qualquer palavra) dae você pode fazer como quiser

Compartilhar este post

Link para o post
Compartilhar em outros sites

Gustavo Emygdio Barboza    24

Gustavo Emygdio Barboza
Postado

pelo que entendi você terá que vetorizar a busca e ignorar os vetores com 2 ou 3 letras ou palavras específicas... para isso você terá que tratar a busca para concatenar em sua sql vamos ver um exemplo de sql buscando o que você quer...

 

select * from tabela where estoque = "&estoque&" and produto like '%Martelo%' or produto like '%Carne%' order by produto

 

a sql acima é o resultado de como deve deixar para fazer o que você quer... agora é como fazer isso!!

 

Function tratabusca(busca)
Dim tb
vet = Split(busca, " ")
For i = 0 To UBound(vet)
If Len(vet(i)) > 2 Then
If tb = "" Then
tb = "produto like '%" & vet(i) & "%'"
Else
tb = tb & " or produto like '%" & vet(i) & "%'"
End If
End If
Next
tratabusca = tb
End Function

a sql é como deve ficar com o uso da função que criei

 

select * from tabela where estoque = "&estoque&" and " & tratabusca(trim(busca)) & " order by produto

fiz essa função tratando somente palavra acima de 2 caracteres mas mude ... fique a vontade !! fiz isso para você ter a idéia de como resolver...

 

 

 

Sucesso!!

Compartilhar este post

Link para o post
Compartilhar em outros sites

xanburzum    169

xanburzum
Postado

olha este exemplo:

<% Option Explicit %>
<% 
Session.LCID="1046"
Response.Buffer = False 

Dim fsoObject			
Dim fldObject			
Dim sarySearchWord		
Dim strSearchWords		
Dim blnIsRoot			
Dim strFileURL			
Dim strServerPath		
Dim intNumFilesShown	
Dim intTotalFilesSearched	
Dim intTotalFilesFound		
Dim intFileNum			
Dim intPageLinkLoopCounter	
Dim sarySearchResults(1000,2)	
Dim intDisplayResultsLoopCounter 
Dim intResultsArrayPosition	
Dim blnSearchResultsFound	
Dim strFilesTypesToSearch	
Dim strBarredFolders		
Dim strBarredFiles		
Dim blnEnglishLanguage	



Const intRecordsPerPage = 10 

strFilesTypesToSearch = "htm,html,asp,shtml,txt,doc,gif,xml,xsl,aspx" 

strBarredFolders = "cgi_bin,_bin" 
strBarredFiles = "adminstation.htm,no_allowed.asp" 

blnEnglishLanguage = True 

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


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">

     
       
<script  language="JavaScript">

var search_icon_off = new Image(); 
search_icon_off.src = "site_search_icon_off.gif";

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>

<%

strSearchWords = Trim(Request.QueryString("search"))

If blnEnglishLanguage = True Then
	strSearchWords = Server.HTMLEncode(strSearchWords)

Else
	strSearchWords = Replace(strSearchWords, "<", "<", 1, -1, 1)
	strSearchWords = Replace(strSearchWords, ">", ">", 1, -1, 1)
End If

sarySearchWord = Split(Trim(strSearchWords), " ")



intFileNum = CInt(Request.QueryString("FileNumPosition"))

intNumFilesShown = intFileNum


Set fsoObject = Server.CreateObject("Scripting.FileSystemObject")


If NOT strSearchWords = "" Then


	Set fldObject = fsoObject.GetFolder("C:\Inetpub\wwwroot")
	
	strServerPath = fldObject.Path & "\"
	
	blnIsRoot = True
		
	Call SearchFile(fldObject)			
	
	Set fsoObject = Nothing
	Set fldObject = Nothing	
	
	
	Call SortResultsByNumMatches(sarySearchResults, intTotalFilesFound)
		
	
	Response.Write vbCrLf & "	<table width=""98%"" border=""0"" cellspacing=""1"" cellpadding=""1"" align=""center"" bgcolor=""#CCCCCC"">"
	Response.Write vbCrLf & " 	  <tr>"
	
	If blnSearchResultsFound = False Then 
		Response.Write vbCrLf & " 	    <td> Pesquisa nos arquivos por: <b>" & strSearchWords & "</b>.    Desculpe nenhum resultado encontrado.</td>"   
	
	Else	
		Response.Write vbCrLf & " 	    <td> Pesquisa nos arquivos por: <b>" & strSearchWords & "</b>.    Mostrando resultados " & intFileNum + 1 & " - " & intNumFilesShown & " of " & intTotalFilesFound & ".</td>"	    
	End If
	
	Response.Write vbCrLf & "	  </tr>"
	Response.Write vbCrLf & "	</table>"
		
	
	Response.Write vbCrLf & "	<table width=""95%"" border=""0"" cellspacing=""1"" cellpadding=""1"" align=""center"">"
	Response.Write vbCrLf & "	 <tr>" 
	Response.Write vbCrLf & "	  <td>"   
	
	If blnSearchResultsFound = False Then 
	
		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
		
		For intDisplayResultsLoopCounter = (intFileNum + 1) to intNumFilesShown
		
			Response.Write vbCrLf & "	     <br>"
			Response.Write vbCrLf & "	    " & sarySearchResults(intDisplayResultsLoopCounter,1)
			Response.Write vbCrLf & "	     <br>"
		Next
	End If
	
	Response.Write vbCrLf & "	    </td>"
	Response.Write vbCrLf & "	  </tr>"
	Response.Write vbCrLf & "	</table>"

End If

 
If intTotalFilesFound > intRecordsPerPage then

	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 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 intTotalFilesFound > intRecordsPerPage Then 
		
		For intPageLinkLoopCounter = 1 to CInt((intTotalFilesFound / intRecordsPerPage) + 0.5)
			
		
			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 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      	
	
	
	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"><%				  
Response.Write("		Powered By - <a href=""xanburzum"" target=""_blank"">www.xxx.com.br</a>")
%>
       </td>
      </tr>
    </table>
    <script langauge="JavaScript">document.searchIcon.src = search_icon_off.src</script>
    <br>
</div>
<br>
</body>
</html>
<%



Public Sub SearchFile(fldObject)


	Dim objRegExp				
	Dim objMatches				
	Dim filObject				
	Dim tsObject				
	Dim subFldObject			
	Dim strFileContents			
	Dim strPageTitle			
	Dim strPageDescription		
	Dim strPageKeywords			
	Dim intSearchLoopCounter		
	Dim intNumMatches			
	Dim blnSearchFound		
	
	On Error Resume Next
	
	Err.Number = 0
		  		
	Set objRegExp = New RegExp
		  		
	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.sua_imagem.info/asp/sample_scripts/site_search_script.asp")
					
		Err.Number = 0
	End If
		
	For Each filObject in fldObject.Files
		
				
		If InStr(1, strFilesTypesToSearch, fsoObject.GetExtensionName(filObject.Name), vbTextCompare) > 0 Then
	 
			If NOT InStr(1, strBarredFiles, filObject.Name, vbTextCompare) > 0 Then		  	
		  	
			 	blnSearchFound = False
		  		
		  		intNumMatches = 0		  	
		  		
		  		objRegExp.Global = True
		  		
		  		objRegExp.IgnoreCase = True
		  		
		  				  		
		  	
			    	Set tsObject = filObject.OpenAsTextStream
			
			   	strFileContents = tsObject.ReadAll		
		
				strPageTitle = GetFileMetaTag("<title>", "</title>", strFileContents)
						
				strPageDescription = GetFileMetaTag("<meta name=""description"" content=""", """>", strFileContents)
			 	
			 	strPageKeywords = GetFileMetaTag("<meta name=""keywords"" content=""", """>", strFileContents)
			 			 	
			 	
			 	
			 	objRegExp.Pattern = "<[^>]*>"
			 	
			 	strFileContents = objRegExp.Replace(strFileContents,"")
			 		
			 	strFileContents = strFileContents & " " & strPageTitle & " " & strPageDescription & " " & strPageKeywords
			 	
			 
			 				 	
			 	If Request.QueryString("mode") = "phrase" Then
			 		
			 		objRegExp.Pattern = "\b" & strSearchWords & "\b"
			 		
			 		Set objMatches = objRegExp.Execute(strFileContents)
			 		
			 		If objMatches.Count > 0 Then
			 		
			 			intNumMatches = objMatches.Count
			 		
			 			blnSearchFound = True
			 		End If
			 	
			 	
			 	Else
			 			 	
				 	If Request.QueryString("mode") = "allwords" then blnSearchFound = True
				 	
				 	
				 	For intSearchLoopCounter = 0 to UBound(sarySearchWord)
				 	
				 		objRegExp.Pattern = "\b" & sarySearchWord(intSearchLoopCounter) & "\b"
				 		
				 		'Search the file for the search words
				 		Set objMatches = objRegExp.Execute(strFileContents)
				 		    	
					    	If objMatches.Count > 0 Then 
					    	
			 				intNumMatches = intNumMatches + objMatches.Count
				    	
				    			If Request.QueryString("mode") = "anywords" then blnSearchFound = True
				    			
				    		Else
				    			If Request.QueryString("mode") = "allwords" then blnSearchFound = False
				    			
				    		End If
				    	Next
			    	End If
			    				    	
			    	
			    	intTotalFilesSearched = intTotalFilesSearched + 1
			
			
			    	
			    	If strPageTitle = "" Then strPageTitle = "Sem Titulo"
			    	
			    	If strPageDescription = "" Then strPageDescription = "Descrição do arquivo (pagina)"
			    	
			    		    				    			    	
			    	
			    	If blnSearchFound = True Then
			    			    	
			    					    		    	
					intTotalFilesFound = intTotalFilesFound + 1
										
			    			    		
					If  intNumFilesShown < (intRecordsPerPage + intFileNum) and intTotalFilesFound > intNumFilesShown Then
	
						intNumFilesShown = intNumFilesShown + 1
						
					End If	
		
					       		
				       		
			       		intResultsArrayPosition = intResultsArrayPosition + 1
			       		
				       		
			       		blnSearchResultsFound = True
				       					       		
					If blnIsRoot = True Then
						
						
						sarySearchResults(intResultsArrayPosition,1) = "<a href=""./" &  filObject.Name & """ target=""_self"">" & strPageTitle & "</a>" 
													
								    						       		
			       		Else
			       			sarySearchResults(intResultsArrayPosition,1) = "<a href=""./" & strFileURL  & fldObject.Name & "/" & filObject.Name & """ target=""_self"">" & strPageTitle & "</a>"			   			   								
						
					End If						
					
					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>"
					
					
					
					sarySearchResults(intResultsArrayPosition,2) = intNumMatches
									
		      		End If
							
		    		tsObject.Close
			End If
		End If
	Next
	
	Set objRegExp = Nothing
		
	
	For Each subFldObject In FldObject.SubFolders
										
		If NOT InStr(1, strBarredFolders, subFldObject.Name, vbTextCompare) > 0 Then
			
			blnIsRoot = False
						
					
			strFileURL = fldObject.Path & "\"
			
			strFileURL = Replace(strFileURL, strServerPath, "")
			
			strFileURL = Replace(strFileURL, "\", "/")
			
			strFileURL = Server.URLEncode(strFileURL)
			
			strFileURL = Replace(strFileURL, "%2F", "/")
						
			Call SearchFile(subFldObject)
		End If
	Next



	Set filObject = Nothing
	Set tsObject = Nothing
	Set subFldObject = Nothing
End Sub




Private Sub SortResultsByNumMatches(ByRef sarySearchResults, ByRef intTotalFilesFound)


	Dim intArrayGap 		
	Dim intIndexPosition		
	Dim intTempResultsHold			
	Dim intTempNumMatchesHold	
	Dim intPassNumber		
	
	
	'Loop round to sort each result found
	For intPassNumber = 1 To intTotalFilesFound
	
		For intIndexPosition = 1 To (intTotalFilesFound - intPassNumber)
		
			If sarySearchResults(intIndexPosition,2) < sarySearchResults((intIndexPosition+1),2) Then
			
				
				intTempResultsHold = sarySearchResults(intIndexPosition,1)
				
				intTempNumMatchesHold = sarySearchResults(intIndexPosition,2)
				
				
				
				sarySearchResults(intIndexPosition,1) = sarySearchResults((intIndexPosition+1),1)
									
				sarySearchResults(intIndexPosition,2) = sarySearchResults((intIndexPosition+1),2)
				
				sarySearchResults((intIndexPosition+1),1) = intTempResultsHold
				
				sarySearchResults((intIndexPosition+1),2) = intTempNumMatchesHold			
			End If
		Next			
	Next					
End Sub



Private Function GetFileMetaTag(ByRef strStartValue, ByRef strEndValue, ByVal strFileContents)

	
	Dim intStartPositionInFile	
	Dim intEndPositionInFile	
	
	
	intStartPositionInFile = InStr(1, LCase(strFileContents), strStartValue, 1)
	
	
	If intStartPositionInFile = 0 And InStr(strStartValue, "name=") Then
		
		strStartValue = Replace(strStartValue, "name=", "http-equiv=")
		
		intStartPositionInFile = InStr(1, LCase(strFileContents), strStartValue, 1)		
	End If
	
				    	
	If NOT intStartPositionInFile = 0 Then
					
		intStartPositionInFile = intStartPositionInFile + Len(strStartValue)
						
		
		intEndPositionInFile = InStr(intStartPositionInFile, LCase(strFileContents), strEndValue, 1)
	
		
		GetFileMetaTag = Trim(Mid(strFileContents, intStartPositionInFile, (intEndPositionInFile - intStartPositionInFile)))
					

	Else
		GetFileMetaTag = ""
		       		
	End If

End Function
%>

Compartilhar este post

Link para o post
Compartilhar em outros sites
Ir para a lista de tópicos ASP Clássico
×

Informação importante

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

  Aceito