Amelioration du temps de traitement d'un split

Version imprimable

Bonjour,

J'ai une procédure qui fonctionne très bien quand je n'ai pas exemple que 200 lignes, mais lorsque je passe à 2000 lignes les temps de traitement sont beaucoup trop longs.

J'ai identifié la cause, c'est mon split qui pose pb, si j’affiche mes données brutes pas de pb, mais si je fait mon traitement en ajoutant un split, c'est très long,(je passe de 35 secondes d'affichage à 150 secondes :( ) savez vous comment optimiser cela ???

Ci dessous mon code, bien commenté :

Code:

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
 
'################################################################################
' GET SCOPE DETAILS
'################################################################################
Sub Scope_Infos(xScope,xMask,xName,xDesc,xStatus,xLease,xCIDR,xBROADCAST,xTOTAL_HOST,xIP_RANGE,xUsed,xFree,xSumTotal,xPercentFree,xPercentUsed,xExclusions)
 
	StartTime = Timer()
	Set objShell = CreateObject("WScript.Shell")
 
	strDHCPServer = FilterSelection.ServerName.Value
	strFilter = FilterSelection.Filter.Value
	Actions.InnerHTML = "Retryving " & xScope & " scope configuration, please wait ..."
 
	'Creation de mon dico pour stocker le résulat de ma commande
	Set DicoAddClients = CreateObject("Scripting.Dictionary")
	DicoAddClients.CompareMode = vbTextCompare
 
	'J'execute ma commande qui va lister les membres des scopes dhcp Pas de PB
	Dim objConsole
	set objConsole = new CliWrapper
	strConsoleOut = objConsole.exec("netsh dhcp server \\" & strDHCPServer & " scope " & xScope & " show clients 1")
 
	'Je met le résultat de ma commande dans un tableau temporaire Pas de PB
	AllLigne = strConsoleOut
	arrayScopeInfosDump = split(AllLigne, vbNewLine)
 
	'Je commence à la ligne 8 en j'enlève les 4 dernières Pas de PB
	For Line = 8 To UBound(arrayScopeInfosDump) - 4
		Ligne = arrayScopeInfosDump(Line)
		'Je traite chaque ligne et je fais une mise en page perso Pas de PB
		'Ce qui va donner :
		'10.127.8.51#255.255.248.0#00-80-9f-5d-3f-d8#11/11/2013 09:11:56#D#ALCATEL-iptouch-00809f5d3fd8.mondomaine.fr
		Call GetClientsInfos(Ligne,Client_Ip,Client_Mask,Client_Mac,Client_Lease,Client_Type,Client_Device)
		ClientsInfos = Client_Ip & "#" & Client_Mask & "#" & Client_Mac & "#" & Client_Lease & "#" & Client_Type & "#" & Client_Device
		If Not DicoAddClients.Exists(Client_Ip) Then
		'Si l'@IP n'existe pas je la met dans le dico clients Pas de PB :
		' sous la forme :
		' Clé --> 10.127.8.51 Valeur --> 10.127.8.51#255.255.248.0#00-80-9f-5d-3f-d8#11/11/2013 09:11:56#D#ALCATEL-iptouch-00809f5d3fd8.mondomaine.fr
			DicoAddClients.add Client_Ip, ClientsInfos
		End If
	Next
 
	'msgbox DicoAddClients.count
 
	strHTML = strHTML &"<table>"
	strHTML = strHTML & "<caption>Clients Informations for scope : " & xScope & "</caption>"
	strHTML = strHTML & "<tr>"
	strHTML = strHTML & "<th>Count</th>"
	strHTML = strHTML & "<th>Status</th>"
	strHTML = strHTML & "<th>Ip</th>"
	strHTML = strHTML & "<th>Mask</th>"
	strHTML = strHTML & "<th>Mac</th>"
	strHTML = strHTML & "<th>Lease</th>"
	strHTML = strHTML & "<th>Type</th>"
	strHTML = strHTML & "<th>Name</th>"
	strHTML = strHTML & "<th>Action</th>"
	strHTML = strHTML & "</tr>"
 
	Set DicoListIP = CreateObject("Scripting.Dictionary")
	DicoListIP.CompareMode = vbTextCompare
 
	'Pour mon scope, je défini le nombre d'@IP total qu'il est possibloe d'avoir Pas de PB et j'enregistre ds un dico.
	Call AvailableIpForScope(xScope,xTOTAL_HOST,arrayAvailableIP)	
 
	For Line = 0 To UBound(arrayAvailableIP) - 1
		DicoListIP.add arrayAvailableIP(Line), arrayAvailableIP(Line)
	Next
 
	'msgbox DicoListIP.count
 
 
	' Creation de mon tableau html
	Client_Status = "FREE"
	Client_Mask = ""
	Client_Mac = ""
	Client_Lease = ""
	Client_Type = ""
	Client_Device = "" 
	Color = "#00CC33" 'Green
 
	'Je parcours mon dico d'@ IP et je compare avec mon dico de clients
	'SI l'@ip existe dans le dico de client alors elle est prise
	'Sinon j'affcihe free
	CptClient = 0
	IndexKeys = DicoListIP.Keys
	For key=0 To ubound(IndexKeys)
		CptClient = CptClient +1
		If DicoAddClients.Exists(IndexKeys(key)) Then	
			DicoAddClientsValue = DicoAddClients.item(IndexKeys(key))
		Else
			DicoListIPValue = DicoListIP.item(IndexKeys(key))
			Client_Ip = DicoListIPValue
		End If
 
		'PB la !!!!!!
 
		'Si je ne fait pas mon split et j'affiche mes valeurs brut (DicoAddClientsValue) --> affichage en 35 secondes pour 2000 lignes ...
		' Ce qui donne :
		'51 10.127.8.51#255.255.248.0#00-80-9f-5d-3f-d8#11/11/2013 09:11:56#D#ALCATEL-iptouch-00809f5d3fd8.mondomaine.fr
		'52 10.127.8.52#255.255.248.0#00-80-9f-5b-ca-8f#12/11/2013 02:58:33#D#ALCATEL-iptouch-00809f5bca8f.mondomaine.fr
		'53 10.127.8.53#255.255.248.0#00-80-9f-8e-83-46#14/11/2013 11:56:08#D#ALCATEL-iptouch-00809f8e8346.mondomaine.fr
		'54 10.127.8.54#255.255.248.0#00-80-9f-5d-27-ce#12/11/2013 02:57:56#D#ALCATEL-iptouch-00809f5d27ce.mondomaine.fr
		'55 10.127.8.55#255.255.248.0#00-80-9f-5d-81-96#11/11/2013 09:58:55#D#ALCATEL-iptouch-00809f5d8196.mondomaine.fr
		'56 10.127.8.56#255.255.248.0#00-80-9f-5d-42-5a#12/11/2013 08:52:08#D#ALCATEL-iptouch-00809f5d425a.mondomaine.fr
 
 
		'Si je fait mon split + case ci-dessous affichage en 150 secondes pour 2000 lignes !!!!!! :(
		'If len(DicoAddClientsValue) > 0 Then
		'	Tab1 = Split(DicoAddClientsValue,"#")
		'	Client_Status = "IN USE"
		'	Client_Ip = Tab1(0)
		'	Client_Mask = Tab1(1)
		'	Client_Mac = UCase(Tab1(2))
		'	Client_Lease = Tab1(3)
		'	Client_Type = Tab1(4)
		'	Client_Device = Tab1(5)
		''	Color = "#82CAFA" 'Blue
 
		strHTML = strHTML & "<tr><Form method='POST'>"
 
		strHTML = strHTML & "<input type='hidden'  name='xscope'  value='" & xScope & "'>"
		strHTML = strHTML & "<input type='hidden'  name='strdhcpserver'  value='" & strDHCPServer & "'>"
 
		strHTML = strHTML & "<td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & CptClient & "</td>"
 
		strHTML = strHTML & "<td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & DicoAddClientsValue & "</td>"
 
		'strHTML = strHTML & "<td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Ip & "</td>"
		'strHTML = strHTML & "<input type='hidden'  name='client_ip'  value='" & Client_Ip & "'>"
 
		'strHTML = strHTML & "<td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Status & "</td>"
 
		'strHTML = strHTML & "<td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Mask & "</td>"
 
		'strHTML = strHTML & "<td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Mac & "</td>"
		'strHTML = strHTML & "<input type='hidden'  name='client_mac'  value='" & Client_Mac & "'>"
 
		'strHTML = strHTML & "<td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Lease & "</td>"
 
		'strHTML = strHTML & "<td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Type & "</td>"
 
		'strHTML = strHTML & "<td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Device & "</td>"
		'strHTML = strHTML & "<input type='hidden'  name='client_device'  value='" & Client_Device & "'>"
 
		'strHTML = strHTML & "<td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Action & "</td>"
		strHTML = strHTML & "</tr></Form>"
 
	Next
 
	' Result
	If CptClient >= 1 Then
		ScopesList.InnerHTML = strHTML & "</table>"
		Actions.InnerHTML = "Execution Time : <b>" & FormatNumber(Timer() - StartTime, 2) & " seconds </b>"
	Else
		ScopesList.InnerHTML = " No Clients for this scope ..."
	End If
 
