Reaching and Developing People for Jesus
|
|
|
|
|
<%
'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(" Error The Server does not support the Regular Expessions object 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(" " & strPageDescription sarySearchResults(intResultsArrayPosition,1) = sarySearchResults(intResultsArrayPosition,1) & vbCrLf & " Search Matches " & intNumMatches & " - Last Updated " & FormatDateTime(filObject.DateLastModified, VbLongDate) & " - Size " & CInt(filObject.Size / 1024) & "kb" '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 %> |
|
Send mail to
david@TheArkNY.org
with
questions about the church or comments about this site.
|
