1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656
|
<% @LANGUAGE=VBScript %>
<% Option Explicit %>
<%
' ---------------------------------------------------------------------------------------------
' recherche.asp
' Ce script effectue une recherche sur l'ensemble des pages d'un site Web (avec ET implicite
' entre les termes). Il permet d'exclure des dossiers, des fichiers ou des extensions.
' L'affichage des résultats se fait sur plusieurs pages si nécéssaire.
' Réalisation Jacques gariépy (jackboy)
'
' ---------------------------------------------------------------------------------------------
'Définition des variables globales
Dim fsoObject 'Objet "système de fichier"
Dim fldObject 'Objet "dossier"
Dim sarySearchWord 'Array qui contient les mots de la recherche séparés
Dim strSearchWords 'String qui contient les mots de la recherche
Dim blnIsRoot 'Vrai si la recherche se fait dans le dossier racine
Dim strFileURL 'Contient le "path" vers le fichier actuel
Dim strServerPath 'Contient le "path" du serveur vers ce script
Dim intNumFilesShown 'Contient le nombre de fichier trouvés jusqu'à présent
Dim intTotalFilesSearched 'Contient le nombre de fichier recherchés
Dim intTotalFilesFound 'Contient le nombre de fichier trouvés
Dim intFileNum 'Contient le numéro du fichier
Dim intPageLinkLoopCounter 'Compteur qui affiche les liens vers les autres pages de résultats
Dim sarySearchResults(1000,2) 'Array 2 dimensions qui contient les résultats de recherche
Dim intDisplayResultsLoopCounter 'Compteur pour afficher les résultats de recherche
Dim intResultsArrayPosition 'Positions dans le array contenant les résultats de recherche
Dim blnSearchResultsFound 'Vrai si des résultats ont été trouvés
Dim strFilesTypesToSearch 'Contient les types de fichiers à chercher
Dim strBarredFolders 'Contient les dossiers à ne pas accéder
Dim strBarredFiles 'Contient les fichiers à ne pas accéder
Dim blnEnglishLanguage 'Vrai si la recherche se fait en anglais
'---Définition des variables contenant le texte de la page ------------------------------------
Dim msgTitre, msgMetaDescription, msgMetaKeywords
Dim msgSearchedFor, msgErrNoResults, msgDisplayResults, msgBouton
Dim msgTo, msgOf, msgNoResults, msgResultPage, msgPrev
Dim msgNext, msgSearched, msgTotal
Dim msgNoTitle, msgNoDescription, msgMatches
Dim msgLastUpdate, msgSize, msgKb
'Messages d'erreur
Dim msgErrNoKeywords, msgErrRegExp
If Request.Querystring("typerecherche") = "faq" Then
Dim strURL
strURL = "faq/faq_search.asp?search=" & Request.Querystring("search") & "&language=" & request.querystring("language")
Response.Redirect(strURL)
End If
' --- Messages affichés par le programme --------------------------------------------
msgTitre = "Recherche sur le site"
msgMetaDescription ="Recherche sur le site Web pour l'information voulue"
msgMetaKeywords = "recherche site"
msgBouton = "Recherche"
msgSearchedFor = "Vous avez recherché le(s) mot(s) "
msgErrNoResults = "Désolé, aucun résultat n'a été trouvé."
msgDisplayResults = "Résultats de"
msgTo = " à "
msgOf = "sur un total de"
msgNoResults = "Votre recherche n'a donné aucun résultat.<br><br>Suggestions:<br><ul><li>Assurez-vous que les mots-clés ont été écrit correctement.<li>Essayez des mots-clés différents.<li>Utilisez des mots-clés plus généraux.<li>Utilisez moins de mots-clés.</ul>"
msgResultPage = "Pages de résultats :"
msgPrev = "Page précédente"
msgNext = "Page suivante"
msgSearched = "Recherche effectuée sur"
msgTotal = "documents au total."
msgNoTitle = "Pas de titre"
msgNoDescription = "Aucune description n'est disponible pour cette page."
msgMatches = "Mots trouvés :"
msgLastUpdate = "Dernière mise-à-jour :"
msgSize = "Poids : "
msgKb = "Ko"
msgErrNoKeywords = "Veuillez entrer au moins un mot à rechercher, merci !" 's'affiche quand aucun mot-clé n'est entré
msgErrRegExp = "Error, the Server does not support the Regular Expessions Object !"
'----------------------------------------------------------------------------------------------
' --- Nombre de résultats maximum par page ----------------------------------------------------
Const intRecordsPerPage = 7
' --- Écrire les noms des types de fichiers à recherche, séparés par des virgules -------------
strFilesTypesToSearch = "htm,html,dhtml,asp,php"
' --- Écrire les noms des dossiers à ignorer, séparés par des virgules ------------------------
strBarredFolders = "_vti_cnf, inc, cgi"
' --- Écrire les noms des fichiers à ignorer, séparés par des virgules. Inclure l'extention ---
strBarredFiles = "recherche.asp, config.asp, inc.asp"
' --- Valeur à false si le site Web n'est pas en anglais --------------------------------------
blnEnglishLanguage = True 'True = "HTML Encode" \ False = no Encoding
' ---------------------------------------------------------------------------------------------
'Initalise la variable
intTotalFilesSearched = 0
%>
<html>
<head>
<title><%= msgTitre %></title>
<meta name="Description" content="<%= msgMetaDescription %>">
<meta name="KeyWords" content="<%= msgMetaKeywords %>">
<link REL="stylesheet" HREF="stylesheet.css" TYPE="text/css">
<script language="JavaScript" src="script1.js" type="text/javascript"></script>
</head>
<body link="#000080" vlink="#800080" alink="#FF0000" bgcolor="#FFFFFF" marginwidth="0" marginheight="0" leftmargin="0" topmargin="0" onLoad="MM_preloadImages('../images/en/menuTopHome_on.gif','../images/en/menuTopSiteMap_on.gif','../images/en/menuTopContact_on.gif','../images/en/menuServices_on.gif','../images/en/menuOurCompany_on.gif')">
<table border="0" cellpadding="0" cellspacing="0" width="100%">
<tr>
<td width="100%">
</td>
</tr>
<tr>
<td width="100%">
<table border="0" cellpadding="0" cellspacing="0" width="650">
<tr>
<td valign="top" width="150" align="center" rowspan="2">
<form method="get" name="frmSiteSearch" action="recherche.asp" onSubmit="return CheckForm();">
<table border="0" cellpadding="0" cellspacing="0" align="center">
<tr>
<td align="right"> <img border="0" src="menuSearch.gif" width="135" height="14">
<table border="0" cellpadding="0" cellspacing="0" width="100%">
<tr>
<td><input type="text" name="search" size="10" value="<% =Request.QueryString("search") %>" style="width:115px"></td>
<td>
<input type="image" value="Search" border="0" src="btnGo.gif" width="19" height="19"></td>
<input type="hidden" name="language" value="fr">
</tr>
</table>
</td>
</tr>
</table>
</form>
<p>
</p>
</td>
<td valign="top" style="border-left-style: solid; border-left-width: 1; border-right-style: solid; border-right-width: 1; border-top-style: solid; border-top-width: 1">
</td>
</tr>
<tr>
<td valign="top" style="border-left-style: solid; border-left-width: 1; border-right-style: solid; border-right-width: 1; border-bottom-style: solid; border-bottom-width: 1">
<table border="0" cellpadding="13" cellspacing="0" width="95%">
<tr>
<td>
<%
'Copie de tous les mots à chercher dans une variable
strSearchWords = Trim(Request.QueryString("search"))
'Si le site est en anglais, utiliser la méthode d'encodage HTML
If blnEnglishLanguage = True Then
'Remplace tous les tags HTML par le code HTML équivalent (empèche les gens d'entrer du HTML comme recherche)
strSearchWords = Server.HTMLEncode(strSearchWords)
'Si le site n'est pas en anglais, changer seulement les tags (pour conserver les accents)
Else
'Remplace les tags <> avec la version HTML < et >
strSearchWords = Replace(strSearchWords, "<", "<", 1, -1, 1)
strSearchWords = Replace(strSearchWords, ">", ">", 1, -1, 1)
End If
'Sépare chacun des mots à chercher et les places dans un array
sarySearchWord = Split(Trim(strSearchWords), " ")
'Lecture du numéro de fichier à montrer
intFileNum = CInt(Request.QueryString("FileNumPosition"))
'Initialise le nombre de fichiers lu jusqu'à maintenant au numéro de fichier ci-haut
intNumFilesShown = intFileNum
'Création de l'objet FileSystemObject
Set fsoObject = Server.CreateObject("Scripting.FileSystemObject")
'S'il n'y a rien d'entré par l'utilisateur, ne pas démarrer la routine de recherche
If NOT strSearchWords = "" Then
'Lire le path et le dossier racine à chercher
Set fldObject = fsoObject.GetFolder(Server.MapPath("./"))
'Lire le path de ce script ASP sur le serveur
strServerPath = fldObject.Path & "\"
'Vrai parce que la recherche s'effectue dans le dossier racine
blnIsRoot = True
'Appeler la procédure de recherche
Call SearchFile(fldObject)
'Réinitialise les variables serveur
Set fsoObject = Nothing
Set fldObject = Nothing
'Appelle le tri à bulle pour placer les résultats les plus forts en premier
Call SortResultsByNumMatches(sarySearchResults, intTotalFilesFound)
'Affiche l'en-tête HTML
%>
<p class="title">Résultat de la recherche</p>
<table width="100%" border="0" cellspacing="0" cellpadding="2" bgcolor="#009F67">
<tr>
<%
'Affiche qu'aucun résultat n'a été trouvé
If blnSearchResultsFound = False Then
%>
<td><font color="#FFFFFF"> <%=msgSearchedFor %><b><%=strSearchWords %></b>. <%= msgErrNoResults %></font></td>
<%
'Sinon, affiche combien de résultats ont été trouvés
Else
%>
<td><font color="#FFFFFF"> <%=msgSearchedFor %><b><%=strSearchWords %></b>. <%= msgDisplayResults & " " & (intFileNum + 1) & msgTo & intNumFilesShown & " " & msgOf & " " & intTotalFilesFound %>.</font></td>
<%
End If
'Fermeture de l'en-tête HTML
%>
</tr>
</table>
<%
'Table HTML qui affiche les résultats ou un message d'erreur s'il n'y a pas de résultats
%>
<table width="95%" border="0" cellspacing="0" cellpadding="0">
<tr>
<td>
<%
'Message d'erreur si aucun résultat n'a été trouvé
If blnSearchResultsFound = False Then
'HTML affichant l'erreur
%>
<br>
<%=msgNoResults %>
<%
'Sinon, afficher les résultats de recherche
Else
'Boucle qui affiche chacun de résultats de l'array des résultats de recherche
For intDisplayResultsLoopCounter = (intFileNum + 1) to intNumFilesShown
%>
<br>
<%=sarySearchResults(intDisplayResultsLoopCounter,1) %>
<br>
<%
Next
End If
'Fermeture de la table HTML qui affiche les résultats
%>
</td>
</tr>
</table>
<%
End If
'Affiche une table HTML avec un lien vers les autres pages de résultats de recherche
If intTotalFilesFound > intRecordsPerPage then
'Lien vers les autres pages
%>
<br>
<table width="100%" border="0" cellspacing="0" cellpadding="0">
<tr>
<td>
<table width="100%" border="0" cellpadding="0" cellspacing="0">
<tr>
<td width="50%" align="center">
<%=msgResultPage %>
<%
'Si le # de page est plus élevé que 1, alors afficher un lien de retour à la page précédente
If intNumFilesShown > intRecordsPerPage Then
%>
<a href="recherche.asp?FileNumPosition=<%=intFileNum - intRecordsPerPage %>&search=<%=Replace(strSearchWords, " ", "+") %>&language=<%=Request.QueryString("Language")%>" target="_self"><< <%=msgPrev %></a>
<%
End If
'S'il y a plus de pages à afficher, créer un lien vers chacune des pages
If intTotalFilesFound > intRecordsPerPage Then
'Boucle pour afficher un hyperlien vers chacune des pages de résultats de recherche
For intPageLinkLoopCounter = 1 to CInt((intTotalFilesFound / intRecordsPerPage) + 0.5)
'Si le numéro de page à afficher est celui de la page actuelle, ne pas créer d'hyperlien
If intFileNum = (intPageLinkLoopCounter * intRecordsPerPage) - intRecordsPerPage Then
Response.Write vbCrLf & " " & intPageLinkLoopCounter & " "
Else
%>
<a href="recherche.asp?FileNumPosition=<%=(intPageLinkLoopCounter * intRecordsPerPage) - intRecordsPerPage %>&search=<%=Replace(strSearchWords, " ", "+") %>&language=<%=Request.QueryString("Language")%>" target="_self"> <%=intPageLinkLoopCounter %> </a>
<%
End If
Next
End If
'Si ce n'est pas la dernière page, afficher un lien vers la prochaine page
If intTotalFilesFound > intNumFilesShown then
%>
<a href="recherche.asp?FileNumPosition=<%=intNumFilesShown %>&search=<%=Replace(strSearchWords, " ", "+") %>&language=<%=Request.QueryString("Language")%>" target="_self"><%= msgNext %> >></a>
<%
End If
'Fin de la table HTML
%>
</td>
</tr>
</table>
</td>
</tr>
</table>
<%
End If
%>
<br>
<table width="98%" border="0" cellspacing="0" cellpadding="2" bgcolor="#009F67">
<tr>
<td height="18"><font color="#FFFFFF"> <%= msgSearched & " " & intTotalFilesSearched & " " & msgTotal %>
</font> </td>
</tr>
</table>
</td>
</tr>
</table> <br>
</td>
</tr>
</table>
</td>
</tr>
</table>
</body>
</html>
<%
' --- Procédure sub de recherche SearchFile ---------------------------------------------------
Public Sub SearchFile(fldObject)
'Variables locales
Dim objRegExp 'Objet "Regular Expression"
Dim objMatches 'Contient la collection des correspondances de l'objet "Regular Expression"
Dim filObject 'Objet fichier
Dim tsObject 'Objet "Text stream"
Dim subFldObject 'Objet dossier
Dim strFileContents 'Contenu du fichier cherché
Dim strPageTitle 'Contenu du titre du fichier cherché
Dim strPageDescription 'Contenu du meta-description de la page cherchée
Dim strPageKeywords 'Contenu du meta-keywords de la page cherchée
Dim intSearchLoopCounter 'Compteur de boucle pour chercher tous les mots dans le array
Dim intNumMatches 'Contient le nombre de mots correspondant pour la page
Dim blnSearchFound 'Vrai si au moins un mot est trouvé
'Prise en charge d'erreurs
On Error Resume Next
'Initialise l'objet d'erreur à 0
Err.Number = 0
'Crée l'objet "Regular Expression"
Set objRegExp = New RegExp
'Si une erreur survient, le serveur ne supporte pas l'objet "Regular Expression"
If Err.Number <> 0 Then
Response.Write(msgErrRegExp)
'Réinitialise l'objet erreur
Err.Number = 0
End If
'Boucle pour lire chacun des fichiers dans le dossier
For Each filObject in fldObject.Files
'Vérification de l'extention du fichier pour s'assurer qu'il doit être cherché
If InStr(1, strFilesTypesToSearch, fsoObject.GetExtensionName(filObject.Name), vbTextCompare) > 0 Then
'Vérifier si le fichier fait parti des fichiers à ne pas chercher
If NOT InStr(1, strBarredFiles, filObject.Name, vbTextCompare) > 0 Then
'Initialise la variable SearchFound (logique inverse, si rien n'est trouvé, il sera remis à false)
blnSearchFound = True
'Initialise le nombre d'occurences trouvées
intNumMatches = 0
'Initialise l'objet "Regular Expression" pour qu'il trouve toutes les occurences d'un mot, pas juste la première
objRegExp.Global = True
'Initialise l'objet "Regular Expression" pour qu'il ignore la case
objRegExp.IgnoreCase = True
'Ouverture du fichier à chercher
Set tsObject = filObject.OpenAsTextStream
'Lecture du contenu du fichier
strFileContents = tsObject.ReadAll
'Lecture du titre du fichier
strPageTitle = GetFileMetaTag("<title>", "</title>", strFileContents)
'Lecture du meta-tag Description
strPageDescription = GetFileMetaTag("<meta name=""description"" content=""", """>", strFileContents)
'Lecture du meta-tag Keywords
strPageKeywords = GetFileMetaTag("<meta name=""keywords"" content=""", """>", strFileContents)
'Initialise le "pattern" des caractères à ignorer
objRegExp.Pattern = "<[^>]*>"
'Enleve les tags HTML du fichier à chercher
strFileContents = objRegExp.Replace(strFileContents,"")
'Remets le titre, la description et les mots-clés dans le fichier à rechercher
strFileContents = strFileContents & " " & strPageTitle & " " & strPageDescription & " " & strPageKeywords
'Boucle pour chercher chacun des mots
For intSearchLoopCounter = 0 to UBound(sarySearchWord)
'Set the pattern to search for
objRegExp.Pattern = "\b" & sarySearchWord(intSearchLoopCounter) & "\b"
'Recherche dans le fichier
Set objMatches = objRegExp.Execute(strFileContents)
'Vérifie si des mots ont été trouvés
If objMatches.Count > 0 Then
'Compte le nombre de fois qu'un mot est trouvé
intNumMatches = intNumMatches + objMatches.Count
Else
'Sinon, le mot n'a pas été trouvé
blnSearchFound = false
End if
Next
'Calcule le nombre total de fichiers cherchés
intTotalFilesSearched = intTotalFilesSearched + 1
'Si la page ne contient pas de titre, un titre par défaut est entré
If strPageTitle = "" Then strPageTitle = msgNoTitle
'Si la page ne contient pas de description, une description par défaut est entrée
If strPageDescription = "" Then strPageDescription = msgNoDescription
'Si des pages ont été trouvés, afficher les résultats
If blnSearchFound = True Then
'Calcule le nombre total de fichiers trouvés
intTotalFilesFound = intTotalFilesFound + 1
's'assurer que le nombre de pages affichés est entre le nombre maximum de pages à afficher et le nombre de page affichés jusqu'à présent
If intNumFilesShown < (intRecordsPerPage + intFileNum) and intTotalFilesFound > intNumFilesShown Then
'Calcule le nombre de pages affichées
intNumFilesShown = intNumFilesShown + 1
End If
'Place les résultats de recherche dans l'array de résultats
'Calcule la position de l'array de résultats
intResultsArrayPosition = intResultsArrayPosition + 1
'Indique que des pages ont été trouvées.
blnSearchResultsFound = True
'Si le fichier est dans le dossier racine
If blnIsRoot = True Then
'Place le titre du résultat de recherche dans l'array de résultat
sarySearchResults(intResultsArrayPosition,1) = "<b><a href=""./" & filObject.Name & """ target=""_self"">" & strPageTitle & "</a></b>"
Else
sarySearchResults(intResultsArrayPosition,1) = "<b><a href=""./" & strFileURL & fldObject.Name & "/" & filObject.Name & """ target=""_self"">" & strPageTitle & "</a></b>"
End If
'Place le reste du résultat de recherche dans l'array de résultat
sarySearchResults(intResultsArrayPosition,1) = sarySearchResults(intResultsArrayPosition,1) & vbCrLf & " <br>" & strPageDescription
sarySearchResults(intResultsArrayPosition,1) = sarySearchResults(intResultsArrayPosition,1) & vbCrLf & " <font size=""1"" color=""#000000""><br><i>" & msgMatches & " " & intNumMatches & " - " & msgLastUpdate & " " & FormatDateTime(filObject.DateLastModified, VbShortDate) & " - " & msgSize & " " & CInt(filObject.Size / 1024) & " " & msgKb & "</i></font>"
'Place le nombre d'occurences dans la 2ième cellule de l'array
sarySearchResults(intResultsArrayPosition,2) = intNumMatches
End If
'Ferme l'objet "Text stream"
tsObject.Close
End If
End If
Next
'Réinitialise l'objet "Regular Expression"
Set objRegExp = Nothing
'Boucle qui cherche dans les dossiers contenus dans le site
For Each subFldObject In FldObject.SubFolders
'S'assurer que le dossier n'est pas exclu
If NOT InStr(1, strBarredFolders, subFldObject.Name, vbTextCompare) > 0 Then
'Faux parce que la recherche s'effectue dans un dossier
blnIsRoot = False
'Trouve le "path" du serveur vers le fichier
strFileURL = fldObject.Path & "\"
'Change le path server en un path URL
strFileURL = Replace(strFileURL, strServerPath, "")
'Remplace les backslash NT en slash URL
strFileURL = Replace(strFileURL, "\", "/")
'Encode le nom du fichier et le path en URL
strFileURL = Server.URLEncode(strFileURL)
'Au cas où des backslashs auraient été encodés
strFileURL = Replace(strFileURL, "%2F", "/")
'Appel récurente de la recherche
Call SearchFile(subFldObject)
End If
Next
'Réinitialisation des objets
Set filObject = Nothing
Set tsObject = Nothing
Set subFldObject = Nothing
End Sub 'de SearchFile
' --- Procédure pour trier un array par tri à bulle -------------------------------------------
Private Sub SortResultsByNumMatches(ByRef sarySearchResults, ByRef intTotalFilesFound)
'Variables locales
Dim intArrayGap 'Contient la partie du Array à trier
Dim intIndexPosition 'Contient l'index de la position dans le Array
Dim intTempResultsHold 'Variable temporaire pour l'échange de données
Dim intTempNumMatchesHold 'Variable temporaire pour l'échange de données
Dim intPassNumber 'Contient le nombre de passe du tri
'Boucle pour trier tous les résultats trouvés
For intPassNumber = 1 To intTotalFilesFound
'Raccourcis le nombre de passes
For intIndexPosition = 1 To (intTotalFilesFound - intPassNumber)
'Si le résultat à trier a moins de mots trouvés que le résultat suivant, les inverser
If sarySearchResults(intIndexPosition,2) < sarySearchResults((intIndexPosition+1),2) Then
'Inverser les nombres du array
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 'de SortResultsByNumMatches
' --- Fonction qui lit dans les meta-tags du fichier ------------------------------------------
Private Function GetFileMetaTag(ByRef strStartValue, ByRef strEndValue, ByVal strFileContents)
'Dimension Variables
Dim intStartPositionInFile 'Contient la position de début dans le fichier
Dim intEndPositionInFile 'Contient la position de fin dans le fichier
'Trouve la position de début du meta-tag dans le fichier
intStartPositionInFile = InStr(1, LCase(strFileContents), strStartValue, 1)
'Si aucune description au mots clés sont trouvés, vérifier avec http-equiv= au lieu de name=
If intStartPositionInFile = 0 And InStr(strStartValue, "name=") Then
strStartValue = Replace(strStartValue, "name=", "http-equiv=")
intStartPositionInFile = InStr(1, LCase(strFileContents), strStartValue, 1)
End If
'S'il y a une description dans le fichier, la position va être au dessus de 0
If NOT intStartPositionInFile = 0 Then
'Trouver la position de fin du meta-tag
intStartPositionInFile = intStartPositionInFile + Len(strStartValue)
'Trouve la position dans le fichier du tag de fin du meta-tag
intEndPositionInFile = InStr(intStartPositionInFile, LCase(strFileContents), strEndValue, 1)
'Lecture du meta-tag pour que la fonction la retourne
GetFileMetaTag = Trim(Mid(strFileContents, intStartPositionInFile, (intEndPositionInFile - intStartPositionInFile)))
'S'il n'y a pas de meta-tag, renvoyer une valeur nulle
Else
GetFileMetaTag = ""
End If
End Function 'de GetFileMetaTag
%> |
Partager