Buscar palavras no site

elton73ssa · Dezembro 1, 2009

Pessoal,

Tenho um sistema excelente de busca por palavras no site em PHP...

Como convertê-lo para ASP é complicado pra mim, pesquisei algo parecido e nao achei.

Queria que o sistema buscasse palavras chaves nas paginas ASP, sem utilizar banco de dados.

O que encontrei exibe o titulo e a descrição (se estiverem configurados no title e meta das páginas) mas não exibe parte do texto da página onde ocorre a palavra buscada.

É justamente isso que gostaria.

Alguem conhece algo assim?

xanburzum · Dezembro 1, 2009

olha este exemplo, muito bom

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

elton73ssa · Dezembro 1, 2009

olha este exemplo, muito bom
<....

Opa.

Eu já tinha visto esse código. Mas se você observar ele mostra apenas o que eu falei. O titulo e a descrição da página. Não mostra o conteúdo onde ocorre a palavra buscada.

xanburzum · Dezembro 1, 2009

você pode usar outra funcaun no lab. de scripts memsmo, para pegar o conteduo de determinada TAG

elton73ssa · Dezembro 1, 2009

você pode usar outra funcaun no lab. de scripts memsmo, para pegar o conteduo de determinada TAG

Que função seria essa? Não achei nada parecido.

xanburzum · Dezembro 1, 2009

Olha este código, tem uma classe onde você invoca ela na pagina demo.asp, nele tem um form, onde você coloca, a url e ele retorna o Title, , Keywords, Description, tudo separado e muito mais, segue o código.

demo.asp

<!--#INCLUDE FILE="clsHTMLParser.asp"-->
<%
Dim StrURL
Dim StrHTML
Dim ObjParser

StrURL = Request.QueryString("URL")
%>
<H1></H1>
<P>

Este script irá solicitar a página do servidor especificado no URL e analisar o título, descrição e palavras-chave para você
</P>
<FORM>
	<INPUT size="50" name="URL" value="<%=StrURL%>"><BR>
	<INPUT type="Submit" value="Parse">
</FORM>
<BR><BR>
<%
If Not StrURL = "" Then
	Set ObjParser = New clsHTMLParser
	With ObjParser
		StrHTML = .GetURL(StrURL)
		%>
		<TABLE border="1">
			<TR>
				<TD>Title</TD>
				<TD><%=.Title%></TD>
			</TR>
			<TR>
				<TD>Keywords</TD>
				<TD><%=.Keywords%></TD>
			</TR>
			<TR>
				<TD>Description</TD>
				<TD><%=.Description%></TD>
			</TR>
		</TABLE>
		<HR>
		<%
		Response.Write Replace(Server.HTMLEncode(StrHTML), vbCrLf, "<BR>")
	End With
	Set ObjParser = Nothing
End If
%>

classe clsHTMLParser.asp

<%
' ------------------------------------------------------------------------------
Class clsHTMLParser
' ------------------------------------------------------------------------------
	Private mStrHTML
	Private mObjRegExp
	Private mObjMatches
	Private mObjMatch
	Public Title
	Public Keywords
	Public Description
' ------------------------------------------------------------------------------
	Public Property Let HTML(ByRef pStrHTML)
		mStrHTML = pStrHTML

		Set mObjRegExp = New RegExp
		mObjRegExp.IgnoreCase = True

		Call ParseTitle()
		Call ParseDescription()
		Call ParseKeywords()

		Set mObjMatch = Nothing
		Set mObjMatches = Nothing
		Set mObjRegExp = Nothing

	End Property
' ------------------------------------------------------------------------------
	Public Property Get HTML()
		HTML = mStrHTML
	End Property
' ------------------------------------------------------------------------------
	Private Sub ParseTitle()
		Title = ""
		mObjRegExp.Pattern = "<TITLE>([^<]*)</TITLE>"
		Set mObjMatches = mObjRegExp.Execute(mStrHTML)
		If mObjMatches.Count = 0 Then Exit Sub
		Title = mObjMatches.item(0).Value
		Title = Replace(Title, "<TITLE>", "", 1, -1, vbTextCompare)
		Title = Replace(Title, "</TITLE>", "", 1, -1, vbTextCompare)
	End Sub