End Sub
'################################################################################

salut,
ce n'est pas la ligne Split n°109 qui est responsable de l'effondrement des perfs de ton script mais la concaténation de ta chaine strHTML
j'avais proposé il y a quelques années une entrée FAQ sur le sujet mais je ne crois pas qu'elle ait été intégrée :aie:
une copie pour info :

Citation:

Q : [Optimisation] Concaténation de chaines

R : La concaténation de chaines lorsqu'elle intervient de façon répétitive dans une boucle devient rapidement impraticable si l'opérateur & est utilisé.
Il est donc nécessaire de lui substituer un algorithme plus performant.
- La 1ère solution qui ne sera pas abordée ici car elle impose la présence d'un composant COM, est l'utilisation de l'objet Stream du composant ADO.
- La 2ème utilise les variables tableaux et la fonction Join
Deux approches sont possibles : soit le nombre de concaténations est connu par avance (ex : boucle For...Next) dans ce cas le choix d'un tableau de taille prédéfinie et fixe sera la meilleure solution, soit ce nombre n'est pas connu avec précision et la seule solution sera le tableau dynamique.
Toutefois, lorsque la chaine finale devient vraiment importante (> 1Mo), il peut être judicieux d'optimiser cette solution en limitant le nombre des redimensionnement toujours coûteux en temps et mémoire.
Vous trouverez ci-dessous le code résumant toutes ces approches ainsi que le code "classique" aux fins de comparaison.
Code:

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 Dim aBuffer(4999) Dim aDynBuffer() sChunk = Space(200) iTime = Timer For i = 0 to 4999 ReDim Preserve aDynBuffer(i) aDynBuffer(i) = sChunk Next sBuffer = Join(aDynBuffer,"") FastConcatTime = Timer - iTime iTime = Timer For i = 0 to 4999 aBuffer(i) = sChunk Next sBuffer = Join(aBuffer,"") FasterConcatTime = Timer - iTime ' la méthode optimisée est surtout utile quand la chaine est longue (> 1 Mo) Erase aDynBuffer ReDim aDynBuffer(0) iTime =Timer For i = 0 to 4999 If UBound(aDynBuffer) < i Then ReDim Preserve aDynBuffer(i + 10) aDynBuffer(i) = sChunk Next sBuffer = Join(aDynBuffer,"") FastestConcatTime = Timer - iTime sBuffer = "" iTime = Timer For i = 0 to 4999 sBuffer = sBuffer & sChunk Next ConcatTime = Timer - iTime MsgBox "Concaténation normale : " & Round(ConcatTime,2) & vbCrLf & _ "Concaténation par tableau dynamique : " & Round(FastConcatTime,2) & vbCrLf & _ "Concaténation par tableau fixe : " & Round(FasterConcatTime,2) & vbCrLf & _ "Concaténation par tableau dynamique optimisé : " & Round(FastestConcatTime,2) & vbCrLf & _ " Taille finale de la chaine : " & Len(sBuffer)

