<% Option Explicit %>
<%
'Setta il response.buffer a true
Response.Buffer = True
'Dimensiono le variabili server
Dim FSO 'File system object
Dim Cartella 'Cartella
Dim ArrayParole 'Array per contenere le parole da cercare
Dim ParoleDaCercare 'Parole da ricercare
Dim Root 'Variabile Booleana per riconoscere la root
Dim FileURL 'Contiene il percorso del file sul sito
Dim ServerPath 'Contiene il percorso di questo script sul server
Dim FileVisualizzati 'Contiene il numero di file visualizzati per volta
Dim TotaleFileCercati 'Numero di file in cui è stata effettuata la ricerca
Dim TotaleFileTrovati 'Numero dei file in cui è stata trovata una corrispondenza
Dim NumeroFile 'Numero totale dei file
Dim LoopContaLinkPagine 'Conta i loop per mostrare i link alle pagine
Dim ArrayRisultatiRicerca(200) 'Array per contenere i risultati della ricerca
Dim LoopContaLinkPagineRisultati 'Conta i loop per mostrare i risultati della
ricerca
Dim ArrayPosizioneRisultati 'Posizione nell'Array dei risultati
Dim CorrispondenzaTrovata 'Controlla se sono state trovate delle corrispondenze
Dim TipiDiFileDoveCercare 'Estensioni dei file dove effettuare la ricerca
Dim CartellaDaEscludere 'Cartelle dove non effettuare la ricerca
Dim FileDaEscludere 'Nomi dei file da escludere dalla ricerca
Dim WebInInglese 'Impostazione linguiaggio del sito web
'----------------------------------------------------------------------------------------------------------------------------
'INIZIO --- VARIABILI CHE È POSSIBILE MODIFICARE DIRETTAMENTE
'----------------------------------------------------------------------------------------------------------------------------
'Imposta il numero di risultati da visualizzare per ogni pagina
Const RecordsPerPagina = 10
'Estensioni dei file dove verrà effettuata la ricerca (devono essere
separate da (,) virgola)
TipiDiFileDoveCercare = "htm,html,asp,shtml"
'Cartelle dove non deve essere effettuata la ricerca (devono essere separate
da (,) virgola)
CartellaDaEscludere = "cgi_bin,_bin,fpdb,db"
'Nomi dei file da escludere dalla ricerca (devono essere separate da (,) virgola
ed avere il nome completo)
FileDaEscludere = "riservato.htm,file_protetto.asp"
'Impostazione linguiaggio del sito web
'True = Inglese False = Altre Lingue
WebInInglese = False
'----------------------------
'FINE --- VARIABILI CHE È POSSIBILE MODIFICARE DIRETTAMENTE
'---------------------------------------
'Reset variabile
TotaleFileCercati = 0
%>
<html>
<head>
<title>Motore di ricerca</title>
<meta name="description" content="Consente di effettuare la
ricerca di parole o informazioni all'interno delle pagine del web">
<script language="JavaScript">
<!--
//Controlla il form prima di spedirlo
function ControllaForm () {
//Messaggio di errore se il form è vuoto
if (document.FormMotoreDiRicerca.CosaCerco.value=="")
{
alert("Inserire almeno una parola da cercare");
document.FormMotoreDiRicerca.CosaCerco.focus();
return false;
}
return true
}
// -->
</script>
</head>
<body bgcolor="#FFFFFF" text="#000000" link="#0000CC"
vlink="#0000CC" alink="#FF0000">
<font face="Verdana">
<h1 align="center">Motore di ricerca</h1>
<form method="get" name="FormMotoreDiRicerca" action="motorediricerca.asp"
onSubmit="return ControllaForm();">
<table cellpadding="0" cellspacing="0" align="center">
<tr>
<td align="center"> Parole da cercare: </td>
</tr>
<tr>
<td align="center">
<input type="TEXT" name="CosaCerco" maxlength="50"
size="50" value="<% =Request.QueryString("CosaCerco")
%>">
<input name="Davide Vogliotti" type="submit" value="Cerca
>>">
</td>
</tr>
<tr>
<td valign="top" align="center">
<input type="radio" name="TipoDiRicerca" value="AlmenoUnaParola"
CHECKED>
Almeno una parola
<input type="radio" name="TipoDiRicerca" value="TutteLeParole">
Tutte le parole
<input type="radio" name="TipoDiRicerca" value="FraseIntera">
Frase intera</td>
</tr>
</table>
</form>
<%
'Inserisce tutte le parole da cercare in una variabile
ParoleDaCercare = Trim(Request.QueryString("CosaCerco"))
'Se il web è in Inglese usa il metodo Server HTML
Encode
If WebInInglese = True Then
'Sostitiusce tutti i tag HTML con il codice HTML equivalente (stoppa le persone
che inseriscono tag HTML)
ParoleDaCercare = Server.HTMLEncode(ParoleDaCercare)
'Se non è in Ingelse cambia solo i tag dello script
Else
'Sostituisce i tag <> con il codice HTML encoded < and >
ParoleDaCercare = Replace(ParoleDaCercare, "<", "<",
1, -1, 1)
ParoleDaCercare = Replace(ParoleDaCercare, ">", ">",
1, -1, 1)
End If
'Inserisce tutte le parole da cercare in un Array
ArrayParole = Split(Trim(ParoleDaCercare), " ")
'Legge il numero del file da dove iniziare a visualizzare
i risultati
NumeroFile = CInt(Request.QueryString("PosizioneDiPartenza"))
'Imposta il numero dei file che devono essere visualizzati
FileVisualizzati = NumeroFile
'Crea il file system object
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
'Se non ci sono parole da cercare non chiama la routine
di ricerca
If NOT ParoleDaCercare = "" Then
'Imposta il path e la root folder dove effettuare la
ricerca
Set Cartella = FSO.GetFolder(Server.MapPath("./"))
'Legge il path corrente di questo script
ServerPath = Cartella.Path & ""
'Imposta a true se lo script sta cercando nella root
Root = True
'Chimata alla routine di ricerca
Call SearchFile(Cartella)
'Resetta le variabili del server
Set FSO = Nothing
Set Cartella = Nothing
'Visualizza la tabella HTML con lo stato della ricerca
Response.Write vbCrLf & " <table width=""98%""
border=""0"" cellspacing=""1"" cellpadding=""1""
align=""center"" bgcolor=""#CCCCCC"">"
Response.Write vbCrLf & " <tr>"
'Visualizza che non sono stati trovati risultati
If CorrispondenzaTrovata = False Then
Response.Write vbCrLf & " <td> Ricerca effettuata nel
sito per <b>" & ParoleDaCercare & "</b> Spiacente,
nessuna corrispondenza trovata.</td>"
'Altrimenti visualizza quanti record sono stati trovati
Else
Response.Write vbCrLf & " <td> Ricerca effettuata nel
sito per <b>" & ParoleDaCercare & "</b> Risultati
da " & NumeroFile + 1 & " a " & FileVisualizzati
& " di " & TotaleFileTrovati & "</td>"
End If
'Chiude la tabella con lo stato della ricerca
Response.Write vbCrLf & " </tr>"
Response.Write vbCrLf & " </table>"
'Tabella HTML che visualizza i risultati della ricerca o l'errore se non ci
sono risultati
Response.Write vbCrLf & " <table width=""95%""
border=""0"" cellspacing=""1"" cellpadding=""1""
align=""center"">"
Response.Write vbCrLf & " <tr>"
Response.Write vbCrLf & " <td>"
'Se non ci sono risultati visualizza un errore
If CorrispondenzaTrovata = False Then
'Errore visualizzato
Response.Write vbCrLf & " <br>"
Response.Write vbCrLf & " La ricerca - <b>" & ParoleDaCercare
& "</b> - non ha fornito risultati su questo sito."
Response.Write vbCrLf & " <br><br>"
Response.Write vbCrLf & " Consigli :"
Response.Write vbCrLf & " <br>"
Response.Write vbCrLf & " <ul><li>Controla di aver digitato
correttamente le parole.<li>Utilizza altre parole.<li>Utilizza parole
meno specifiche.<li>Utilizza meno parole.</ul>"
'Altrimenti visualizza i risultati
Else
'Loop per visualizzare ogni risultato presente
For LoopContaLinkPagineRisultati = 1 to (FileVisualizzati - NumeroFile)
Response.Write vbCrLf & " <br>"
Response.Write vbCrLf & " " & ArrayRisultatiRicerca(LoopContaLinkPagineRisultati)
Response.Write vbCrLf & " <br>"
Next
End If
'Chiude la tabella che visualizza i risultati
Response.Write vbCrLf & " </td>"
Response.Write vbCrLf & " </tr>"
Response.Write vbCrLf & " </table>"
End If
'Controlla il numero di risultati e visualizza una tabella
HTML con i links agli altri risultati
If TotaleFileTrovati > RecordsPerPagina Then
'Visualizza una tabella HTML con i links agli altri
risultati
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 & " Pagine : "
'Se la pagina è successiva alla 1 allora visualizza il link per tornare
indietro
If FileVisualizzati > RecordsPerPagina Then
Response.Write vbCrLf & " <a href=""motorediricerca.asp?PosizioneDiPartenza="
& NumeroFile - RecordsPerPagina & "&CosaCerco=" &
Replace(ParoleDaCercare, " ", "+") & "&TipoDiRicerca="
& Request.QueryString("TipoDiRicerca") & """
target=""_self""><< Precedente</a>
"
End If
'Se ci sono più pagine visualizza il link alle altre pagine
If TotaleFileTrovati > RecordsPerPagina Then
'Loop per visualizzare un link per ogni pagina di risultati
For LoopContaLinkPagine = 1 to CInt((TotaleFileTrovati / RecordsPerPagina) +
0.5)
'Se la pagina da linkare è quella corrente non la visualizza come link
ma come testo
If NumeroFile = (LoopContaLinkPagine * RecordsPerPagina) - RecordsPerPagina
Then
Response.Write vbCrLf & " " & LoopContaLinkPagine
Else
Response.Write vbCrLf & " <a href=""motorediricerca.asp?PosizioneDiPartenza="
& (LoopContaLinkPagine * RecordsPerPagina) - RecordsPerPagina & "&CosaCerco="
& Replace(ParoleDaCercare, " ", "+") & "&TipoDiRicerca="
& Request.QueryString("TipoDiRicerca") & """
target=""_self"">" & LoopContaLinkPagine &
"</a> "
End If
Next
End If
'Se la pagina corrente non è l'ultima visualizza un link per le pagine
successive
If TotaleFileTrovati > FileVisualizzati Then
Response.Write vbCrLf & " <a href=""motorediricerca.asp?PosizioneDiPartenza="
& FileVisualizzati & "&CosaCerco=" & Replace(ParoleDaCercare,
" ", "+") & "&TipoDiRicerca=" & Request.QueryString("TipoDiRicerca")
& """ target=""_self"">Successiva >></a>"
End If
'Chiude la tabella
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
%>
<br>
<div align="center">
<table width="98%" border="0" cellspacing="1"
cellpadding="1" bgcolor="#CCCCCC" align="center">
<tr>
<td width="47%" height="18"> La ricerca è
stata effettuata in <% = TotaleFileCercati %> documenti. </td>
<td width="53%" align="right" height="18">
<a href="http://www.freeasphost.co.uk/defcon/" target="_blank">Davide
Vogliotti</a> </td>
</tr>
</table>
<br>
<br>
</body>
</html>
<%
'Routine per effettuare la ricerca
Public Sub SearchFile(Cartella)
'Dimensiona le variabili locali
Dim File 'File
Dim StreamTesto 'Contenuto del File
Dim SottoCartella 'Sottocartelle
Dim DavideVogliotti 'Mania di protagonismo
Dim ContenutoDelFile 'Contenuto del file
Dim TitoloDellaPagina 'Contiene il titolo della pagina
Dim InizioTitoloDelFile 'Posizione di inizio del titolo della pagina nel file
utilizzato
Dim FineTitoloDelFile 'Posizione di fine del titolo della pagina nel file utilizzato
Dim DescrizioneDellaPagina 'Descrizione del file
Dim InizioDescrizioneDellaPagina 'Posizione di inizio della descrizione della
pagina nel file utilizzato
Dim FineDescrizioneDellaPagina 'Posizione di fine della descrizione della pagina
nel file utilizzato
Dim ContaParoleDaCercare 'Conta le parole che devono essere cercate nell Array
Dim TrovatoRisultati 'Se viene trovata una corrispondenza il valore è
True
'Gestore dell'errore
On Error Resume Next
'Loop per cercare in tutti i file nella cartella
For Each File in Cartella.Files
'Controlla l'estensione del file per autorizzare la ricerca
If InStr(1, TipiDiFileDoveCercare, FSO.GetExtensionName(File.Name), vbTextCompare)
> 0 Then
'Controlla che il file non sia di quelli esclusi dalla ricerca
If NOT InStr(1, FileDaEscludere, File.Name, vbTextCompare) > 0 Then
'Apre il file per la ricerca
Set StreamTesto = File.OpenAsTextStream
'Legge il contenuto del file
ContenutoDelFile = StreamTesto.ReadAll
'Imposta il risultato come False
TrovatoRisultati = False
'Se l'utente ha scelto di il metodo di ricerca FraseIntera
If Request.QueryString("TipoDiRicerca") = "FraseIntera"
Then
'Cerca nel file come FraseIntera
If InStr(1, LCase(ContenutoDelFile), LCase(ParoleDaCercare), 1) Then
'Se viene trovata una corrispondenza imposta la variabile come True
TrovatoRisultati = True
End If
'Se l'utente ha scelto di il metodo di ricerca Tutte le parole o Almeno una
parola
Else
'Se la ricerca è impostata per Tutte le parole allora setta la variabile
come True
If Request.QueryString("TipoDiRicerca") = "TutteLeParole"
Then TrovatoRisultati = True
'Loop per cercare tutte le parole richieste
For ContaParoleDaCercare = 0 to UBound(ArrayParole)
'Cerca nel file le parole richieste
If InStr(1, LCase(ContenutoDelFile), LCase(ArrayParole(ContaParoleDaCercare)),
1) Then
'Se la parola è stata trovata setta la variabile come True
If Request.QueryString("TipoDiRicerca") = "AlmenoUnaParola"
Then TrovatoRisultati = True
Else
'Se la parola non è stata trovata e la ricerca è su Tutte le parole
allora setta la variabile a False perchè una parola non è stata
trovata
If Request.QueryString("TipoDiRicerca") = "TutteLeParole"
Then TrovatoRisultati = False
End If
Next
End If
'Calcola il totale dei file nei quali è stata effettuata la ricerca
TotaleFileCercati = TotaleFileCercati + 1
'Se la variabile della ricerca è True allora
visualizza i risultati
If TrovatoRisultati = True Then
'Calcola il totale dei file trovati
TotaleFileTrovati = TotaleFileTrovati + 1
'Calcola che i file visualizzati non superino il numero
di file da visualizzare per pagina
If FileVisualizzati < (RecordsPerPagina + NumeroFile) and TotaleFileTrovati
> FileVisualizzati Then
'Incrementa il numero di file visualizzati
FileVisualizzati = FileVisualizzati + 1
'Legge il titolo del file
InizioTitoloDelFile = InStr(1, lcase(ContenutoDelFile), "<title>",
1) + 7
'Se c'è un titolo imposta l'inizio alla fine del tag <title>
If NOT InizioTitoloDelFile = 7 Then
'Legge la posizione del tag di chiusura del titolo (</title>)
FineTitoloDelFile = InStr(InizioTitoloDelFile, ContenutoDelFile, "</title>",
1)
'Recupera il titolo eliminando tutto quello prima e dopo ai tag HTML
TitoloDellaPagina = Server.HTMLEncode(Trim(Mid(ContenutoDelFile, InizioTitoloDelFile,
(FineTitoloDelFile - InizioTitoloDelFile))))
'Se non c'è nessun titolo imposta la variabile con una stringa a scelta
Else
TitoloDellaPagina = "Nessun titolo"
End If
'Legge le descrizione del file
'Trova l'inizio della descrizione del file
InizioDescrizioneDellaPagina = InStr(1, ContenutoDelFile, "<meta name=""description""
content=""", 1)
'Se c'è una descrizione allora la posizione nel file sarà diversa
da 0
If NOT InizioDescrizioneDellaPagina = 0 Then
'Trova la posizione di inizio del tag HTML della descrizione
InizioDescrizioneDellaPagina = InizioDescrizioneDellaPagina + Len("<meta
name=""description"" content=""")
'Trova la posizione di chiusura del tag HTML della descrizione
FineDescrizioneDellaPagina = InStr(InizioDescrizioneDellaPagina, ContenutoDelFile,
""">", 1)
'Legge la descrizione del file
DescrizioneDellaPagina = Server.HTMLEncode(Trim(Mid(ContenutoDelFile, InizioDescrizioneDellaPagina,
(FineDescrizioneDellaPagina - InizioDescrizioneDellaPagina))))
'Se non c'è nessuna descrizione imposta la variabile con una stringa
a scelta
Else
DescrizioneDellaPagina = "Nessuna descrizione disponibile per questa pagina"
End If
'Mette i risultati della ricerca nell' Array dei risultati
'e calcola la posizione nell'Array del risultato ottenuto
ArrayPosizioneRisultati = ArrayPosizioneRisultati + 1
'Dichiara di aver trovato una corrispondenza
CorrispondenzaTrovata = True
'Controlla se il file è nella root
If Root = True Then
'Mette il risultato della ricerca nell' Array dei risultati
ArrayRisultatiRicerca(ArrayPosizioneRisultati) = "<a href=""./"
& File.Name & """ target=""_self"">"
& TitoloDellaPagina & "</a><br>" & vbCrLf
& " " & DescrizioneDellaPagina
'Se non è nella root
Else
'Mette il risultato della ricerca nell' Array dei risultati
ArrayRisultatiRicerca(ArrayPosizioneRisultati) = "<a href=""./"
& FileURL & Cartella.Name & "/" & File.Name &
""" target=""_self"">" & TitoloDellaPagina
& "</a><br>" & vbCrLf & " " &
DescrizioneDellaPagina
End If
End If
End If
'Chiude il file per la ricerca
StreamTesto.Close
End If
End If
Next
'Ciclo per cercare nelle sottocartelle
For Each SottoCartella In Cartella.SubFolders
'Controlla che la cartella dove viene effettuata la ricerca non sia tra le cartelle
da escludere
If NOT InStr(1, CartellaDaEscludere, SottoCartella.Name, vbTextCompare) >
0 Then
'Imposta la root a False in quanto si sta cercando in una sottocartella
Root = False
'Recupera il percorso del file
FileURL = Cartella.Path & ""
'Converte il percorso del server in URL
FileURL = Replace(FileURL, ServerPath, "")
'Rimpiazza il carattere di NT con il carattere / utilizzato
nei percorsi internet
FileURL = Replace(FileURL, "", "/")
'Sostituisce gli spazi presenti nel percorso con il
carattere equivalente %20
FileURL = Replace(FileURL, " ", "%20")
'Richiama la routine di ricerca
Call SearchFile(SottoCartella)
End If
Next
'Resetta le variabili server
Set File = Nothing
Set StreamTesto = Nothing
Set SottoCartella = Nothing
End Sub
%>