İstanbul Çorap
Arama
<%'*********** 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 %>
  Aranacak Kelime(ler):
">
Şeçenekler: Bütün Kelimeler Kelime kelime Cümle
<% ' ------ 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 & "
  " & strSearchWords & " için arama sonuçları.    Kayıt bulunamadı. " & strSearchWords & " için arama sonucu.    Görüntülenen aramalar " & 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 & " Sizin aradığınız kelime - " & strSearchWords & " - site içerisinde bulunamadı." Response.Write vbCrLf & "

" Response.Write vbCrLf & " Önerimiz:" Response.Write vbCrLf & "
" Response.Write vbCrLf & "
  • Arama seçeneklerinde Bütün kelimeri seçmeniz.
  • Kelimeyi kontrol etmeniz.
  • Başka bir kelime seçmeniz.
  • Kelimenin tamamını yazmanız.
" 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 & " Sonuç sayfaları:  " If intNumFilesShown > intRecordsPerPage Then Response.Write vbCrLf & " << Geri " 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 & "  ileri >>" End If Response.Write vbCrLf & "
" Response.Write vbCrLf & "
" End If If intTotalFilesFound <> "" then%>
 Arama Sonucu <%=intTotalFilesFound%> tane sayfa bulundu


<%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 = "Başlıksız" 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 & "
Bulunan kelime sayısı " & intNumMatches & "  -  En son güncelleme " & FormatDateTime(filObject.DateLastModified, VbLongDate) & "  -  Boyutu " & 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) ********%>
English Kolay Ulaşım Arama Tekstil Sözlüğü