' ------------------------------------------------------------------------------
	Private Sub ParseDescription()
		Description = ""
		mObjRegExp.Pattern = "<META[^>]+(name=""description""|content=""([^""]*)"")[^>]+(name=""description""|content=""([^""]*)"")[^>]*>"
		Set mObjMatches = mObjRegExp.Execute(mStrHTML)
		If mObjMatches.Count = 0 Then Exit Sub
		Description = mObjMatches.item(0).Value
		Description = Mid(Description, InStr(1, Description, "content=""", vbTextCompare) + 9)
		Description = Mid(Description, 1, InStr(1, Description, """", vbTextCompare) -1)
	End Sub
' ------------------------------------------------------------------------------
	Private Sub ParseKeywords()
		Keywords = ""
		mObjRegExp.Pattern = "<META[^>]+(name=""keywords""|content=""([^""]*)"")[^>]+(name=""keywords""|content=""([^""]*)"")[^>]*>"
		Set mObjMatches = mObjRegExp.Execute(mStrHTML)
		If mObjMatches.Count = 0 Then Exit Sub
		Keywords = mObjMatches.item(0).Value
		Keywords = Mid(Keywords, InStr(1, Keywords, "content=""", vbTextCompare) + 9)
		Keywords = Mid(Keywords, 1, InStr(1, Keywords, """", vbTextCompare) -1)
	End Sub
' ------------------------------------------------------------------------------
	Public Function GetURL(ByRef pStrURL)

		Dim lObjSpider
		Dim strText

		If pStrURL = "" Then Exit Function

		On Error Resume Next

		
		'Set lObjSpider = Server.CreateObject ("MSXML2.XMLHTTP.3.0")
		'Set lObjSpider = Server.CreateObject ("MSXML2.ServerXMLHTTP")
		Set lObjSpider = Server.CreateObject ("Microsoft.XMLHTTP")
		

		' Could not create Internet Control
		If Err Then
			GetURL = "Error: " & Err.Description
			Exit Function
		End If
		
		On Error Goto 0

		With lObjSpider
			.Open "GET", pStrURL, False, "", ""
			.Send
			GetURL = .ResponseText
		End With
		Set LobjSpider = Nothing

		HTML = GetURL
		
	End Function
' ------------------------------------------------------------------------------
End Class
' ------------------------------------------------------------------------------
%>

elton73ssa · Dezembro 2, 2009

Olha este código, tem uma classe onde você invoca ela na pagina demo.asp, nele tem um form, onde você coloca, a url e ele retorna o Title, , Keywords, Description, tudo separado e muito mais, segue o código.

Valeu pelas respostas... Mas continua na mesma.

A busca por palavras no site não mostra o que tem nas tags meta e title apenas.. Pelo menos não uma boa busca.

Como diz o locutor do Fifa, "de qualquer forma, valeu a tentativa..." http://forum.imasters.com.br/public/style_emoticons/default/natal_biggrin.gif

Tem esse aqui. O poblema dele é que embora no codigo diga que é pra mostrar o conteúdo da página onde ocorre a palavra pesquisada, na prática ele não faz.

<% Option Explicit %>
<% 

'Set the response buffer to true
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 = "asp" 

' --------------------- 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 = "admin.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 = False 'True = HTML Encode best for English sites \ False = no Emcoding best for non English sites

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


'Initalise variables
intTotalFilesSearched = 0

%>
<html>
<head>
<title>Search the Website</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("Please enter at least one keyword to search");
		document.frmSiteSearch.search.focus();
		return false;
	}
	
	return true
}
// -->
</script>
       
</head>
<body bgcolor="#FFFFFF" text="#000000" link="#0000CC" vlink="#0000CC" alink="#FF0000">
<h1 align="center">Site Search Engine</h1>
  
<form method="get" name="frmSiteSearch" action="teste_busca1.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"> Search the Web Site: </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="Search >>" name="submit">
        </td>
    </tr>
    <tr> 
      <td class="normal" height="34" width="571" valign="top"> Search On : 
        <input type="radio" name="mode" value="allwords" CHECKED>
        All Words 
        <input type="radio" name="mode" value="anywords">
        Any Words 
        <input type="radio" name="mode" value="phrase">
        Phrase</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(Server.MapPath("./"))
	
	'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> Searched the site for <b>" & strSearchWords & "</b>.    Sorry, no results found.</td>"   
	
	'Else Search went OK so display how many records found
	Else	
		Response.Write vbCrLf & " 	    <td> Searched the site for <b>" & strSearchWords & "</b>.    Displaying Results " & 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 & "	   Your Search - <b>" & strSearchWords & "</b> - did not match any files on this site."
	   	Response.Write vbCrLf & "	   <br><br>"
	   	Response.Write vbCrLf & "	   Suggestions:"
	   	Response.Write vbCrLf & "	   <br>"
	   	Response.Write vbCrLf & "	   <ul><li>Make sure all words are spelled correctly.<li>Try different keywords.<li>Try more general keywords.<li>Try fewer keywords.</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"> Searched <% = intTotalFilesSearched  %> documents in total. </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=""http://www.webwizguide.info""'>http://www.webwizguide.info"" target=""_blank"">www.webwizguide.info</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>
  <a href="http://www.webwizguide.info" target="_blank"><img src="web_wiz_guide.gif" width="100" height="30" border="0" alt="Web Wiz Guide!"></a></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>Error The Server does not support the Regular Expessions object<br>Please download the alternative version of this application from 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 = "No Title"
			    	
			    	'If the page contains no title then Page Description variable the appropriate message to display
			    	If strPageDescription = "" Then strPageDescription = "There is no description available for this page"
			    	
			    		    				    			    	
			    	
			    	'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
%>

Entrar

Arquivado

Buscar palavras no site

Recommended Posts

elton73ssa 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

xanburzum 169

Compartilhar este post

Link para o post

Compartilhar em outros sites

elton73ssa 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

xanburzum 169

Compartilhar este post

Link para o post

Compartilhar em outros sites

elton73ssa 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

xanburzum 169

Compartilhar este post

Link para o post

Compartilhar em outros sites

elton73ssa 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

Fixar div até atingir uma certa altura

Ajuda com Extends e envio para o banco

PHP+Codeginiter - Orientação para Impressão

Este projeto é apoiado pelas empresas

Fóruns

Tempo Real

Informação importante