<% Option Explicit %> <% 'Set the response buffer to true Response.Buffer = False 'Dimension global variables Dim fsoObject 'File system object Dim fldObject 'Folder object Dim sarySearchWord 'Array delle perole da cercare Dim strSearchWords 'Contiene le parole da cercare Dim blnIsRoot 'true se la ricerca è sulla root Dim strFileURL 'memorizza il path del file nel sito Dim strServerPath 'memorizza il path del server Dim intNumFilesShown 'memorizza il numero di files visualizzati Dim intTotalFilesSearched 'memorizza il numero di files cercati Dim intTotalFilesFound 'memorizza il numero di istanze cercate e trovate Dim intFileNum 'memorizza il numero di file Dim intPageLinkLoopCounter 'contatore di loop . Memorizza il link alle eventuali altre pagine che compongono la ricerca Dim sarySearchResults(1000,2) 'matrice 1000x2 per memorizzare i rusultati della riceca Dim intDisplayResultsLoopCounter 'contatore di loopo per memorizzare i risultati della ricerca Dim intResultsArrayPosition 'passa la posizione nell'array dei risultati Dim blnSearchResultsFound 'true se la ricerca haprodotto qualcosa Dim strFilesTypesToSearch 'memorizza i tipi di files che devono essere cercati Dim strBarredFolders 'memorizziamo le cartelle da escludere dalla ricerca Dim strBarredFiles 'memorizza i nomi dei files che devono essere cercati Dim blnEnglishLanguage 'true se l'utente usa l'inglese come lingua ' -------------------------- QUANTI RISULTATI PER PAGINA?? ------------------------------------ Const intRecordsPerPage = 10 'se si vuole cambiare il numero di risultati per pagina, basta cambiare il valore ' --------------------- elenco delle estensioni di files che devono essere cercati separati da virgola -------------------------- strFilesTypesToSearch = "htm,html,asp,shtml,php,https,aspx" ' --------------------- Elenco delle cartelle da scludere dalla ricerca, separate da virgola -------------------------- strBarredFolders = "stats,_mmServerScripts" ' ' ---------- Elenco dei files da escludere dalla ricerca separati da virgola ------------- strBarredFiles = "aindex.asp" ' ' -------------------- Set this boolean to False if you are not using an English language web site -------------------------------------------------- blnEnglishLanguage = True 'True = Inglese ON \ False = Inglese OFF html encoding '----------------------------------------------------------------------------------------------------------------------------------------------------- 'Inizializzazione variabili intTotalFilesSearched = 0 %> Hotel Beauty spa .it motore di ricerca interno.
Lasciati trasportare dai profumi
e goditile cure e le coccole
dei migliori centri d
 i benessere e beauty spa in italia e all'estero
 
I TUOI DESIDERI
le migliori offerte selezionate per te da Hotel beauty spa
 
I PREFERITI
Più visitati Hotel beauty spa
 
GLOSSARIO - BENESSERE
Tutti i termini del benessere
 
MIA SPA
Tutto per la tua spa
 
MAILING LIST
Iscriviti
 
 
Uilizza il motore di ricerca libera:

