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
%> |
29/12/2007, 14h20
je voudrai crée moteur de recherche
00
mais j'ai installé iis sur mon ordi et j'ai cherché sur google des moteur mais j'ai pas trouver et c'est pour sa que j'ai deposé ce sujet ici .
,
c'est :
