Søgescript der "blokerer" min server
Hej!Jeg kører Win 2000 Pro med IIS 5.0. Jeg forsøger at afvikle nedenstående asp-script, der en "lokal" søgemaskine, men scriptet får min server (localhost) til at gå helt i stå. Efter et stykke tid, melder den "for brugere tilsluttet"!
Hvis jeg derimod lægger samme script ud på en ekstern server, fungerer det fint. Men jeg har behov for at kunne teste lokalt.
Hvad er der galt på min maskine?
<-- start min kode -->
<%
%>
<% Option Explicit %>
<%
Response.Buffer = True
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 'change this to the number of results to show on each page
strFilesTypesToSearch = "htm,html,asp,shtml"
strBarredFolders = "cgi_bin,_bin" 'cgi_bin and _bin have been put in here as examples, but you can put any folders in here
strBarredFiles = "adminstation.htm,no_allowed.asp,admin.asp" 'adminstration.htm and not_allowed.asp have been put in as an examples
blnEnglishLanguage = False 'True = HTML Encode best for English sites \ False = no Emcoding best for non English sites
intTotalFilesSearched = 0
%>
<html>
<head>
<title>søgemaskine</title>
<meta name="Description" content="I denne streng skriver du beskrivelsen af siden...">
<meta name="KeyWords" content="søgemaskine">
<style type="text/css">
<!--
a:active { font-family: Verdana, Arial, Helvetica, sans-serif; font-size: 12px; font-weight: bold; color: #000000; text-decoration: none}
a:hover { font-family: Verdana, Arial, Helvetica, sans-serif; font-size: 12px; font-weight: bold; color: #666666; text-decoration: underline}
a:link { font-family: Verdana, Arial, Helvetica, sans-serif; font-size: 12px; font-weight: bold; color: #000000; text-decoration: underline}
a:visited { font-family: Verdana, Arial, Helvetica, sans-serif; font-size: 12px; font-weight: bold; color: #000000; text-decoration: underline}
.box { font-family: Verdana, Arial, Helvetica, sans-serif; font-size: 12px; font-weight: bold; color: #000000; text-decoration: none; background-image: url(side/grafik/graa_bg.gif); border-color: #000000 #333333 #333333 #000000; border-style: solid; border-top-width: thin; border-right-width: thin; border-bottom-width: thin; border-left-width: thin}
body { font-family: Verdana, Arial, Helvetica, sans-serif; font-weight: bold; color: #000000}
-->
</style>
</head>
<body bgcolor="#FFFFFF">
<p><font size="2">For at man kan søge skal man jo have nogle sider med
søge ord....<br>
Så derfor er der 2 side hvor der stå forskelige ord.<br>
asp, gratis, webdesign, webmaster. Prøv de forskelig funktioner. da dette
ikke står på alle sider.<br>
</font><font size="2">Og prøv at skriv noget volapyk eller noget der
ikke står her. <br>
Prøv alle søge ord for der er små hints på siderne.<br>
</font> </p>
<form method="get" name="frmSiteSearch" action="site_search.asp">
<table cellpadding="0" cellspacing="0" width="90%" align="center">
<tr>
<td class="arial" height="4" width="571"> <b><font size="2">Fandt du ikke
det du skulle bruge ?</font></b></td>
</tr>
<tr>
<td class="normal" height="2" width="571">
<input type="TEXT" name="search" maxlength="50" size="36" value="<% =Request.QueryString("search") %>" class="box">
<input type="submit" value="Søg >>" name="submit" class="box">
</td>
</tr>
<tr>
<td class="normal" height="34" width="571" valign="top"> <font size="2">Specifik
søgning </font><font size="2"> :
<input type="radio" name="mode" value="allwords" CHECKED>
Alle ord
<input type="radio" name="mode" value="anywords">
Nogle af ordene
<input type="radio" name="mode" value="phrase">
Sætningen </font></td>
</tr>
</table>
</form>
<%
strSearchWords = Trim(Request.QueryString("search"))
If blnEnglishLanguage = True Then
strSearchWords = Server.HTMLEncode(strSearchWords)
Else
'Just replace the script tag <> with HTML encoded < and >
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(Server.MapPath("./"))
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=""#EBEBEB"">"
Response.Write vbCrLf & " <tr>"
If blnSearchResultsFound = False Then
Response.Write vbCrLf & " <td><font size=2> Søgte på sider efter <b>" & strSearchWords & "</b>. Desvære der var ingen resultater.</font></td>"
Else
Response.Write vbCrLf & " <td><font size=2> Søgte på sider efter <b>" & strSearchWords & "</b>. Viser resultater " & intFileNum + 1 & " - " & intNumFilesShown & " af " & intTotalFilesFound & ".</font></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 & " <font size=2>Dit søgeord var - <b>" & strSearchWords & "</b> - Der var desvære ingen resultat/resultater af søgningen.</font>"
Response.Write vbCrLf & " <br><br>"
Response.Write vbCrLf & " <font size=2><b>Muligheder:</b></font>"
Response.Write vbCrLf & " <br>"
Response.Write vbCrLf & " <font size=2><ul><li>Har du stavet det rigtigt?<li>Prøv uden special tegn.<li>Prøv med et andet keyword.<li>Prøv med fære keywords.</ul></font>"
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 & " <font size=2>Antal sider med valgte søgning: </font>"
If intNumFilesShown > intRecordsPerPage Then
Response.Write vbCrLf & " <font size=2><a href=""site_search.asp?FileNumPosition=" & intFileNum - intRecordsPerPage & "&search=" & Replace(strSearchWords, " ", "+") & "&mode=" & Request.QueryString("mode") & """ target=""_self""><< Sidste</a></font> "
End If
If intTotalFilesFound > intRecordsPerPage Then
For intPageLinkLoopCounter = 1 to CInt((intTotalFilesFound / intRecordsPerPage) + 0.5)
If intFileNum = (intPageLinkLoopCounter * intRecordsPerPage) - intRecordsPerPage Then
Response.Write vbCrLf & " <font size=2 color=#CC3300><b>" & intPageLinkLoopCounter & "</b></font>"
Else
Response.Write vbCrLf & " <font size=2><a href=""site_search.asp?FileNumPosition=" & (intPageLinkLoopCounter * intRecordsPerPage) - intRecordsPerPage & "&search=" & Replace(strSearchWords, " ", "+") & "&mode=" & Request.QueryString("mode") & """ target=""_self"">" & intPageLinkLoopCounter & "</a></font> "
End If
Next
End If
If intTotalFilesFound > intNumFilesShown then
Response.Write vbCrLf & " <font size=2><a href=""site_search.asp?FileNumPosition=" & intNumFilesShown & "&search=" & Replace(strSearchWords, " ", "+") & "&mode=" & Request.QueryString("mode") & """ target=""_self"">Næste >></a></font>"
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" align="center">
<tr>
<td width="47%" height="18"> </td>
<td width="53%" align="right" height="18"><br>
<%Response.Write("<font size=1><b>(c)</b>2003</font>")%>
</td>
</tr>
</table>
<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>FEJL! Serveren understøtter ikke extension<br>")
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"
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 = "<font size=2><b>Siden har ingen titel!</b></font>"
If strPageDescription = "" Then strPageDescription = "<font size=2>Der er ikke lavet en beskrivelse af denne side.</font>"
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 & " <font size=2><br>" & strPageDescription & "</font>"
sarySearchResults(intResultsArrayPosition,1) = sarySearchResults(intResultsArrayPosition,1) & vbCrLf & " <font size=""1"" color=""#000000""><br>Søgningen machede " & intNumMatches & " - Sidst opdateret " & FormatDateTime(filObject.DateLastModified, VbLongDate) & " - Side størelse " & CInt(filObject.Size / 1024) & "kb</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 '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
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 'Holds the start position in the file
Dim intEndPositionInFile 'Holds the end position in the file
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
%>
<-- slut min kode -->
