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
| function SearchInLine(tab2, sLine)
'retourne le nombre de mots trouvés
dim iNbWord, i
dim oRegExpr
dim iFound 'nb de mots trouvés
set oRegExpr = new RegExp 'en plus
iNbWord = ubound(tab2, 1)
iFound = 0
for i = 0 to iNbWord
oRegExpr.Pattern = tab2(0,i)
oRegExpr.IgnoreCase = true
oRegExpr.Global = false
if oRegExpr.test(sLine) then
iFound = iFound + 1
tab2(1,i) = true
end if
next
SearchInLine = iFound
end function
function SearchInFile(byref sSummary, tab2, sFile)
dim bFound
dim iCom, oF1, sLine
bFound = false
iCom = 0
sSummary = ""
if oWkFso.FileExists(sFile) then
' Numéro de l'étape
' 0 : Pas encore trouvé de commentaires
' 1 : Dans le premier bloc de commentaires
' 2 : Sorti du premier bloc de commentaires
set oF1 = oWkFSO.OpenTextFile(sFile, 1)
do while not oF1.atEndOfStream and iCom < 2
sLine = oF1.Readline
if left(sLine, 2) = "''" then
iCom = 1
if left(sLine, 5) <> "''KEY" then
sSummary = sSummary & right(sLine, len(sLine) - 2) & "<br />" & vbNewline
end if
if SearchInLine(tab2, sLine) > 0 then
bFound = true
end if
else
if iCom = 1 then
iCom = 2
end if
end if
loop
end if
SearchInFile = bFound
end function
'Déclaration des variables
Dim oWkFso, oD, oDir
Dim iCptResult 'Nombre résultat(s)
Dim sSummary ' Résumé de la page
Dim sPat 'Mot(s) recherché(s)
Dim affichage 'Pour afficher les mots recherchés non-tronqués
Dim tab 'Tableau contenant le sPat découpé + pour calculer nbEl
Dim tab2() 'Tableau contenant les critéres de recherche (sPat)
Dim tabPages(4, 4) 'Liste des pages 5 colonnes, 5 lignes
Dim nbEl 'Nombre Eléments dans la liste des pages
Dim iAllWords 'Pour vérifier si la totalité des mots sont trouvés en cas de recherche "Tous les mots"
Dim h 'Pour boucler pour remplir tab2
Dim i 'Pour boucler sur le nombre d'éléments dans tab2
Dim j 'Pour boucler sur le nombre d'appli à fouiller
Dim k 'Pour boucler dans la deuxiemme colonne de tab2
Const NB_APPLICATIONS_A_FOUILLER = 5 'PENSER A INCREMENTER SI UNE APPLICATION DOIT ÊTRE AJOUTEE
set oWkFso = server.createObject("Scripting.FileSystemObject")
%>
<%
'tabPages(0, 0) = chemin physique vers le répertoire (sans le \ de fin)
'tabPages(1, 0) = parcourir les sous répertoires ? (false / true)
'tabPages(2, 0) = fichier à analyser
'tabPages(3, 0) = chemin web à retourner (qui pointe vers l’application). Dans le cas d’un parcours des sous répertoires, $1 sera remplacé par le nom du sous répertoire courant.
'tabPages(4, 0) = Accès intranet devant posséder l’utilisateur pour qu’il puisse accéder à cette application. Pour un groupe AD, mettre AD.Nom du groupe ad.
tabPages(0, 0) = Request.ServerVariables("APPL_PHYSICAL_PATH") & "Stats.V2"
tabPages(1, 0) = true
tabPages(2, 0) = "functions.asp"
tabPages(3, 0) = "/Stats.V2/$1/"
tabPages(4, 0) = ""
tabPages(0, 1) = Request.ServerVariables("APPL_PHYSICAL_PATH") & "Essais"
tabPages(1, 1) = false
tabPages(2, 1) = "cad_menustt.asp"
tabPages(3, 1) = "/ESSAIS/cad_menustt.asp"
tabPages(4, 1) = "ESSAIS.STT"
tabPages(0, 2) = Request.ServerVariables("APPL_PHYSICAL_PATH") & "Essais\BOURGES\MAGASIN"
tabPages(1, 2) = false
tabPages(2, 2) = "cad_magasin.asp"
tabPages(3, 2) = "/ESSAIS/BOURGES/MAGASIN/cad_magasin.asp"
tabPages(4, 2) = "ESSAIS.MAG"
tabPages(0, 3) = Request.ServerVariables("APPL_PHYSICAL_PATH") & "SuiviOffre"
tabPages(1, 3) = false
tabPages(2, 3) = "Index.txt"
tabPages(3, 3) = "/SuiviOffre/"
tabPages(4, 3) = "AD.FR Bou UAp SuiviOffres"
tabPages(0, 4) = Request.ServerVariables("APPL_PHYSICAL_PATH") & "Adeqstock"
tabPages(1, 4) = false
tabPages(2, 4) = "main.asp"
tabPages(3, 4) = "/Adeqstock"
tabPages(4, 4) = "ADEQSTOCK"
sPat = trim(request("search"))
if sPat <> "" then
iCptResult = 0
iAllWords = 0
h = 0
i = 0
j = 0
k = 0
'Séparation si besoins puis insertion des critéres de recherche dans tab
tab = Split(sPat," ")
nbEl = ubound(tab)
redim tab2(1, nbEl)
for h = 0 to nbEl 'remplissage de tab2
tab = tab2(0, h)
h = h + 1
next
if nbEl >= 1 then
response.write "<br> Vous avez lancé une recherche sur "& nbEl + 1 &" mots : <b>" & affichage & "</b> <br /><br />"
else
response.write "<br> Vous avez lancé une recherche sur "& nbEl + 1 &" mot : <b>" & affichage & "</b> <br /><br />"
end if
for j = 0 to NB_APPLICATIONS_A_FOUILLER - 1 'Début boucle selon tabPages
if tabPages(1, j) = true then 'Parcourir les sous-repertoires ou non
' Recherche récursive
set oDir = oWkFso.GetFolder(tabPages(0, j))
if tabPages(4, j) = "" or access(tabPages(4, j)) then 'Restriction d'accés : autorisé si vide ou possède l'accès
for each oD in oDir.SubFolders
sSummary = ""
if SearchInFile(sSummary, tab2, oD.Path & "\" & tabPages(2, j)) then
if request("allwords") = "checked" then 'Checkbox "Tous les mots"
for k = 0 to nbEl
if tab2(1, k) = true then
iAllWords = iAllWords + 1
k = k + 1
end if
next
if iAllWords = nbEl then
response.write "<b><A href=""" & replace(tabPages(3, j), "$1", oD.Name) & """>" & replace(tabPages(3, j), "$1", oD.Name) & "</A></b><br />" & vbnewline
response.write "<i>" & sSummary & "</i><br /><br />" & vbnewline
iCptResult = iCptResult + 1
end if
else
response.write "<b><A href=""" & replace(tabPages(3, j), "$1", oD.Name) & """>" & replace(tabPages(3, j), "$1", oD.Name) & "</A></b><br />" & vbnewline
response.write "<i>" & sSummary & "</i><br /><br />" & vbnewline
iCptResult = iCptResult + 1
end if
end if
next
end if
else 'On ne recherche pas dans les sous-fichiers
if tabPages(4, j) = "" or access(tabPages(4, j)) then 'Restriction d'accés : autorisé si vide ou possède l'accès
sSummary = ""
if SearchInFile(sSummary, tab2, tabPages(0, j) & "\" & tabPages(2, j)) then
if request("allwords") = "checked" then 'Checkbox "Tous les mots"
for k = 0 to nbEl
if tab2(1, k) = true then
iAllWords = iAllWords + 1
k = k + 1
end if
next
if iAllWords = nbEl then
response.write "<b><A href=""" & replace(tabPages(3, j), "$1", oD.Name) & """>" & replace(tabPages(3, j), "$1", oD.Name) & "</A></b><br />" & vbnewline
response.write "<i>" & sSummary & "</i><br /><br />" & vbnewline
iCptResult = iCptResult + 1
end if
else
response.write "<b><A href=""" & replace(tabPages(3, j), "$1", oD.Name) & """>" & replace(tabPages(3, j), "$1", oD.Name) & "</A></b><br />" & vbnewline
response.write "<i>" & sSummary & "</i><br /><br />" & vbnewline
iCptResult = iCptResult + 1
end if
end if
end if
end if
next ' Boucle tabPages
if iCptResult = 0 then 'Affiche le nombre de résultat(s) trouvé(s)
response.write "Désolé, aucune page trouvée pour votre recherche. <br />" & vbnewline
response.write " Veillez à l'<u>orthographe</u> des mots recherchés."
else if iCptResult > 1 then
response.write "<b>" & iCptResult & "</b>" & " résultats trouvés pour votre recherche <br />" & vbnewline
else response.write "<b>" & iCptResult & "</b>" & " résultat trouvé pour votre recherche <br />" & vbnewline
end if
end if
else
response.write "<b>Entrez un critère de recherche</b>" & vbnewline
end if |
runtime error '800a0009' : Subscript out of range: 'i'
Répondre avec citation
Partager