Istanbul Corap
Search
<%'*********** ARAMA MOTORU ************* 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(500,2) Dim intDisplayResultsLoopCounter Dim intResultsArrayPosition Dim blnSearchResultsFound Dim strFilesTypesToSearch Dim strBarredFolders Dim strBarredFiles ' -------------------------- DİKKAT----------------------------------- DİKKAT-------------------- Const intRecordsPerPage = 10 'Burada her sayfada kaç kayıt gösterileceğini ayarlıyorsunuz ' -------------------------- DİKKAT----------------------------------- DİKKAT-------------------- strFilesTypesToSearch = "asp,shtml,dhtml" 'Burada aranacak dosya türlerini ayarlıyorsunuz ' -------------------------- DİKKAT----------------------------------- DİKKAT-------------------- strBarredFolders = "cgi_bin,_private,inc,admin" 'cgi_bin ve _private gibi arama yapılmasını istemediğiniz klasörleri yazıyorsunuz ' -------------------------- DİKKAT----------------------------------- DİKKAT-------------------- strBarredFiles = "admin.asp" 'Buradada aranmasını istemediğiniz dosyaları yazıyonuz '---------------------------- intTotalFilesSearched = 0 %>
<% ' ------ Color and Style -------- strBarColor = "#736C5C" strInfoColor = "" ' ------------------------------- strSearchWords = Trim(Request.QueryString("search")) strSearchWords = Server.HTMLEncode(strSearchWords) sarySearchWord = Split(Trim(strSearchWords), " ") intFileNum = CInt(Request.QueryString("FileNumPosition")) intNumFilesShown = intFileNum Set fsoObject = Server.CreateObject("Scripting.FileSystemObject") If NOT Request.QueryString("search") = "" 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 & "
  Search results for " & strSearchWords & ".    No records found. Search results for " & strSearchWords & ".    Displayed results " & intFileNum + 1 & " - " & intNumFilesShown & " / " & intTotalFilesFound & "
" Response.Write vbCrLf & " " Response.Write vbCrLf & " " Response.Write vbCrLf & " " Response.Write vbCrLf & "
" If blnSearchResultsFound = False Then Response.Write vbCrLf & "
" Response.Write vbCrLf & " No results were found for your search: " & strSearchWords 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 & " Pages:  " If intNumFilesShown > intRecordsPerPage Then Response.Write vbCrLf & " << previous " 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 If intTotalFilesFound <> "" then%>
<%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 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 Set objRegExp = New RegExp objRegExp.Global = True objRegExp.IgnoreCase = True Set tsObject = filObject.OpenAsTextStream strFileContents = tsObject.ReadAll strPageTitle = Server.HTMLEncode(GetFileMetaTag("", strFileContents)) strPageDescription = Server.HTMLEncode(GetFileMetaTag("", strFileContents)) strPageKeywords = Server.HTMLEncode(GetFileMetaTag("", strFileContents)) objRegExp.Pattern = "<[^>]*>" strFileContents = objRegExp.Replace(strFileContents,"") strFileContents = strFileContents & " " & 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 = sarySearchWord(intSearchLoopCounter) 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 = "No Title" 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) sarySearchResults(intResultsArrayPosition,1) = sarySearchResults(intResultsArrayPosition,1) & vbCrLf & "
Number of words found " & intNumMatches & "  - Last upadate " & FormatDateTime(filObject.DateLastModified, VbLongDate) & "  -  Size " & CInt(filObject.Size / 1024) & "kb
" sarySearchResults(intResultsArrayPosition,2) = intNumMatches End If Set objRegExp = Nothing tsObject.Close End If End If Next 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 = Replace(strFileURL, " ", "%20") 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 '************* ARAMA MOTORU (SON) ********%>
Turkce Site Map Search Textile Dictionary