Cerca nel sito ">
Cerca : tutte le parole parola per parola frase
<% 'le parole da cercare sono messe in una variabile strSearchWords = Trim(Request.QueryString("search")) 'se il sito è in inglese allora utilizzo l'html encoding If blnEnglishLanguage = True Then 'rimpiazzo i tags html con i loro caratteri corrispondenti (in questo modo se qualcuno inserisce tags html da cercare viene stoppato) strSearchWords = Server.HTMLEncode(strSearchWords) 'se il sito non è in inglese cambio i tags Else 'cambio solo <> con la loro codifica HTML < > strSearchWords = Replace(strSearchWords, "<", "<", 1, -1, 1) strSearchWords = Replace(strSearchWords, ">", ">", 1, -1, 1) End If 'metto le parole da crcare in un array pushandole sarySearchWord = Split(Trim(strSearchWords), " ") 'leggo il numero del file da visualizzare intFileNum = CInt(Request.QueryString("FileNumPosition")) 'imposto il numero di file visualizzati intNumFilesShown = intFileNum 'Creo il file system object Set fsoObject = Server.CreateObject("Scripting.FileSystemObject") 'se non sono state inserite parole da cercare allora If NOT strSearchWords = "" Then 'mi metto sulla root Set fldObject = fsoObject.GetFolder(Server.MapPath("./")) 'Leggo nel path del server questo script strServerPath = fldObject.Path & "\" 'se la ricerca è in radice allorea metto la variabile a true blnIsRoot = True 'metodo call per aviare la procedura di ricerca Call SearchFile(fldObject) 'Reset variabili del serve Set fsoObject = Nothing Set fldObject = Nothing 'ALGORITMO DI ORDINAMENTO = BUBBLE SORT Call SortResultsByNumMatches(sarySearchResults, intTotalFilesFound) 'Visualizzazione tabella html con i risultati Response.Write vbCrLf & " " Response.Write vbCrLf & " " 'non ci sono records If blnSearchResultsFound = False Then Response.Write vbCrLf & " " 'quanti records ho trovato? Else Response.Write vbCrLf & " " End If 'chiudo la tabella html Response.Write vbCrLf & " " Response.Write vbCrLf & "
 Ho cercato nel sito " & strSearchWords & ".    Nessun risultato. Ho cercato nel sito " & strSearchWords & ".    Risultati:" & intFileNum + 1 & " - " & intNumFilesShown & " di " & intTotalFilesFound & ".
" 'tabella dei risultati... se ce ne sono e di un messaggio con suggerimento se non ce ne sono Response.Write vbCrLf & " " Response.Write vbCrLf & " " Response.Write vbCrLf & " " Response.Write vbCrLf & " " Response.Write vbCrLf & "
" 'messaggio che esce se non ho trovato niente If blnSearchResultsFound = False Then 'mesaggio Response.Write vbCrLf & "
" Response.Write vbCrLf & " La ricerca per- " & strSearchWords & " - no ha dato risultati." Response.Write vbCrLf & "

" Response.Write vbCrLf & " Suggerimenti:" Response.Write vbCrLf & "
" Response.Write vbCrLf & "
  • Controlla di aver scritto le parole in modo corretto.
  • Cambia parole.
  • Inserisci parole di senso più generalizzato.
  • Inserisci meno chiavi.
" 'altrimenti vedo i risultati Else 'Scorro i risultati nel loro array For intDisplayResultsLoopCounter = (intFileNum + 1) to intNumFilesShown Response.Write vbCrLf & "
" Response.Write vbCrLf & " " & sarySearchResults(intDisplayResultsLoopCounter,1) Response.Write vbCrLf & "
" Next End If 'chiudo la tabella dei risultati Response.Write vbCrLf & "
" End If 'tabella dei links ad eventuai altri risultati If intTotalFilesFound > intRecordsPerPage then 'tabella dei links ad altri risultati 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 & " Pagina dei risultati:  " 'se sono a pag > 1 visualizzo il torna indietro If intNumFilesShown > intRecordsPerPage Then Response.Write vbCrLf & " << Precedente " End If 'se ci sono + pagine di risultati allora metto il link a tutte le pagine If intTotalFilesFound > intRecordsPerPage Then 'ogni risultato viene linkato alla pagina corrispondente For intPageLinkLoopCounter = 1 to CInt((intTotalFilesFound / intRecordsPerPage) + 0.5) 'se la pagina da linkare è quella corrente allora ovviamente non metto il link If intFileNum = (intPageLinkLoopCounter * intRecordsPerPage) - intRecordsPerPage Then Response.Write vbCrLf & " " & intPageLinkLoopCounter Else Response.Write vbCrLf & "  " & intPageLinkLoopCounter & "  " End If Next End If 'se non mi trovo all'ultima pagina dei risultati allora metto il link alla pagina successiva If intTotalFilesFound > intNumFilesShown then Response.Write vbCrLf & "  Successivo >>" End If 'chiudo la tabella Response.Write vbCrLf & "
" Response.Write vbCrLf & "
" End If %>
 Cercati <% = intTotalFilesSearched %> documenti. <% '***** START WARNING - REMOVAL OR MODIFICATION ****** 'Response.Write(" I migliori hotels e centri benessere su hotelbeautyspa .it") '***** END WARNING - REMOVAL OR MODIFICATION ****** %>


 
