search.asp

遍历文件夹下的所有文件

		  		
	'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 = "该网页没有特别说明！"
			    	
			    		    				    			    	
			    	
			    	'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>搜索结果 " & intNumMatches & " &nbsp;-&nbsp; 最后更新 " & FormatDateTime(filObject.DateLastModified, VbLongDate) & " &nbsp;-&nbsp; 大小 " & 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
%>