begin process at 2010 02 09 12:42:44
  Trouver un code source :
 
dans
 
Accueil > Forum > 

Archive ASP & ASP.NET

 > 

Archives ASP & ASP.NET

 > 

AU SECOURS !!!!

 > 

Moteur de recherche interne


Derniers messages déposésPoser une question dans le forum ou lancer une discussion

Moteur de recherche interne

mercredi 4 janvier 2006 à 16:51:49 | Moteur de recherche interne

LABAUDE

Bonjour, je n'en pleux plus

Je souhaite mettre en ligne un moteur de recherche mais lorsque je tape test, il me ressort

attestant
test
testeur

Je souhaiterai uniquement qu'il me ressorte test. Voici les lignes de code. Merci et en esperant que quelqu'un pourra m'aider... :



mercredi 4 janvier 2006 à 16:55:03 | Voici le code HTML de la page

LABAUDE

<% QueryString = Request.QueryString( "recherche" ) QueryWords = Split( QueryString ) strIndent = "               " ' Setup SQL sql = "SELECT dictionary_concepts.id_indices, dictionary_concepts.label_fr AS dictionary_concepts_label_fr, dictionary_keywords.label_fr AS dictionary_keywords_label_fr, dictionary_keywords.definition_fr, dictionary_keywords.id_concepts, dictionary_keywords.id AS dictionary_keywords_id FROM dictionary_concepts INNER JOIN dictionary_keywords ON dictionary_concepts.id = dictionary_keywords.id_concepts WHERE" ' Search Description sql = sql & " ( [dictionary_concepts.label_fr] LIKE '%" & QueryWords( 0 ) & "%'" ' First For i = LBound( QueryWords ) + 1 to UBound( QueryWords ) If QueryWords( i ) <> "" and UCase( QueryWords(i) ) <> "OR" and UCase( QueryWords(i) ) <> "AND" Then If uCase( QueryWords( i-1 ) ) = "OR" Then sql = sql & " OR [dictionary_concepts.label_fr] LIKE '%" & QueryWords( i ) & "%'" Else sql = sql & " AND [dictionary_concepts.label_fr] LIKE '%" & QueryWords( i ) & "%'" End If End If Next ' Search Keywords sql = sql & " ) OR ( [dictionary_keywords.label_fr] LIKE '%" & QueryWords( 0 ) & "%'" For i = LBound( QueryWords ) + 1 to UBound( QueryWords ) If QueryWords( i ) <> "" and UCase( QueryWords(i) ) <> "OR" and UCase( QueryWords(i) ) <> "AND" Then If uCase( QueryWords( i-1 ) ) = "OR" Then sql = sql & " OR [dictionary_keywords.label_fr] LIKE '%" & QueryWords( i ) & "%'" Else sql = sql & " AND [dictionary_keywords.label_fr] LIKE '%" & QueryWords( i ) & "%'" End If End If Next ' Search Title sql = sql & " ) OR ( [dictionary_keywords.definition_fr] LIKE '%" & QueryWords( 0 ) & "%'" For i = LBound( QueryWords ) + 1 to UBound( QueryWords ) If QueryWords( i ) <> "" and UCase( QueryWords(i) ) <> "OR" and UCase( QueryWords(i) ) <> "AND" Then If uCase( QueryWords( i-1 ) ) = "OR" Then sql = sql & " OR [dictionary_keywords.definition_fr] LIKE '%" & QueryWords( i ) & "%'" Else sql = sql & " AND [dictionary_keywords.definition_fr] LIKE '%" & QueryWords( i ) & "%'" End If End If Next sql = sql & " ) ORDER BY dictionary_concepts.id_indices, dictionary_keywords.label_fr" ' Fetch Set rs = Server.CreateObject("ADODB.Recordset") rs.Open sql, conn, 3, 3 %>
 


Votre recherche : <% Response.Write QueryString %>

<% Dim MyString, MyArray, strWordy, t , SCheck strwordy = request.QueryString("recherche") MyString = Split(strWordy, " ", -1, 1) Scheck = request.QueryString("Spellcheck") if SCheck = "True" then response.write("Ou essayez cette orthographe : ") if SCheck = "" OR "false" then response.write("Recherchez vous ? ") Dim MyCorrect(20) t = 0 LoadDictArray do while t <= UBound(MyString) If len(MyString(t)) >= 15 then response.write("Pas de suggestion") 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) '-------Word Filter Remove words which gives unnecessery result like to, of, the, etc.------------------------- 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 'You can add more words or remove filter just remove dash line code to add , add else statement with word or you can use OR Statement. '----------------------------END Word filter------------------------------------------------------------------- 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 'Error handler On Error Resume Next 'Set the error object to 0 Err.Number = 0 MyCorrect(t) = mySuggest(0) 'If an error has occured then the server does not support Regular Expresions If Err.Number <> 0 Then Response.Write("Pas de suggestion") 'Reset error object Err.Number = 0 Exit do End If loop Dim MySys MySys = Trim(Join(MyCorrect)) Response.write("" & MySys & "") if len(strFilterWord)>0 then Response.write("" & strFilterWord & "  N'est pas dans votre recherche") end if %>

