<% Option Explicit %> <% Response.Buffer = True Dim fsoObject Dim fldObject Dim esHaeTermi Dim strSearchWords Dim blnIsRoot Dim strFileURL Dim strServerPath Dim intNumFilesShown Dim intTotalFilesSearched Dim intTotalFilesFound Dim intFileNum Dim intPageLinkLoopCounter Dim esHakuTulokset(1000,2) Dim intDisplayResultsLoopCounter Dim intResultsArrayPosition Dim blnSearchResultsFound Dim strFilesTypesToSearch Dim strSalatutKansiot Dim strSalatutFileet Dim blnEnglishLanguage Const intRecordsPerPage = 10 strFilesTypesToSearch = "htm,html" strSalatutKansiot = "cgi_bin,_bin,_derived,_private,_vti_cnf,_vti_pvt,images,Kuvat,PDFt" strSalatutFileet = "adminstation.htm,no_allowed.asp,admin.asp,animate.js,desktop.ini,haku.asp,aineistohaku.asp,valikko.htm,haku.htm,etsinta.htm,etusivu.htm" blnEnglishLanguage = False intTotalFilesSearched = 0 %> Hakemisto
Etusivu

Sisällys

 Hakemisto <Edellinen Seuraava>

Tekstihaku

 

Alla olevan lomakkeen avulla voit etsiä verkkokirjasta artikkeleja, jotka sisältävät tiettyjä sanoja tai sanayhdistelmiä. Näyttöön tulee luettelo, jonka alkuun on sijoitettu hakuehtoja parhaiten vastaavat kirjoitukset. Kukin luettelokohta on linkki vastaavaan artikkeliin.

Esimerkiksi haku laadukas oppiminen etsii valinnalla "Kaikki sanat" artikkelit, joissa on sanat laadukas ja oppiminen. Valinnalla "Jokin sanoista" haku etsii artikkelit, joissa on sana laadukas tai sana oppiminen. Valinnalla "Täsmällinen fraasi" haku etsii artikkelit, joissa on sanaliitto laadukas oppiminen. – Jos etsintä ei johda tulokseen, näyttöön tulee lisää ohjeita.
 

">
Hakumuoto: Kaikki sanat Jokin sanoista Täsmällinen fraasi
<% strSearchWords = Trim(Request.QueryString("haku")) If blnEnglishLanguage = True Then strSearchWords = Server.HTMLEncode(strSearchWords) Else strSearchWords = Replace(strSearchWords, "<", "<", 1, -1, 1) strSearchWords = Replace(strSearchWords, ">", ">", 1, -1, 1) End If esHaeTermi = Split(Trim(strSearchWords), " ") intFileNum = CInt(Request.QueryString("SivujenEsitys")) 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(esHakuTulokset, intTotalFilesFound) Response.Write vbCrLf & " " Response.Write vbCrLf & " " If blnSearchResultsFound = False Then Response.Write vbCrLf & " " Else Response.Write vbCrLf & " " End If Response.Write vbCrLf & " " Response.Write vbCrLf & "
 Hakutermi: " & strSearchWords & ".
 Ei hakutuloksia.
 Hakutermi: " & strSearchWords & ".
 Tulokset: " & intFileNum + 1 & " - " & intNumFilesShown & " / " & intTotalFilesFound & ".
" Response.Write vbCrLf & " " Response.Write vbCrLf & " " Response.Write vbCrLf & " " Response.Write vbCrLf & " " Response.Write vbCrLf & "
" If blnSearchResultsFound = False Then Response.Write vbCrLf & "
" Response.Write vbCrLf & " Hakutermiäsi: " & strSearchWords & " vastaavia kohteita ei löytynyt." Response.Write vbCrLf & "

" Response.Write vbCrLf & " Ehdotuksia hakutulosten parantamiseksi:" Response.Write vbCrLf & "
" Response.Write vbCrLf & "
  • Varmista, että kaikki sanat on kirjoitettu oikein
  • Kokeile sanan eri taivutusmuotoja, esim. peruskoulun, peruskoulussa, peruskoulumme jne.
  • Kirjoita kokeeksi sanan taipuvaa osaa vastaavaan kohtaan pisteitä, esim. peruskoulu...
