Amelioration du temps de traitement d'un split

**snorky94** · 06/11/2013, 23h06

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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
'################################################################################

**omen999** · 07/11/2013, 10h43

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

une copie pour info :

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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)

**snorky94** · 07/11/2013, 11h11

humm effectivement ca va très vite, sauf que pour implémenter dans mon cote maintenant

....

**omen999** · 07/11/2013, 11h35

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

**snorky94** · 07/11/2013, 12h11

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

**omen999** · 07/11/2013, 14h23

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 :

Sélectionner tout - Visualiser dans une fenêtre à part