07/11/2013, 11h11
snorky94

humm effectivement ca va très vite, sauf que pour implémenter dans mon cote maintenant :) ....
07/11/2013, 11h35
omen999

tu connais la taille de ton dico
tu sais que DicoAddClientsValue sera splitté en 6 éléments
un tableau strHTML fixe devrait donc être possible

Merci pour ta réponse, pour le tableau fixe c'est donc :
Code:

1 2 3 4 5 6 7 8 9 10 11 Dim aBuffer(4999) Dim aDynBuffer() sChunk = Space(6) iTime = Timer For i = 0 to 4999 aBuffer(i) = sChunk Next sBuffer = Join(aBuffer,"") FasterConcatTime = Timer - iTime
Mais je ne vois pas comment l’intégrer, quelles variables remplacer, etc ...

Merci encore.

07/11/2013, 14h23
omen999

déjà tu compactes ton header (lignes 45 à 57) que tu appelles sHeader
ensuite tu sais que le nb d'items max est égal à DicoAddClients.Count
tu dénombres les blocs de string nécessaires pour construire un item
(lignes 119 à 146)
donc

Code:

Dim aHTML(Dico.count x nb blocs)

gestion d'une variable indice dans la boucle pour affecter les éléments du tableau aHTML
et à la sortie (ligne 149)

