Boa tarde,
Estou a criar um site em ASP sem BD, só queria fazer um pesquisar que procurasse pelo site inteiro.
Possivel?
Publicidade
|
|
Page 1 of 1
Pesquisar
#2
Posted 22 March 2010 - 10:39 PM
olha este exemplo:
CÓDIGO
<% Option Explicit %>
<!--#include file="checkspell.asp" -->
<%
Response.Buffer = False
Dim tut
Dim tut1
Dim tutnet
tut = hour(time())*3600 + minute(time())*60 + Second(time())
dim mode, search
search = Request.QueryString("search")
mode = request.querystring("mode")
if mode = "google" then
Response.Redirect("site_search_google.asp?q=" & search & "")
end if
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
Dim Score
Const intRecordsPerPage = 10
strFilesTypesToSearch = "htm,html,asp,shtml,aspx"
strBarredFolders = "_vti_cnf,cgi_bin,_bin,_privet,login_interface,editor,admin,js"
strBarredFiles = "adminstation.htm,no_allowed.asp,admin.htm,admintools.asp,adminpower.asp,aspy
.asp,admin.asp"
blnEnglishLanguage = True
intTotalFilesSearched = 0
%>
<html>
<head>
<title>Search the Website</title>
<meta name="Description" content="Busca no site na web para páginas ou informações que são depois">
<meta name="KeyWords" content="Web site search">
<script language="JavaScript">
var search_icon_off = new Image();
search_icon_off.src = "site_search_icon_off.gif";
function CheckForm () {
if (document.frmSiteSearch.search.value==""){
alert("Please enter at least two keyword to search");
document.frmSiteSearch.search.focus();
return false;
}
return true
}
</script>
<style fprolloverstyle>A:hover {color: #FF0000}
</style>
</head>
<body bgcolor="#FFFFFF" text="#000000" link="#0000CC" vlink="#0000CC" alink="#FF0000">
<h1 align="center">
<img border="0" src="search.gif"></h1>
<form method="get" name="frmSiteSearch" action="site_search.asp" onSubmit="return CheckForm();">
<table cellpadding="0" cellspacing="0" width="90%" align="center" height="76">
<tr>
<td height="76" width="165" align="right" rowspan="3" valign="middle">
<font face="Arial"><img src="site_search_icon_on.gif" width="58" height="52" align="absmiddle" alt="Search the Web Site" name="searchIcon">
</font>
</td>
<td height="76" width="15" align="right" rowspan="3" valign="middle"> </td>
<td class="arial" height="16" width="571"> <b> <font face="Arial" size="2">Search Site:
</font> </b> </td>
</tr>
<tr>
<td class="normal" height="26" width="571">
<font face="Arial">
<b>
<input type="TEXT" name="search" maxlength="50" size="36" value="<% =Request.QueryString("search") %>"><font size="2">
</font>
<input type="submit" value="Search >>"><font size="2">
</font></b> </font>
</td>
</tr>
<tr>
<td class="normal" height="34" width="571" valign="top">
<p style="margin-top: -3; margin-bottom: -3">
<font face="Arial"><b><font size="2">Pesquisar em : </font>
<input type="radio" name="mode" value="allwords" CHECKED><font size="2">
Todas as Palavras </font>
<input type="radio" name="mode" value="anywords"><font size="2">
Qualquer palavra</font>
<input type="radio" name="mode" value="google"><font size="2"> Pesquisa no
Google</font></b></font></p>
<p style="margin-top: -3; margin-bottom: -3" align="right"> </td>
</tr>
</table>
</form>
<%
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 & " <table width=""98%"" border=""0"" cellspacing=""1"" cellpadding=""1"" align=""center"" bgcolor=""#3399FF"">"
Response.Write vbCrLf & " <tr>"
If blnSearchResultsFound = False Then
Response.Write vbCrLf & " <td> <font color =#ffffff>Procurou o local para <b> "& strSearchWords &" </ b>. Desculpe, nenhum resultado encontrado.</font></td>"
Else
tut1 = hour(time())*3600 + minute(time())*60 + Second(time())
tutnet = tut1 - tut
Response.Write vbCrLf & " <td> <font color =#ffffff>Procurou o local para <b> "& strSearchWords &" </ b>. Resultados Resultados" & intFileNum + 1 & " - " & intNumFilesShown & " of " & intTotalFilesFound & ". tempo de : <b>" & Tutnet & " Sec</B></font></td>"
End If
'Close the HTML table with the search status
Response.Write vbCrLf & " </tr>"
Response.Write vbCrLf & " </table>"
Dim MyString, MyArray, strWordy, t , SCheck
strwordy = request.QueryString("Search")
MyString = Split(strWordy, " ", -1, 1)
Scheck = request.QueryString("Spellcheck")
if SCheck = "True" then response.write(" <i>Spell Checked:</i> ")
if SCheck = "" OR "false" then response.write(" <i>You Mean :</i> ")
Dim MyCorrect(20)
t = 0
LoadDictArray
do while t <= UBound(MyString)
If len(MyString(t)) >= 15 then
response.write("<b><i>Nenhuma sugestão ortográfica</i></b>")
exit do
END IF
Dim strSoundex
Dim i
Dim strSuggestions
Dim intMaxSuggestions
Dim intSuggestionCount
Dim strSuggestion
Dim strSuggestionArray
Dim dblSimilarityArray
Dim dblSimilarity
Dim mySuggest
Dim strword
Dim strFilterWord
strWord = MyString(t)
if LCase(strWord) = "to" then
strFilterWord = LCase(strWord)
strword = ""
end if
if LCase(strWord) = "of" then
strFilterWord = LCase(strWord)
strword = ""
end if
if LCase(strWord) = "on" then
strFilterWord = LCase(strWord)
strword = ""
end if
intMaxSuggestions = 1
strSoundex = Soundex(strWord)
i = 0
do while i <= UBound(strDictArray)
if LCase(Left(strDictArray(i), 1)) <> LCase(Left(strWord, 1)) then
i = i + 1
else
exit do
end if
loop
do while i <= UBound(strDictArray)
if LCase(Left(strDictArray(i), 1)) = LCase(Left(strWord, 1)) then
if Soundex(strDictArray(i)) = strSoundex then
if strSuggestions & "" = "" then
strSuggestions = strDictArray(i)
else
strSuggestions = strSuggestions & "|" & strDictArray(i)
end if
end if
i = i + 1
else
exit do
end if
loop
mySuggest = Split(strSuggestions, "|")
if UBound(mySuggest) < intMaxSuggestions then
intSuggestionCount = UBound(mySuggest)
else
intSuggestionCount = intMaxSuggestions - 1
end if
ReDim strSuggestionArray(intSuggestionCount)
ReDim dblSimilarityArray(intSuggestionCount)
for each strSuggestion in mySuggest
dblSimilarity = WordSimilarity(strWord, strSuggestion)
i = intSuggestionCount
do while dblSimilarity > dblSimilarityArray(i)
if i < intSuggestionCount then
strSuggestionArray(i + 1) = strSuggestionArray(i)
dblSimilarityArray(i + 1) = dblSimilarityArray(i)
end if
strSuggestionArray(i) = strSuggestion
dblSimilarityArray(i) = dblSimilarity
i = i - 1
if i = -1 then
exit do
end if
loop
next
mySuggest = strSuggestionArray
if t > UBound(MyString) then
exit do
end if
t = t + 1
On Error Resume Next
Err.Number = 0
MyCorrect(t) = mySuggest(0)
If Err.Number <> 0 Then
Response.Write("<b>Nenhuma sugestão ortográfica</B>")
Err.Number = 0
Exit do
End If
loop
Dim MySys
MySys = Trim(Join(MyCorrect))
Response.write("<b><a href=site_search.asp?search=" & Replace(Replace(Mysys , " " , "+"), "++", "+") &"&mode=" & mode &"&SpellCheck=True>" & MySys & "</a></b>")
if len(strFilterWord)>0 then
Response.write(" || <font face =arial size = 2 color = gray><b>" & strFilterWord & "</b> Não está incluída em sua pesquisa.</font>")
end if
Response.Write vbCrLf & " <table width=""95%"" border=""0"" cellspacing=""1"" cellpadding=""1"" align=""center"">"
Response.Write vbCrLf & " <tr>"
Response.Write vbCrLf & " <td>"
If blnSearchResultsFound = False Then
Response.Write vbCrLf & " <br>"
Response.Write vbCrLf & " Sua Busca- <b>" & strSearchWords & "</b> - não encontrou quaisquer arquivos neste site. "
Response.Write vbCrLf & " <br><br>"
Response.Write vbCrLf & " sugestões:"
Response.Write vbCrLf & " <br>"
Response.Write vbCrLf & " <ul><li>Certifique-se de que todas as palavras estão escritas corretamente.<li>Tente palavras-chave diferentes. <li> Tente palavras-chave mais gerais. <li> Tente menos palavras-chave. <li> Experimente o Google Search. </ Ul> "
Else
For intDisplayResultsLoopCounter = (intFileNum + 1) to intNumFilesShown
Response.Write vbCrLf & " <br>"
Response.Write vbCrLf & " " & sarySearchResults(intDisplayResultsLoopCounter,1)
Response.Write vbCrLf & " <br>"
Next
End If
Response.Write vbCrLf & " </td>"
Response.Write vbCrLf & " </tr>"
Response.Write vbCrLf & " </table>"
End If
If intTotalFilesFound > intRecordsPerPage then
Response.Write vbCrLf & " <br>"
Response.Write vbCrLf & " <table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""0"" align=""center"">"
Response.Write vbCrLf & " <tr>"
Response.Write vbCrLf & " <td>"
Response.Write vbCrLf & " <table width=""100%"" border=""0"" cellpadding=""0"" cellspacing=""0"">"
Response.Write vbCrLf & " <tr>"
Response.Write vbCrLf & " <td width=""50%"" align=""center"">"
Response.Write vbCrLf & " Página de Resultados: "
If intNumFilesShown > intRecordsPerPage Then
Response.Write vbCrLf & " <a href=""site_search.asp?SpellCheck=" & SCheck & "&FileNumPosition=" & intFileNum - intRecordsPerPage & "&search=" & Replace(strSearchWords, " ", "+") & "&mode=" & Request.QueryString("mode") & """ target=""_self""><< Prev</a> "
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 & " <a href=""site_search.asp?SpellCheck=" & SCheck & "&FileNumPosition=" & (intPageLinkLoopCounter * intRecordsPerPage) - intRecordsPerPage & "&search=" & Replace(strSearchWords, " ", "+") & "&mode=" & Request.QueryString("mode") & """ target=""_self"">" & intPageLinkLoopCounter & "</a> "
End If
Next
End If
If intTotalFilesFound > intNumFilesShown then
Response.Write vbCrLf & " <a href=""site_search.asp?SpellCheck=" & SCheck & "&FileNumPosition=" & intNumFilesShown & "&search=" & Replace(strSearchWords, " ", "+") & "&mode=" & Request.QueryString("mode") & """ target=""_self"">Next >></a>"
End If
Response.Write vbCrLf & " </td>"
Response.Write vbCrLf & " </tr>"
Response.Write vbCrLf & " </table>"
Response.Write vbCrLf & " </td>"
Response.Write vbCrLf & " </tr>"
Response.Write vbCrLf & " </table>"
End If
%>
<font face="Arial">
<br>
</font>
<div align="center">
<div align="center">
<center>
<table width="98%" border="0" cellspacing="0" cellpadding="0" bgcolor="#CCCCCC" style="border-collapse: collapse" bordercolor="#111111">
<tr>
<td width="47%" height="18" bgcolor="#3399FF"><font face="Arial"> <b><font color="#FFFFFF" size="2">Pesquisa <% = intTotalFilesSearched %>documentos no total.
</font></b>
</font> </td>
<td width="53%" align="right" height="18" bgcolor="#3399FF"><%
Response.Write("<font color = #FFFFFF><b> Powered By - Google</b></font>")
%><font face="Arial"> </font>
</td>
</tr>
</table>
</center>
</div>
<script langauge="JavaScript">document.searchIcon.src = search_icon_off.src</script>
<font face="Arial">
<br>
</div>
<font face="Arial">
<br>
</font>
</body>
</html>
<%
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 Goto 0
Err.Number = 0
Set objRegExp = New RegExp
If Err.Number <> 0 Then
Response.Write("<br>Erro O servidor não suporta o Expessions Regular")
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("<title>", "</title>", strFileContents)
strPageDescription = GetFileMetaTag("<meta name=""description"" content=""", """>", strFileContents)
strPageKeywords = GetFileMetaTag("<meta name=""keywords"" content=""", """>", 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)
dim ssp,nssp
Set ssp = objRegExp.Execute(strPageTitle)
nssp = ssp.count
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 = "Untitled Page"
If strPageDescription = "" Then strPageDescription = "There is no description available for this page"
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) = "<a href=""./" & filObject.Name & """ target=""_self"">" & strPageTitle & "</a>"
Else
sarySearchResults(intResultsArrayPosition,1) = "<font face = Arial size=2><a href=""./" & strFileURL & fldObject.Name & "/" & filObject.Name & """ target=""_self"">" & strPageTitle & "</a></font>"
End If
if nssp > 0 then intNumMatches = (intNumMatches) + 10
if nssp = 0 then intNumMatches = (intNumMatches)
Score = (intNumMatches)*3
If Score > 100 then
score = 100
End if
sarySearchResults(intResultsArrayPosition,1) = sarySearchResults(intResultsArrayPosition,1) & vbCrLf & " <br>" & strPageDescription
sarySearchResults(intResultsArrayPosition,1) = sarySearchResults(intResultsArrayPosition,1) & vbCrLf & " <font size=""2"" color=""#0000FF""><br><i>Search Matches " & intNumMatches & " - Last Updated " & FormatDateTime(filObject.DateLastModified, VbLongDate) & " - Size " & CInt(filObject.Size / 1024) & "kb # Match Percent <img border=0 src=/iaorg/images/blue.jpg width=" & score & " height=10> " & Score & "%</i></font>"
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
%>
<!--#include file="checkspell.asp" -->
<%
Response.Buffer = False
Dim tut
Dim tut1
Dim tutnet
tut = hour(time())*3600 + minute(time())*60 + Second(time())
dim mode, search
search = Request.QueryString("search")
mode = request.querystring("mode")
if mode = "google" then
Response.Redirect("site_search_google.asp?q=" & search & "")
end if
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
Dim Score
Const intRecordsPerPage = 10
strFilesTypesToSearch = "htm,html,asp,shtml,aspx"
strBarredFolders = "_vti_cnf,cgi_bin,_bin,_privet,login_interface,editor,admin,js"
strBarredFiles = "adminstation.htm,no_allowed.asp,admin.htm,admintools.asp,adminpower.asp,aspy
.asp,admin.asp"
blnEnglishLanguage = True
intTotalFilesSearched = 0
%>
<html>
<head>
<title>Search the Website</title>
<meta name="Description" content="Busca no site na web para páginas ou informações que são depois">
<meta name="KeyWords" content="Web site search">
<script language="JavaScript">
var search_icon_off = new Image();
search_icon_off.src = "site_search_icon_off.gif";
function CheckForm () {
if (document.frmSiteSearch.search.value==""){
alert("Please enter at least two keyword to search");
document.frmSiteSearch.search.focus();
return false;
}
return true
}
</script>
<style fprolloverstyle>A:hover {color: #FF0000}
</style>
</head>
<body bgcolor="#FFFFFF" text="#000000" link="#0000CC" vlink="#0000CC" alink="#FF0000">
<h1 align="center">
<img border="0" src="search.gif"></h1>
<form method="get" name="frmSiteSearch" action="site_search.asp" onSubmit="return CheckForm();">
<table cellpadding="0" cellspacing="0" width="90%" align="center" height="76">
<tr>
<td height="76" width="165" align="right" rowspan="3" valign="middle">
<font face="Arial"><img src="site_search_icon_on.gif" width="58" height="52" align="absmiddle" alt="Search the Web Site" name="searchIcon">
</font>
</td>
<td height="76" width="15" align="right" rowspan="3" valign="middle"> </td>
<td class="arial" height="16" width="571"> <b> <font face="Arial" size="2">Search Site:
</font> </b> </td>
</tr>
<tr>
<td class="normal" height="26" width="571">
<font face="Arial">
<b>
<input type="TEXT" name="search" maxlength="50" size="36" value="<% =Request.QueryString("search") %>"><font size="2">
</font>
<input type="submit" value="Search >>"><font size="2">
</font></b> </font>
</td>
</tr>
<tr>
<td class="normal" height="34" width="571" valign="top">
<p style="margin-top: -3; margin-bottom: -3">
<font face="Arial"><b><font size="2">Pesquisar em : </font>
<input type="radio" name="mode" value="allwords" CHECKED><font size="2">
Todas as Palavras </font>
<input type="radio" name="mode" value="anywords"><font size="2">
Qualquer palavra</font>
<input type="radio" name="mode" value="google"><font size="2"> Pesquisa no
Google</font></b></font></p>
<p style="margin-top: -3; margin-bottom: -3" align="right"> </td>
</tr>
</table>
</form>
<%
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 & " <table width=""98%"" border=""0"" cellspacing=""1"" cellpadding=""1"" align=""center"" bgcolor=""#3399FF"">"
Response.Write vbCrLf & " <tr>"
If blnSearchResultsFound = False Then
Response.Write vbCrLf & " <td> <font color =#ffffff>Procurou o local para <b> "& strSearchWords &" </ b>. Desculpe, nenhum resultado encontrado.</font></td>"
Else
tut1 = hour(time())*3600 + minute(time())*60 + Second(time())
tutnet = tut1 - tut
Response.Write vbCrLf & " <td> <font color =#ffffff>Procurou o local para <b> "& strSearchWords &" </ b>. Resultados Resultados" & intFileNum + 1 & " - " & intNumFilesShown & " of " & intTotalFilesFound & ". tempo de : <b>" & Tutnet & " Sec</B></font></td>"
End If
'Close the HTML table with the search status
Response.Write vbCrLf & " </tr>"
Response.Write vbCrLf & " </table>"
Dim MyString, MyArray, strWordy, t , SCheck
strwordy = request.QueryString("Search")
MyString = Split(strWordy, " ", -1, 1)
Scheck = request.QueryString("Spellcheck")
if SCheck = "True" then response.write(" <i>Spell Checked:</i> ")
if SCheck = "" OR "false" then response.write(" <i>You Mean :</i> ")
Dim MyCorrect(20)
t = 0
LoadDictArray
do while t <= UBound(MyString)
If len(MyString(t)) >= 15 then
response.write("<b><i>Nenhuma sugestão ortográfica</i></b>")
exit do
END IF
Dim strSoundex
Dim i
Dim strSuggestions
Dim intMaxSuggestions
Dim intSuggestionCount
Dim strSuggestion
Dim strSuggestionArray
Dim dblSimilarityArray
Dim dblSimilarity
Dim mySuggest
Dim strword
Dim strFilterWord
strWord = MyString(t)
if LCase(strWord) = "to" then
strFilterWord = LCase(strWord)
strword = ""
end if
if LCase(strWord) = "of" then
strFilterWord = LCase(strWord)
strword = ""
end if
if LCase(strWord) = "on" then
strFilterWord = LCase(strWord)
strword = ""
end if
intMaxSuggestions = 1
strSoundex = Soundex(strWord)
i = 0
do while i <= UBound(strDictArray)
if LCase(Left(strDictArray(i), 1)) <> LCase(Left(strWord, 1)) then
i = i + 1
else
exit do
end if
loop
do while i <= UBound(strDictArray)
if LCase(Left(strDictArray(i), 1)) = LCase(Left(strWord, 1)) then
if Soundex(strDictArray(i)) = strSoundex then
if strSuggestions & "" = "" then
strSuggestions = strDictArray(i)
else
strSuggestions = strSuggestions & "|" & strDictArray(i)
end if
end if
i = i + 1
else
exit do
end if
loop
mySuggest = Split(strSuggestions, "|")
if UBound(mySuggest) < intMaxSuggestions then
intSuggestionCount = UBound(mySuggest)
else
intSuggestionCount = intMaxSuggestions - 1
end if
ReDim strSuggestionArray(intSuggestionCount)
ReDim dblSimilarityArray(intSuggestionCount)
for each strSuggestion in mySuggest
dblSimilarity = WordSimilarity(strWord, strSuggestion)
i = intSuggestionCount
do while dblSimilarity > dblSimilarityArray(i)
if i < intSuggestionCount then
strSuggestionArray(i + 1) = strSuggestionArray(i)
dblSimilarityArray(i + 1) = dblSimilarityArray(i)
end if
strSuggestionArray(i) = strSuggestion
dblSimilarityArray(i) = dblSimilarity
i = i - 1
if i = -1 then
exit do
end if
loop
next
mySuggest = strSuggestionArray
if t > UBound(MyString) then
exit do
end if
t = t + 1
On Error Resume Next
Err.Number = 0
MyCorrect(t) = mySuggest(0)
If Err.Number <> 0 Then
Response.Write("<b>Nenhuma sugestão ortográfica</B>")
Err.Number = 0
Exit do
End If
loop
Dim MySys
MySys = Trim(Join(MyCorrect))
Response.write("<b><a href=site_search.asp?search=" & Replace(Replace(Mysys , " " , "+"), "++", "+") &"&mode=" & mode &"&SpellCheck=True>" & MySys & "</a></b>")
if len(strFilterWord)>0 then
Response.write(" || <font face =arial size = 2 color = gray><b>" & strFilterWord & "</b> Não está incluída em sua pesquisa.</font>")
end if
Response.Write vbCrLf & " <table width=""95%"" border=""0"" cellspacing=""1"" cellpadding=""1"" align=""center"">"
Response.Write vbCrLf & " <tr>"
Response.Write vbCrLf & " <td>"
If blnSearchResultsFound = False Then
Response.Write vbCrLf & " <br>"
Response.Write vbCrLf & " Sua Busca- <b>" & strSearchWords & "</b> - não encontrou quaisquer arquivos neste site. "
Response.Write vbCrLf & " <br><br>"
Response.Write vbCrLf & " sugestões:"
Response.Write vbCrLf & " <br>"
Response.Write vbCrLf & " <ul><li>Certifique-se de que todas as palavras estão escritas corretamente.<li>Tente palavras-chave diferentes. <li> Tente palavras-chave mais gerais. <li> Tente menos palavras-chave. <li> Experimente o Google Search. </ Ul> "
Else
For intDisplayResultsLoopCounter = (intFileNum + 1) to intNumFilesShown
Response.Write vbCrLf & " <br>"
Response.Write vbCrLf & " " & sarySearchResults(intDisplayResultsLoopCounter,1)
Response.Write vbCrLf & " <br>"
Next
End If
Response.Write vbCrLf & " </td>"
Response.Write vbCrLf & " </tr>"
Response.Write vbCrLf & " </table>"
End If
If intTotalFilesFound > intRecordsPerPage then
Response.Write vbCrLf & " <br>"
Response.Write vbCrLf & " <table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""0"" align=""center"">"
Response.Write vbCrLf & " <tr>"
Response.Write vbCrLf & " <td>"
Response.Write vbCrLf & " <table width=""100%"" border=""0"" cellpadding=""0"" cellspacing=""0"">"
Response.Write vbCrLf & " <tr>"
Response.Write vbCrLf & " <td width=""50%"" align=""center"">"
Response.Write vbCrLf & " Página de Resultados: "
If intNumFilesShown > intRecordsPerPage Then
Response.Write vbCrLf & " <a href=""site_search.asp?SpellCheck=" & SCheck & "&FileNumPosition=" & intFileNum - intRecordsPerPage & "&search=" & Replace(strSearchWords, " ", "+") & "&mode=" & Request.QueryString("mode") & """ target=""_self""><< Prev</a> "
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 & " <a href=""site_search.asp?SpellCheck=" & SCheck & "&FileNumPosition=" & (intPageLinkLoopCounter * intRecordsPerPage) - intRecordsPerPage & "&search=" & Replace(strSearchWords, " ", "+") & "&mode=" & Request.QueryString("mode") & """ target=""_self"">" & intPageLinkLoopCounter & "</a> "
End If
Next
End If
If intTotalFilesFound > intNumFilesShown then
Response.Write vbCrLf & " <a href=""site_search.asp?SpellCheck=" & SCheck & "&FileNumPosition=" & intNumFilesShown & "&search=" & Replace(strSearchWords, " ", "+") & "&mode=" & Request.QueryString("mode") & """ target=""_self"">Next >></a>"
End If
Response.Write vbCrLf & " </td>"
Response.Write vbCrLf & " </tr>"
Response.Write vbCrLf & " </table>"
Response.Write vbCrLf & " </td>"
Response.Write vbCrLf & " </tr>"
Response.Write vbCrLf & " </table>"
End If
%>
<font face="Arial">
<br>
</font>
<div align="center">
<div align="center">
<center>
<table width="98%" border="0" cellspacing="0" cellpadding="0" bgcolor="#CCCCCC" style="border-collapse: collapse" bordercolor="#111111">
<tr>
<td width="47%" height="18" bgcolor="#3399FF"><font face="Arial"> <b><font color="#FFFFFF" size="2">Pesquisa <% = intTotalFilesSearched %>documentos no total.
</font></b>
</font> </td>
<td width="53%" align="right" height="18" bgcolor="#3399FF"><%
Response.Write("<font color = #FFFFFF><b> Powered By - Google</b></font>")
%><font face="Arial"> </font>
</td>
</tr>
</table>
</center>
</div>
<script langauge="JavaScript">document.searchIcon.src = search_icon_off.src</script>
<font face="Arial">
<br>
</div>
<font face="Arial">
<br>
</font>
</body>
</html>
<%
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 Goto 0
Err.Number = 0
Set objRegExp = New RegExp
If Err.Number <> 0 Then
Response.Write("<br>Erro O servidor não suporta o Expessions Regular")
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("<title>", "</title>", strFileContents)
strPageDescription = GetFileMetaTag("<meta name=""description"" content=""", """>", strFileContents)
strPageKeywords = GetFileMetaTag("<meta name=""keywords"" content=""", """>", 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)
dim ssp,nssp
Set ssp = objRegExp.Execute(strPageTitle)
nssp = ssp.count
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 = "Untitled Page"
If strPageDescription = "" Then strPageDescription = "There is no description available for this page"
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) = "<a href=""./" & filObject.Name & """ target=""_self"">" & strPageTitle & "</a>"
Else
sarySearchResults(intResultsArrayPosition,1) = "<font face = Arial size=2><a href=""./" & strFileURL & fldObject.Name & "/" & filObject.Name & """ target=""_self"">" & strPageTitle & "</a></font>"
End If
if nssp > 0 then intNumMatches = (intNumMatches) + 10
if nssp = 0 then intNumMatches = (intNumMatches)
Score = (intNumMatches)*3
If Score > 100 then
score = 100
End if
sarySearchResults(intResultsArrayPosition,1) = sarySearchResults(intResultsArrayPosition,1) & vbCrLf & " <br>" & strPageDescription
sarySearchResults(intResultsArrayPosition,1) = sarySearchResults(intResultsArrayPosition,1) & vbCrLf & " <font size=""2"" color=""#0000FF""><br><i>Search Matches " & intNumMatches & " - Last Updated " & FormatDateTime(filObject.DateLastModified, VbLongDate) & " - Size " & CInt(filObject.Size / 1024) & "kb # Match Percent <img border=0 src=/iaorg/images/blue.jpg width=" & score & " height=10> " & Score & "%</i></font>"
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
%>
#3
Posted 22 March 2010 - 10:57 PM
Obrigado
xanburzum
Mas está dificil. Eu parei de mexer em asp durante 2 anos.Estou mais em flash para voltar a isto...
xanburzum
Mas está dificil. Eu parei de mexer em asp durante 2 anos.Estou mais em flash para voltar a isto...
Share this topic:
Page 1 of 1
Similar Topics
| Topic | Forum | Started By | Stats | Last Post Info | |
|---|---|---|---|---|---|
|
Pesquisar sintomas na web pode levar a 'cibercondria'
|
Notícias |
Notícias
|
|
|
|
Computador mais rápido do mundo vai pesquisar energias do futuro
|
Notícias |
Notícias
|
|
|
|
Como Pesquisar Numa Gride E Trazer Resultados,
(como se fosse em delphi ou vb) |
PHP |
cnmmbh
|
|
|
|
Pesquisar antes de inserir
Quero relizar uma pesquisa no bd antes d |
ColdFusion |
Mac2004
|
|
|
|
Pesquisar em Mysql digitando apenas algumas letras
|
PHP |
motivado
|
|
|
|
Pesquisar 2 Tabelas e Gerar Resultados em uma 3
Com ajuda de Matrix, p/ ñ percorrer todas as linhas da TB várias vezes |
MySQL |
parenti
|
|
|
|
Alcatel e fabricantes de chips vão pesquisar consumo eficiente de energia
|
Notícias |
Notícias
|
|
|
|
Cinco mil cientistas vão pesquisar origem do universo pela web
|
Notícias |
Notícias
|
|
Publicidade
|
|

Help