<% ' Print the Results On Error Resume Next rs.MoveFirst Do While Not rs.eof Vid_indices = rs("id_indices") response.write ""&rs("dictionary_keywords_label_fr")&"
" rs.MoveNext Loop %>
   


 

 

 

 

 

 

 




 
<% rs.close : Set rs=nothing conn.close : Set conn=nothing %>
mercredi 4 janvier 2006 à 16:55:10 | Voici le code HTML de la page

LABAUDE

<% QueryString = Request.QueryString( "recherche" ) QueryWords = Split( QueryString ) strIndent = "               " ' Setup SQL sql = "SELECT dictionary_concepts.id_indices, dictionary_concepts.label_fr AS dictionary_concepts_label_fr, dictionary_keywords.label_fr AS dictionary_keywords_label_fr, dictionary_keywords.definition_fr, dictionary_keywords.id_concepts, dictionary_keywords.id AS dictionary_keywords_id FROM dictionary_concepts INNER JOIN dictionary_keywords ON dictionary_concepts.id = dictionary_keywords.id_concepts WHERE" ' Search Description sql = sql & " ( [dictionary_concepts.label_fr] LIKE '%" & QueryWords( 0 ) & "%'" ' First For i = LBound( QueryWords ) + 1 to UBound( QueryWords ) If QueryWords( i ) <> "" and UCase( QueryWords(i) ) <> "OR" and UCase( QueryWords(i) ) <> "AND" Then If uCase( QueryWords( i-1 ) ) = "OR" Then sql = sql & " OR [dictionary_concepts.label_fr] LIKE '%" & QueryWords( i ) & "%'" Else sql = sql & " AND [dictionary_concepts.label_fr] LIKE '%" & QueryWords( i ) & "%'" End If End If Next ' Search Keywords sql = sql & " ) OR ( [dictionary_keywords.label_fr] LIKE '%" & QueryWords( 0 ) & "%'" For i = LBound( QueryWords ) + 1 to UBound( QueryWords ) If QueryWords( i ) <> "" and UCase( QueryWords(i) ) <> "OR" and UCase( QueryWords(i) ) <> "AND" Then If uCase( QueryWords( i-1 ) ) = "OR" Then sql = sql & " OR [dictionary_keywords.label_fr] LIKE '%" & QueryWords( i ) & "%'" Else sql = sql & " AND [dictionary_keywords.label_fr] LIKE '%" & QueryWords( i ) & "%'" End If End If Next ' Search Title sql = sql & " ) OR ( [dictionary_keywords.definition_fr] LIKE '%" & QueryWords( 0 ) & "%'" For i = LBound( QueryWords ) + 1 to UBound( QueryWords ) If QueryWords( i ) <> "" and UCase( QueryWords(i) ) <> "OR" and UCase( QueryWords(i) ) <> "AND" Then If uCase( QueryWords( i-1 ) ) = "OR" Then sql = sql & " OR [dictionary_keywords.definition_fr] LIKE '%" & QueryWords( i ) & "%'" Else sql = sql & " AND [dictionary_keywords.definition_fr] LIKE '%" & QueryWords( i ) & "%'" End If End If Next sql = sql & " ) ORDER BY dictionary_concepts.id_indices, dictionary_keywords.label_fr" ' Fetch Set rs = Server.CreateObject("ADODB.Recordset") rs.Open sql, conn, 3, 3 %>
 


Votre recherche : <% Response.Write QueryString %>

