Arama

<% Response.Buffer = False 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 = 15 strFilesTypesToSearch = "asp" strBarredFolders = "cgi_bin,_bin,db" strBarredFiles = "adminstation.htm,no_allowed.asp" 'adminstration.htm and not_allowed.asp have been put in as an examples blnEnglishLanguage = False intTotalFilesSearched = 0 %> Arama

<% strSearchWords = Trim(Request.QueryString("search")) If blnEnglishLanguage = True Then strSearchWords = Server.HTMLEncode(strSearchWords) Else 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 & " " Response.Write vbCrLf & " " If blnSearchResultsFound = False Then Response.Write vbCrLf & " " Else Response.Write vbCrLf & " " End If Response.Write vbCrLf & " " Response.Write vbCrLf & "

Sitede aranan " & strSearchWords & ". Üzgünüz,aradýðýnýz kriterlere uygun sonuç bulunamadý.

Sitede aranan " & strSearchWords & ". Bulunan Sonuçlar " & intFileNum + 1 & " - " & intNumFilesShown & "

" 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 & " Aradýðýnýz - " & strSearchWords & " - kriterine uygun hiçbir kayýt bulunamadý." Response.Write vbCrLf & "

" Response.Write vbCrLf & " Öneri:" Response.Write vbCrLf & "
" Response.Write vbCrLf & "

Bütün kelimeleri doðru yazdýðýnýzdan emin olunuz.
Baþka bir kelime deneyiniz.

" Else For intDisplayResultsLoopCounter = (intFileNum + 1) to intNumFilesShown Response.Write vbCrLf & "
" Response.Write vbCrLf & " " & sarySearchResults(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 & " Results Page: " If intNumFilesShown > intRecordsPerPage Then Response.Write vbCrLf & " << Prev " 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 & " Next >>" End If Response.Write vbCrLf & "

" Response.Write vbCrLf & "

" End If %>

Toplam <% = intTotalFilesSearched %> dosya arandı.

<% %>

<% 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("
Hata !Server ,Regular Expessions objelerini desteklemiyor
") 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("", "", strFileContents) strPageDescription = GetFileMetaTag("", strFileContents) strPageKeywords = GetFileMetaTag("", 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 = "Baþlýk Yok" If strPageDescription = "" Then strPageDescription = "Bu sayfada kullanýlabilir tanýmlama yok" 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) = "" & strPageTitle & "" Else sarySearchResults(intResultsArrayPosition,1) = "" & strPageTitle & "" End If sarySearchResults(intResultsArrayPosition,1) = sarySearchResults(intResultsArrayPosition,1) & vbCrLf & "
" & strPageDescription sarySearchResults(intResultsArrayPosition,1) = sarySearchResults(intResultsArrayPosition,1) & vbCrLf & "
Eþdeðer Sonuçlar " & intNumMatches & " - Son Güncelleme " & FormatDateTime(filObject.DateLastModified, VbLongDate) & " - Boyut " & CInt(filObject.Size / 1024) & "kb" 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 Dim intIndexPosition Dim intTempResultsHold Dim intTempNumMatchesHold Dim intPassNumber 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 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 %>