" Else For intDisplayResultsLoopCounter = (intFileNum + 1) to intNumFilesShown Response.Write vbCrLf & "
" Response.Write vbCrLf & " " & esHakuTulokset(intDisplayResultsLoopCounter,1) Response.Write vbCrLf & "
" Next End If Response.Write vbCrLf & "
" End If If intTotalFilesFound > intRecordsPerPage then Response.Write vbCrLf & "
" Response.Write vbCrLf & " " Response.Write vbCrLf & " " Response.Write vbCrLf & " " Response.Write vbCrLf & " " Response.Write vbCrLf & "
" Response.Write vbCrLf & " " Response.Write vbCrLf & " " Response.Write vbCrLf & " " Response.Write vbCrLf & " " Response.Write vbCrLf & "
" Response.Write vbCrLf & "   " If intNumFilesShown > intRecordsPerPage Then Response.Write vbCrLf & " << Edellinen sivu " End If If intTotalFilesFound > intRecordsPerPage Then For intPageLinkLoopCounter = 1 to CInt((intTotalFilesFound / intRecordsPerPage) + 0.5) If intFileNum = (intPageLinkLoopCounter * intRecordsPerPage) - intRecordsPerPage Then Response.Write vbCrLf & " " & intPageLinkLoopCounter & "" Else Response.Write vbCrLf & "  " & intPageLinkLoopCounter & "  " End If Next End If If intTotalFilesFound > intNumFilesShown then Response.Write vbCrLf & "  Seuraava sivu >>" End If Response.Write vbCrLf & "
" Response.Write vbCrLf & "
" End If %>
Etusivu

Sisällys

 Hakemisto <Edellinen Seuraava>

jyo.gif (1438 bytes)

Savonlinnan opettajankoulutuslaitos 2002

 

 

 

 

<% 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("
Virhe!
") 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, strSalatutFileet, filObject.Name, vbTextCompare) > 0 Then blnSearchFound = False intNumMatches = 0 objRegExp.Global = True objRegExp.IgnoreCase = True Set tsObject = filObject.OpenAsTextStream strFileContents = tsObject.ReadAll strPageTitle = GetFileMetaTag("", "", strFileContents) strPageDescription = GetFileMetaTag("", strFileContents) strPageKeywords = GetFileMetaTag("", strFileContents) objRegExp.Pattern = "<[^>]*>" strFileContents = objRegExp.Replace(strFileContents,"") strFileContents = strFileContents & " " & strPageTitle & " " & strPageDescription & " " & strPageKeywords If Request.QueryString("hakutapa") = "fraasi" 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("hakutapa") = "kaikki" then blnSearchFound = True For intSearchLoopCounter = 0 to UBound(esHaeTermi) objRegExp.Pattern = "\b" & esHaeTermi(intSearchLoopCounter) & "\b" Set objMatches = objRegExp.Execute(strFileContents) If objMatches.Count > 0 Then intNumMatches = intNumMatches + objMatches.Count If Request.QueryString("hakutapa") = "mikavain" then blnSearchFound = True Else If Request.QueryString("hakutapa") = "kaikki" then blnSearchFound = False End If Next End If intTotalFilesSearched = intTotalFilesSearched + 1 If strPageTitle = "" Then strPageTitle = "Siden har ingen titel!" If strPageDescription = "" Then strPageDescription = "Sivusta ei ole kuvailutietoja." 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 esHakuTulokset(intResultsArrayPosition,1) = "" & strPageTitle & "" Else esHakuTulokset(intResultsArrayPosition,1) = "" & strPageTitle & "" End If esHakuTulokset(intResultsArrayPosition,1) = esHakuTulokset(intResultsArrayPosition,1) & vbCrLf & "
" & strPageDescription & "" esHakuTulokset(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, strSalatutKansiot, 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 esHakuTulokset, ByRef intTotalFilesFound) Dim intArrayGap Dim intIndexPosition Dim intTempResultsHold Dim intTempNumMatchesHold Dim intPassNumber For intPassNumber = 1 To intTotalFilesFound For intIndexPosition = 1 To (intTotalFilesFound - intPassNumber) If esHakuTulokset(intIndexPosition,2) < esHakuTulokset((intIndexPosition+1),2) Then intTempResultsHold = esHakuTulokset(intIndexPosition,1) intTempNumMatchesHold = esHakuTulokset(intIndexPosition,2) esHakuTulokset(intIndexPosition,1) = esHakuTulokset((intIndexPosition+1),1) esHakuTulokset(intIndexPosition,2) = esHakuTulokset((intIndexPosition+1),2) esHakuTulokset((intIndexPosition+1),1) = intTempResultsHold esHakuTulokset((intIndexPosition+1),2) = intTempNumMatchesHold End If Next Next End Sub Private Function GetFileMetaTag(ByRef strStartValue, ByRef strEndValue, ByVal strFileContents) Dim intStartPositionInFile Dim intEndPositionInFile intStartPositionInFile = InStr(1, LCase(strFileContents), strStartValue, 1) If intStartPositionInFile = 0 And InStr(strStartValue, "name=") Then strStartValue = Replace(strStartValue, "name=", "http-equiv=") intStartPositionInFile = InStr(1, LCase(strFileContents), strStartValue, 1) End If If NOT intStartPositionInFile = 0 Then intStartPositionInFile = intStartPositionInFile + Len(strStartValue) intEndPositionInFile = InStr(intStartPositionInFile, LCase(strFileContents), strEndValue, 1) GetFileMetaTag = Trim(Mid(strFileContents, intStartPositionInFile, (intEndPositionInFile - intStartPositionInFile))) Else GetFileMetaTag = "" End If End Function %>