<% Dim MyString, MyArray, strWordy, t , SCheck strwordy = request.QueryString("recherche") MyString = Split(strWordy, " ", -1, 1) Scheck = request.QueryString("Spellcheck") if SCheck = "True" then response.write("Ou essayez cette orthographe : ") if SCheck = "" OR "false" then response.write("Recherchez vous ? ") Dim MyCorrect(20) t = 0 LoadDictArray do while t <= UBound(MyString) If len(MyString(t)) >= 15 then response.write("Pas de suggestion") 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) '-------Word Filter Remove words which gives unnecessery result like to, of, the, etc.------------------------- 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 'You can add more words or remove filter just remove dash line code to add , add else statement with word or you can use OR Statement. '----------------------------END Word filter------------------------------------------------------------------- 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 'Error handler On Error Resume Next 'Set the error object to 0 Err.Number = 0 MyCorrect(t) = mySuggest(0) 'If an error has occured then the server does not support Regular Expresions If Err.Number <> 0 Then Response.Write("Pas de suggestion") 'Reset error object Err.Number = 0 Exit do End If loop Dim MySys MySys = Trim(Join(MyCorrect)) Response.write("" & MySys & "") if len(strFilterWord)>0 then Response.write("" & strFilterWord & "  N'est pas dans votre recherche") end if %>

<% ' Print the Results On Error Resume Next rs.MoveFirst Do While Not rs.eof Vid_indices = rs("id_indices") response.write ""&rs("dictionary_keywords_label_fr")&"
" rs.MoveNext Loop %>
   


 

 

 

 

 

 

 




 
<% rs.close : Set rs=nothing conn.close : Set conn=nothing %>
mercredi 4 janvier 2006 à 16:55:12 | Voici le code HTML de la page

LABAUDE

<% QueryString = Request.QueryString( "recherche" ) QueryWords = Split( QueryString ) strIndent = "               " ' Setup SQL sql = "SELECT dictionary_concepts.id_indices, dictionary_concepts.label_fr AS dictionary_concepts_label_fr, dictionary_keywords.label_fr AS dictionary_keywords_label_fr, dictionary_keywords.definition_fr, dictionary_keywords.id_concepts, dictionary_keywords.id AS dictionary_keywords_id FROM dictionary_concepts INNER JOIN dictionary_keywords ON dictionary_concepts.id = dictionary_keywords.id_concepts WHERE" ' Search Description sql = sql & " ( [dictionary_concepts.label_fr] LIKE '%" & QueryWords( 0 ) & "%'" ' First For i = LBound( QueryWords ) + 1 to UBound( QueryWords ) If QueryWords( i ) <> "" and UCase( QueryWords(i) ) <> "OR" and UCase( QueryWords(i) ) <> "AND" Then If uCase( QueryWords( i-1 ) ) = "OR" Then sql = sql & " OR [dictionary_concepts.label_fr] LIKE '%" & QueryWords( i ) & "%'" Else sql = sql & " AND [dictionary_concepts.label_fr] LIKE '%" & QueryWords( i ) & "%'" End If End If Next ' Search Keywords sql = sql & " ) OR ( [dictionary_keywords.label_fr] LIKE '%" & QueryWords( 0 ) & "%'" For i = LBound( QueryWords ) + 1 to UBound( QueryWords ) If QueryWords( i ) <> "" and UCase( QueryWords(i) ) <> "OR" and UCase( QueryWords(i) ) <> "AND" Then If uCase( QueryWords( i-1 ) ) = "OR" Then sql = sql & " OR [dictionary_keywords.label_fr] LIKE '%" & QueryWords( i ) & "%'" Else sql = sql & " AND [dictionary_keywords.label_fr] LIKE '%" & QueryWords( i ) & "%'" End If End If Next ' Search Title sql = sql & " ) OR ( [dictionary_keywords.definition_fr] LIKE '%" & QueryWords( 0 ) & "%'" For i = LBound( QueryWords ) + 1 to UBound( QueryWords ) If QueryWords( i ) <> "" and UCase( QueryWords(i) ) <> "OR" and UCase( QueryWords(i) ) <> "AND" Then If uCase( QueryWords( i-1 ) ) = "OR" Then sql = sql & " OR [dictionary_keywords.definition_fr] LIKE '%" & QueryWords( i ) & "%'" Else sql = sql & " AND [dictionary_keywords.definition_fr] LIKE '%" & QueryWords( i ) & "%'" End If End If Next sql = sql & " ) ORDER BY dictionary_concepts.id_indices, dictionary_keywords.label_fr" ' Fetch Set rs = Server.CreateObject("ADODB.Recordset") rs.Open sql, conn, 3, 3 %>
 


Votre recherche : <% Response.Write QueryString %>