<% 'ricerca Public Sub SearchFile(fldObject) 'variabili locali Dim objRegExp 'oggetto espressione regolare Dim objMatches 'memorizza tutti gli oggetti espressioni regolari Dim filObject 'oggetto file Dim tsObject 'oggetto stream text Dim subFldObject 'oggetto sottocartella Dim strFileContents 'memorizzail contenuto del file che stiamo cercando Dim strPageTitle 'memorizza il titolo della pagina Dim strPageDescription 'memorizza la descrizione della pagina Dim strPageKeywords 'memorizza le keywords della pagina Dim intSearchLoopCounter 'contatore per cercare tutte le keywords nell'array Dim intNumMatches 'memorizza il numero di istanze Dim blnSearchFound 'se ho trovato qualcosa diventa true 'handler degli errori On Error Resume Next 'metto l'oggetto errore a 0 Err.Number = 0 'creo l'oggetto espressione regolare Set objRegExp = New RegExp 'In caso di errore.. If Err.Number <> 0 Then Response.Write("
Errore. Il server non supporta espressioni regolari.") 'resetto l'oggetto errore Err.Number = 0 End If 'loop di ricerca di ogni file nella cartella For Each filObject in fldObject.Files 'controllo le estensioni dei files da cercare If InStr(1, strFilesTypesToSearch, fsoObject.GetExtensionName(filObject.Name), vbTextCompare) > 0 Then 'controllo se il file corrente non sia del tipo da non cercare If NOT InStr(1, strBarredFiles, filObject.Name, vbTextCompare) > 0 Then 'inizializzo la ricerca mettendo la variabile a false blnSearchFound = False 'inizializzo il numero di istanze cercate e lo metto a zero intNumMatches = 0 'inizializzo la modalità dell'espressione regolae a globale objRegExp.Global = True 'inizializzo l'oggetto espressione regolare a IgnoreCase=true objRegExp.IgnoreCase = True 'Oapro il file per la ricerca Set tsObject = filObject.OpenAsTextStream 'leggo il contenuto del file strFileContents = tsObject.ReadAll 'leggo nel titolo strPageTitle = GetFileMetaTag("", "", strFileContents) 'leggo nella descrizione strPageDescription = GetFileMetaTag("", strFileContents) 'leggo nelle keywords strPageKeywords = GetFileMetaTag("", strFileContents) 'settaggio del pattern objRegExp.Pattern = "<[^>]*>" 'contenuto da cercare strFileContents = objRegExp.Replace(strFileContents,"") 'metto titolo,descrizione e chiavi nell'array di ricerca strFileContents = strFileContents & " " & strPageTitle & " " & strPageDescription & " " & strPageKeywords 'se l'utente ha scelto di cercare per frase If Request.QueryString("mode") = "phrase" Then 'settaggio del pattern di ricerca objRegExp.Pattern = "\b" & strSearchWords & "\b" 'cerco il file per la frase Set objMatches = objRegExp.Execute(strFileContents) 'vedo se la frase è stata trovata If objMatches.Count > 0 Then 'quante volte l'ho trovata? intNumMatches = objMatches.Count 'se l'ho trovata allora questa variabile diventa true blnSearchFound = True End If 'se non ho trovato la frase intera cerco tutte le parole distintamente Else 'Ise la ricerca eè per tutte le parole metto la variabile a true If Request.QueryString("mode") = "allwords" then blnSearchFound = True 'loop per ogi parola che deve essere cercata For intSearchLoopCounter = 0 to UBound(sarySearchWord) 'setto il pattern di ricerca objRegExp.Pattern = "\b" & sarySearchWord(intSearchLoopCounter) & "\b" 'cerco il file per la ricerca delle parole Set objMatches = objRegExp.Execute(strFileContents) 'Cho trovato delle parole? If objMatches.Count > 0 Then 'quante volte le ho trovate? intNumMatches = intNumMatches + objMatches.Count 'se ho trovato la parola ed il criterio è uguale a cerca tutte allora metto la variabile blnSearchFound a true If Request.QueryString("mode") = "anywords" then blnSearchFound = True Else 'se invece non ho trovato niente ed il criterio di ricerca è uguale a tutte le parole allora metto la variabile a false If Request.QueryString("mode") = "allwords" then blnSearchFound = False End If Next End If 'calcolo dei files totali cercati intTotalFilesSearched = intTotalFilesSearched + 1 'Se la pagina non ha titolo allora scrivo nessun titolo If strPageTitle = "" Then strPageTitle = "Hotel Beautyspa " 'se la pagina non ha descrizione allora plotto le keywords If strPageDescription = "" Then strPageDescription = "i migliori hotels su http://www.hotelbeautyspa.it" 'se la variabile è true allora visualizzo i risultati If blnSearchFound = True Then 'calcolo il numero di files trovati intTotalFilesFound = intTotalFilesFound + 1 'quanti sono i files trovati se sono maggiori del numero di files per pagina allora devo creare altre pagine If intNumFilesShown < (intRecordsPerPage + intFileNum) and intTotalFilesFound > intNumFilesShown Then 'calcolo del numero di risultati plottati intNumFilesShown = intNumFilesShown + 1 End If 'metto i risultati nell'array dei risultati 'calcolo la posizione del risultato nell'array intResultsArrayPosition = intResultsArrayPosition + 1 'metto il booleano del risultato a true blnSearchResultsFound = True 'se il file è nella directory allora If blnIsRoot = True Then 'piazzo il risultato della ricerca nell'array con link sarySearchResults(intResultsArrayPosition,1) = "" & strPageTitle & "" 'se non sono nella root directory Else 'metto il risultato della ricerca con link nell'array sarySearchResults(intResultsArrayPosition,1) = "" & strPageTitle & "" End If 'metto il resto della ricerca nell'array sarySearchResults(intResultsArrayPosition,1) = sarySearchResults(intResultsArrayPosition,1) & vbCrLf & "
" & strPageDescription sarySearchResults(intResultsArrayPosition,1) = sarySearchResults(intResultsArrayPosition,1) & vbCrLf & "
Risultati " & intNumMatches & "  -  Ultimo aggiornamento " & FormatDateTime(filObject.DateLastModified, VbLongDate) & "  -  Size " & CInt(filObject.Size / 1024) & "kb" 'leggo il numero di istanze cercate nella seconda parte della matrice sarySearchResults(intResultsArrayPosition,2) = intNumMatches End If 'chiudo lo stream tsObject.Close End If End If Next 'Rresetto l'espressione regolare Set objRegExp = Nothing 'cerco nelle sottocartelle For Each subFldObject In FldObject.SubFolders 'La cartella in cui voglio cercae è esclusa dalla ricerca? If NOT InStr(1, strBarredFolders, subFldObject.Name, vbTextCompare) > 0 Then 'non siamo più nella root ma in sottocartelle... blnIsRoot = False 'server path strFileURL = fldObject.Path & "\" 'rimpiazzo il percorso del file con quello del file relativo al path del server strFileURL = Replace(strFileURL, strServerPath, "") 'rimpiazzo i backslash (NT) strFileURL = Replace(strFileURL, "\", "/") 'codifico il nome ed il percorso del file con il metodo url strFileURL = Server.URLEncode(strFileURL) 'se qualche backslash non dovesse essere stato codificato strFileURL = Replace(strFileURL, "%2F", "/") 'procedura di ricerca Call SearchFile(subFldObject) End If Next 'reset delle variabili del server Set filObject = Nothing Set tsObject = Nothing Set subFldObject = Nothing End Sub 'Ordino il vettoe dei risultati con il bubble sort, quelli con più istanze vanno davanti Private Sub SortResultsByNumMatches(ByRef sarySearchResults, ByRef intTotalFilesFound) 'variabili Dim intArrayGap 'Hmemorizza la parte d array che deve essere copiata Dim intIndexPosition 'memorizza gli indici dell'array che devono essere copiati Dim intTempResultsHold 'se devo cambiare posizione ad un risultato memorizzo temporaneamente in questa var Dim intTempNumMatchesHold 'variabile temporanea per memorizzare il numero di istanze Dim intPassNumber 'memorizzo il numero di passo per l'ordinamento 'loop di ordinamento dei risultati For intPassNumber = 1 To intTotalFilesFound 'i più piccoli dietro For intIndexPosition = 1 To (intTotalFilesFound - intPassNumber) 'e i più grandi davanti If sarySearchResults(intIndexPosition,2) < sarySearchResults((intIndexPosition+1),2) Then 'metto i risultati nella variabile temporanea intTempResultsHold = sarySearchResults(intIndexPosition,1) 'metto il numero dei risultati trovati nella seconda variabile temporanea intTempNumMatchesHold = sarySearchResults(intIndexPosition,2) 'swappo l'array 'muovo in avanti i risultati con il numero più alto di risultati sarySearchResults(intIndexPosition,1) = sarySearchResults((intIndexPosition+1),1) 'muovo in avanti i risultati con il più alto match rate sarySearchResults(intIndexPosition,2) = sarySearchResults((intIndexPosition+1),2) 'Mmuovo effettivamente i risultati dalla variabile temporanea al vettore dei risultati sarySearchResults((intIndexPosition+1),1) = intTempResultsHold 'muovo i risultati dalla variabile temporanea alla posizione successiva del vettore dei sirultati sarySearchResults((intIndexPosition+1),2) = intTempNumMatchesHold End If Next Next End Sub 'funzione di lettura dei meta tags all'interno dei files Private Function GetFileMetaTag(ByRef strStartValue, ByRef strEndValue, ByVal strFileContents) 'variabili Dim intStartPositionInFile 'memorizzo la posizione di partenza all'interno del file Dim intEndPositionInFile 'memorizzo la posizione finale all'interno del file 'vado alla posizione iniziale intStartPositionInFile = InStr(1, LCase(strFileContents), strStartValue, 1) 'se non sono state trovate keywords o descrizione cerco per http-equiv= al posto di name= nei meta tags If intStartPositionInFile = 0 And InStr(strStartValue, "name=") Then 'scambio nome per http-equiv= strStartValue = Replace(strStartValue, "name=", "http-equiv=") 'Cerca di nuovo keywords e descrizioni intStartPositionInFile = InStr(1, LCase(strFileContents), strStartValue, 1) End If 'Se c'è una posizione allora nel file il suo valore è maggiore di zero If NOT intStartPositionInFile = 0 Then 'retistuisce la posizione del meta tag di chiusura di html intStartPositionInFile = intStartPositionInFile + Len(strStartValue) 'restituisce la posizione nel file del tag di chiusura intEndPositionInFile = InStr(intStartPositionInFile, LCase(strFileContents), strEndValue, 1) 'Legge nel meta tag dal file per la funzione da restituire GetFileMetaTag = Trim(Mid(strFileContents, intStartPositionInFile, (intEndPositionInFile - intStartPositionInFile))) 'se non ci sono meta tags la funzione GetFileMetaTag restituisce un valore =null Else GetFileMetaTag = "" End If End Function %>