Code:

strHTML = sHeader & Join(aHTML,"")

:(

Je ne vois pas comment l'intégrer, ci dessous ce que j'ai fait mais ca ne fonctionne pas :(

Merci à toi.

Code:

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
 
 
'################################################################################
' GET SCOPE DETAILS
'################################################################################
Sub Scope_Infos(xScope,xMask,xName,xDesc,xStatus,xLease,xCIDR,xBROADCAST,xTOTAL_HOST,xIP_RANGE,xUsed,xFree,xSumTotal,xPercentFree,xPercentUsed,xExclusions)
 
	StartTime = Timer()
	Set objShell = CreateObject("WScript.Shell")
 
	strDHCPServer = FilterSelection.ServerName.Value
	strFilter = FilterSelection.Filter.Value
	Actions.InnerHTML = "Retryving " & xScope & " scope configuration, please wait ..."
 
	'Creation de mon dico pour stocker le résulat de ma commande
	Set DicoAddClients = CreateObject("Scripting.Dictionary")
	DicoAddClients.CompareMode = vbTextCompare
 
	'J'execute ma commande qui va lister les membres des scopes dhcp Pas de PB
	Dim objConsole
	set objConsole = new CliWrapper
	strConsoleOut = objConsole.exec("netsh dhcp server \\" & strDHCPServer & " scope " & xScope & " show clients 1")
 
	'Je met le résultat de ma commande dans un tableau temporaire Pas de PB
	AllLigne = strConsoleOut
	arrayScopeInfosDump = split(AllLigne, vbNewLine)
 
	'Je commence à la ligne 8 en j'enlève les 4 dernières Pas de PB
	For Line = 8 To UBound(arrayScopeInfosDump) - 4
		Ligne = arrayScopeInfosDump(Line)
		'Je traite chaque ligne et je fais une mise en page perso Pas de PB
		'Ce qui va donner :
		'10.127.8.51#255.255.248.0#00-80-9f-5d-3f-d8#11/11/2013 09:11:56#D#ALCATEL-iptouch-00809f5d3fd8.mondomaine.fr
		Call GetClientsInfos(Ligne,Client_Ip,Client_Mask,Client_Mac,Client_Lease,Client_Type,Client_Device)
		ClientsInfos = Client_Ip & "#" & Client_Mask & "#" & Client_Mac & "#" & Client_Lease & "#" & Client_Type & "#" & Client_Device
		If Not DicoAddClients.Exists(Client_Ip) Then
		'Si l'@IP n'existe pas je la met dans le dico clients Pas de PB :
		' sous la forme :
		' Clé --> 10.127.8.51 Valeur --> 10.127.8.51#255.255.248.0#00-80-9f-5d-3f-d8#11/11/2013 09:11:56#D#ALCATEL-iptouch-00809f5d3fd8.mondomaine.fr
			DicoAddClients.add Client_Ip, ClientsInfos
		End If
	Next
 
	'msgbox DicoAddClients.count
 
	'---> NEW
	sHeader  = sHeader  &"<table>"
	sHeader  = sHeader & "<caption>Clients Informations for scope : " & xScope & "</caption>"
	sHeader  = sHeader & "<tr>"
	sHeader  = sHeader & "<th>Count</th>"
	sHeader  = sHeader & "<th>Status</th>"
	sHeader  = sHeader & "<th>Ip</th>"
	sHeader  = sHeader & "<th>Mask</th>"
	sHeader  = sHeader & "<th>Mac</th>"
	sHeader  = sHeader & "<th>Lease</th>"
	sHeader  = sHeader & "<th>Type</th>"
	sHeader  = sHeader& "<th>Name</th>"
	sHeader  = sHeader & "<th>Action</th>"
	sHeader  = sHeader & "</tr>"
 
	Set DicoListIP = CreateObject("Scripting.Dictionary")
	DicoListIP.CompareMode = vbTextCompare
 
	'Pour mon scope, je défini le nombre d'@IP total qu'il est possibloe d'avoir Pas de PB et j'enregistre ds un dico.
	Call AvailableIpForScope(xScope,xTOTAL_HOST,arrayAvailableIP)	
 
	For Line = 0 To UBound(arrayAvailableIP) - 1
		DicoListIP.add arrayAvailableIP(Line), arrayAvailableIP(Line)
	Next
 
	'msgbox DicoListIP.count
 
 
	' Creation de mon tableau html
	Client_Status = "FREE"
	Client_Mask = ""
	Client_Mac = ""
	Client_Lease = ""
	Client_Type = ""
	Client_Device = "" 
	Color = "#00CC33" 'Green
 
	'---> NEW
	Dim aHTML(DicoAddClients*6)
 
	'J'ai pris 6 blocs sachant que je dois découper une chaine de ce type :
	'51 10.127.8.51#255.255.248.0#00-80-9f-5d-3f-d8#11/11/2013 09:11:56#D#ALCATEL-iptouch-00809f5d3fd8.mondomaine.fr
 
 
	'Je parcours mon dico d'@ IP et je compare avec mon dico de clients
	'SI l'@ip existe dans le dico de client alors elle est prise
	'Sinon j'affcihe free
	CptClient = 0
	IndexKeys = DicoListIP.Keys
	For key=0 To ubound(IndexKeys)
		CptClient = CptClient +1
		If DicoAddClients.Exists(IndexKeys(key)) Then	
			DicoAddClientsValue = DicoAddClients.item(IndexKeys(key))
 
 
 
		Else
			DicoListIPValue = DicoListIP.item(IndexKeys(key))
			Client_Ip = DicoListIPValue
		End If
 
		'PB la !!!!!!
 
		'Si je ne fait pas mon split et j'affiche mes valeurs brut (DicoAddClientsValue) --> affichage en 35 secondes pour 2000 lignes ...
		' Ce qui donne :
		'51 10.127.8.51#255.255.248.0#00-80-9f-5d-3f-d8#11/11/2013 09:11:56#D#ALCATEL-iptouch-00809f5d3fd8.mondomaine.fr
		'52 10.127.8.52#255.255.248.0#00-80-9f-5b-ca-8f#12/11/2013 02:58:33#D#ALCATEL-iptouch-00809f5bca8f.mondomaine.fr
		'53 10.127.8.53#255.255.248.0#00-80-9f-8e-83-46#14/11/2013 11:56:08#D#ALCATEL-iptouch-00809f8e8346.mondomaine.fr
		'54 10.127.8.54#255.255.248.0#00-80-9f-5d-27-ce#12/11/2013 02:57:56#D#ALCATEL-iptouch-00809f5d27ce.mondomaine.fr
		'55 10.127.8.55#255.255.248.0#00-80-9f-5d-81-96#11/11/2013 09:58:55#D#ALCATEL-iptouch-00809f5d8196.mondomaine.fr
		'56 10.127.8.56#255.255.248.0#00-80-9f-5d-42-5a#12/11/2013 08:52:08#D#ALCATEL-iptouch-00809f5d425a.mondomaine.fr
 
 
		'Si je fait mon split + case ci-dessous affichage en 150 secondes pour 2000 lignes !!!!!! :(
		'If len(DicoAddClientsValue) > 0 Then
		'	Tab1 = Split(DicoAddClientsValue,"#")
		'	Client_Status = "IN USE"
		'	Client_Ip = Tab1(0)
		'	Client_Mask = Tab1(1)
		'	Client_Mac = UCase(Tab1(2))
		'	Client_Lease = Tab1(3)
		'	Client_Type = Tab1(4)
		'	Client_Device = Tab1(5)
		''	Color = "#82CAFA" 'Blue
 
		strHTML = strHTML & "<tr><Form method='POST'>"
 
		strHTML = strHTML & "<input type='hidden'  name='xscope'  value='" & xScope & "'>"
		strHTML = strHTML & "<input type='hidden'  name='strdhcpserver'  value='" & strDHCPServer & "'>"
 
		strHTML = strHTML & "<td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & CptClient & "</td>"
 
		strHTML = strHTML & "<td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & DicoAddClientsValue & "</td>"
 
		'strHTML = strHTML & "<td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Ip & "</td>"
		'strHTML = strHTML & "<input type='hidden'  name='client_ip'  value='" & Client_Ip & "'>"
 
		'strHTML = strHTML & "<td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Status & "</td>"
 
		'strHTML = strHTML & "<td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Mask & "</td>"
 
		'strHTML = strHTML & "<td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Mac & "</td>"
		'strHTML = strHTML & "<input type='hidden'  name='client_mac'  value='" & Client_Mac & "'>"
 
		'strHTML = strHTML & "<td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Lease & "</td>"
 
		'strHTML = strHTML & "<td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Type & "</td>"
 
		'strHTML = strHTML & "<td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Device & "</td>"
		'strHTML = strHTML & "<input type='hidden'  name='client_device'  value='" & Client_Device & "'>"
 
		'strHTML = strHTML & "<td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Action & "</td>"
		strHTML = strHTML & "</tr></Form>"
 
	Next
 
	'---> NEW
	strHTML = sHeader & Join(aHTML,"")
 
	' Result
	If CptClient >= 1 Then
		ScopesList.InnerHTML = strHTML & "</table>"
		Actions.InnerHTML = "Execution Time : <b>" & FormatNumber(Timer() - StartTime, 2) & " seconds </b>"
	Else
		ScopesList.InnerHTML = " No Clients for this scope ..."
	End If
 
End Sub
'################################################################################

Code:

Dim aHTML(DicoAddClients*6)

:calim2:
déjà la propriété count n'est pas une propriété par défaut de l'objet Dictionary
en plus, la taille du tableau n'étant pas une constante, le tableau doit être dimensionné par la fonction Array
par ailleurs, je pense qu'il est plus simple pour toi de constituer la chaine complète de l'item directement sans auto-concaténation intermédiaire
donc un exemple simplifié

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Dim aHTML
aHTML = Array(DicoAddClients.Count)
iCur = 0
For key=0 To ubound(IndexKeys)
  Tab1 = Split(DicoAddClientsValue,"#")
  Client_Status = "IN USE"
  Client_Ip = Tab1(0)
  Client_Mask = Tab1(1)
  Client_Mac = UCase(Tab1(2))
  Client_Lease = Tab1(3)
  Client_Type = Tab1(4)
  Client_Device = Tab1(5)
  Color = "#82CAFA" 'Blue
  aHTML(iCur) = "<tr><Form method='POST'><input type='hidden' name='xscope'  value='" & xScope & "'><input type='hidden'  name='strdhcpserver'  value='" & strDHCPServer & "'><td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & CptClient & "</td><td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & DicoAddClientsValue & "</td><td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Ip & "</td><input type='hidden'  name='client_ip'  value='" & Client_Ip & "'><td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Status & "</td><td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Mask & "</td><td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Mac & "</td><input type='hidden'  name='client_mac'  value='" & Client_Mac & "'><td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Lease & "</td><td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Type & "</td><td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Device & "</td><input type='hidden'  name='client_device'  value='" & Client_Device & "'><td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Action & "</td></tr></Form>"
   iCur = iCur + 1
Next
strHTML = sHeader & Join(aHTML,"")

07/11/2013, 17h33
snorky94

désolé j'avais trouvé entre tps, pas eu le tps de répondre :cry:

Mais effectivement c'est comme ca que j'avais fait, merci je fais des tests de perf et je reviens vers toi ;)

Merci omen999 tu déchires :ccool: :ccool: :ccool:

Juste une question, à quoi sert ta variable iCur dans l'exemple ?

Moi je fait ca et ca marche bien aussi :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Dim aHTML
aHTML = Array(DicoListIP.count)
iCur = 0
For key=0 To ubound(IndexKeys)
 
  myhtml  = ""
  DicoAddClientsValue = DicoAddClients.item(IndexKeys(key))	
  Tab1 = Split(DicoAddClientsValue,"#")
  Client_Status = "IN USE"
  Client_Ip = Tab1(0)
  Client_Mask = Tab1(1)
  Client_Mac = UCase(Tab1(2))
  Client_Lease = Tab1(3)
  Client_Type = Tab1(4)
  Client_Device = Tab1(5)
  Color = "#82CAFA" 'Blue
  myhtml  = "<tr><Form method='POST'><input type='hidden' name='xscope'  value='" & xScope & "'><input type='hidden'  name='strdhcpserver'  value='" & strDHCPServer & "'><td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & CptClient & "</td><td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & DicoAddClientsValue & "</td><td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Ip & "</td><input type='hidden'  name='client_ip'  value='" & Client_Ip & "'><td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Status & "</td><td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Mask & "</td><td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Mac & "</td><input type='hidden'  name='client_mac'  value='" & Client_Mac & "'><td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Lease & "</td><td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Type & "</td><td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Device & "</td><input type='hidden'  name='client_device'  value='" & Client_Device & "'><td style=" & chr(34) & "background-color:" & Color & "" & chr(34) & ">" & Client_Action & "</td></tr></Form>"
aHTML(key) =  myhtml
Next
strHTML = sHeader & Join(aHTML,"")

Merci encore c’est le top, je peux lire plus de 4000 lignes en 1 seconde maintenant ;)

Merci ;)

08/11/2013, 11h18
omen999

Citation:

Juste une question, à quoi sert ta variable iCur dans l'exemple ?

:oops: à rien... j'ai changé de logique en cours de route et cette variable était indispensable en cas de concaténation de blocs multiples par item...

merci de cliquer sur :resolu:

de plus 150 secondes à moins d'une seconde, bel exemple pratique d'optimisation
08/11/2013, 12h01
snorky94

Merci à omen999 pour son aide précieuse :ccool::ccool::ccool::ccool:

Sujet résolu.

:ccool: