<% 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,sisallys.htm,kansi.htm,henkilot.htm,tietoja.htm,julkaisu.htm,kirjoittajat.htm,lahteet.htm" blnEnglishLanguage = False intTotalFilesSearched = 0 %> Tekstihaku

Etusivu l Sisällys l Hakemisto l <Edellinen l Seuraava>

Sanahaku

 

Alla olevan lomakkeen avulla voit etsiä tästä verkkojulkaisusta sivuja, jotka sisältävät tiettyjä sanoja tai sanayhdistelmiä. Näyttöön tulee luettelo, jonka alkuun on sijoitettu hakuehtoja parhaiten vastaavat sivut. Kukin luettelokohta on linkki vastaavalle sivulle.

Esimerkiksi haku opetusharjoittelun ohjaus etsii valinnalla "Kaikki sanat" artikkelit, joissa on sanat opetusharjoittelun ja ohjaus. Valinnalla "Jokin sanoista" haku etsii artikkelit, joissa on sana opetusharjoittelun tai sana ohjaus. Valinnalla "Täsmällinen fraasi" haku etsii artikkelit, joissa on sanaliitto opetusharjoittelun ohjaus.

Haku kestää jonkin aikaa. 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 & " Ehdotuksia hakutulosten parantamiseksi:" Response.Write vbCrLf & "
" Response.Write vbCrLf & "
  • Varmista, että kaikki sanat on kirjoitettu oikein
  • Kokeile sanan eri taivutusmuotoja, esim. perusharjoittelun, perusharjoittelussa jne.
  • Kirjoita kokeeksi sanan taipuvaa osaa vastaavaan kohtaan pisteitä, esim. perusharjoittelu...
" 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 %>

 

 

 

 

<% 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 = "Sivulla ei ole otsikkoa." 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 %>