<% Dim MyString, MyArray, strWordy, t , SCheck strwordy = request.QueryString("recherche") MyString = Split(strWordy, " ", -1, 1) Scheck = request.QueryString("Spellcheck") if SCheck = "True" then response.write("Ou essayez cette orthographe : ") if SCheck = "" OR "false" then response.write("Recherchez vous ? ") Dim MyCorrect(20) t = 0 LoadDictArray do while t <= UBound(MyString) If len(MyString(t)) >= 15 then response.write("Pas de suggestion") 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) '-------Word Filter Remove words which gives unnecessery result like to, of, the, etc.------------------------- 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 'You can add more words or remove filter just remove dash line code to add , add else statement with word or you can use OR Statement. '----------------------------END Word filter------------------------------------------------------------------- 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 'Error handler On Error Resume Next 'Set the error object to 0 Err.Number = 0 MyCorrect(t) = mySuggest(0) 'If an error has occured then the server does not support Regular Expresions If Err.Number <> 0 Then Response.Write("Pas de suggestion") 'Reset error object Err.Number = 0 Exit do End If loop Dim MySys MySys = Trim(Join(MyCorrect)) Response.write("" & MySys & "") if len(strFilterWord)>0 then Response.write("" & strFilterWord & "  N'est pas dans votre recherche") end if %>

<% ' Print the Results On Error Resume Next rs.MoveFirst Do While Not rs.eof Vid_indices = rs("id_indices") response.write ""&rs("dictionary_keywords_label_fr")&"
" rs.MoveNext Loop %>
   


 

 

 

 

 

 

 




 
<% rs.close : Set rs=nothing conn.close : Set conn=nothing %>
mercredi 4 janvier 2006 à 21:25:20 | Re : Moteur de recherche interne

azra

Membre Club Administrateur CodeS-SourceS
Je ne sais pas si c'est exactement la, la flemme de tout lire mais:

"If QueryWords( i ) <> "" and UCase( QueryWords(i) ) <> "OR" and UCase( QueryWords(i) ) <> "AND" Then
If uCase( QueryWords( i-1 ) ) = "OR" Then
sql = sql & " OR [dictionary_concepts.label_fr] LIKE '%" & QueryWords( i ) & "%'"
Else
sql = sql & " AND [dictionary_concepts.label_fr] LIKE '%" & QueryWords( i ) & "%'"
End If
"
Enleve les '%' au début et a la fin de tes LIKE, car ils signifient que tu veux quelque chose qui contient LIKE et qui peut contenir autre chose avant et apres.


Azra (Florent) - MVS - MCAD.NET


Cette discussion est classée dans : recherche, test, interne, moteur


Répondre à ce message

Sujets en rapport avec ce message

Moteur de recherche interne au site [ par Nightwolf774 ] Bonjour,Je cherche un code sources pour faire une recherche automatique dasn mes bases de donnée par rapport à un mot ou une référence.Je suis débutan moteur de recherche interne d'un site [ par wally88 ] Bonjour, J'aimerais faire un moteur de recherche sur mot clé.Par exemple dans les site de petites annonces on saisie "je veux une voiture rouge" , il PB de moteur de recherche [ par hichamdeb ] Bonjour,Voila un moteur de recherche que j'ai trouver sur ce forum et qui fonctionne parfaitement, vous le mettez dans n'importe quel projet et il fai un moteur de recherche en asp.net [ par nassirsource ] salut, vous pouvez m'aider, je suis en train de réaliser une application web avec asp.net et je ne sais pas comment faire un moteur de recherche pour moteur de recherche aspx sur une base access [ par lotfi_dgi ] slt a tous je suis sur un PFE je suis entrain d'pprendre ASP.net sur le tas, donc je suis arrivé au point ou g une table affiché sur 70 pages et c pas Moteur de recherche [ par abdoulayediouf ] Bonjour, J'aimerai savoir s'il est possible de créer un moteur de recherche sans que vous ayez la connexion internet. Merci moteur de recherche [ par lhoazour ] Salut tout le monde,Je développe un site avec ASP et Access que je teste sur un serveur IIS local.Je veux faire la recherche en plein texte dans un ré ameliorer un moteur de recherche [ par berserk ] Bonjour à tous!!!Rentrons de suite dans le vif du sujet.J'ai un moteur de recherche asp avec une base acces, jusque la tout tourne bien.Mais je voudra moteur de recherche avec lien intranet [ par benares8 ] Re bonjourJ'aimerais connaitre le moyen de faire des lien intranet avec un moteur de recherche.Je vais essayer de m'expliquer:J'ai un nombre n de page


Nos sponsors


Appels d'offres

Sondage...

Comparez les prix

CalendriCode

Février 2010
LMMJVSD
1234567
891011121314
15161718192021
22232425262728

Consulter la suite du CalendriCode

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 2,402 sec (3)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales