probleme d'insertion dans un tableau (WMI)

Bonjour

j'ai écris un script pour recuperer en WMi les imprimantes de 2 serveurs Active directory en WMI afin d'avoir les differences au niveau des imprimantes entre ces 2 serveur.

la requête wmi fonctionne, j'arrive à inserer les noms d'imprimantes dans un tableau mais je n'arrive pas à avoir la liste des differences.

Est ce que quelqu'un pourrait m'aider ?

Voici le code

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
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
 
'option Explicit
 
Dim g_lp
Dim g_prog
Dim g_rnd
Dim g_flog
Dim g_replace
Dim g_dbg
Dim shell, env, home, UDNSDOMAIN
Dim adsys
Dim oPrinter, strServer1, strServer2, StrServerBackup,nbprint
Dim ServerName, ShareName, DriverName
Dim sDomaineI, sDomaineU, sDomaineC
Dim oConnection,oCommand, oRecordSet, nbsrv
 
 
g_dbg = 0
g_prog = "RestorePrinters-add-printerAD"
 
Set shell = CreateObject("WScript.Shell")
set env = shell.Environment("PROCESS")
 
 
'Enregistrement DLL Prnadmin.dll
Shell.Run "regsvr32 /s Prnadmin.dll",1,True
 
'Recuperation du chemin pour les logs
home = env("HOMEDRIVE") & env("HOMEPATH")
If home = "" Then
	home = "C:"
end If
 
'Création du fichier de log
g_flog = home & "\" & g_prog & ".log"
g_replace = False
Randomize()
g_rnd = CInt(Int((10000 * Rnd()) + 1))
 
'Debut du Log
msglog("Debut.")
 
'++++++++++++++++++++++++++++++++++++++++
'-			Déclaration méthode         -
'++++++++++++++++++++++++++++++++++++++++
 
 
        	Set WSHShell = WScript.CreateObject("WScript.Shell")
	Dim sImpn(20,3)
        ' Test des Domaines NT
     '   On Error Resume Next
		UDNSDOMAIN = WshShell.ExpandEnvironmentStrings ("%USERDNSDOMAIN%")
        If Err <> 0 then
            Retour = MsgBox("Erreur au lancement, ce programme ne peut s'exécuter sur un poste Pl@net V1 !" & Chr(13) & " Fin du programme.", vbOKOnly + vbCritical)
            WScript.quit
        End If
        sDomaineI = ""
        sDomaineU = ""
        sDomaineC = ""
 
        If LCase(UDNSDOMAIN) = "local" Then
            sDomaineI = "OU=FilePrinters,OU=Servers,DC=Packaging"
            sDomaineU = "OU=User-Accounts,DC=Packaging"
            sDomaineC = "OU=WORKSTATIONS,DC=Packaging"
        ElseIf LCase(UDNSDOMAIN) = "directory" Or LCase(UDNSDOMAIN) = "intranet" Then ' si production, le domaine est :
            sDomaineI = "OU=FilePrinters,OU=Servers,DC=directory"
            sDomaineU = "OU=User-Accounts,DC=directory"
            sDomaineC = "OU=WORKSTATIONS,DC=directory"
        End If
        If sDomaineI = "" Or sDomaineU = "" Then
            Retour = MsgBox("Domaine non reconnu ! Fin du programme.", vbOKOnly + vbCritical)
            WScript.Quit
        End If
   Set oConnection = CreateObject("ADODB.Connection") 
   'connexion avec l'AD 
   oConnection.Open "Provider=ADsDSOObject;" 
   Set oCommand = CreateObject("ADODB.Command") 
   oCommand.ActiveConnection = oConnection 
 
   'Requete composant la commande du recordSet 
    oCommand.CommandText = _ 
        "<LDAP://"&sDomaineI&">;(&(objectCategory=Computer));name,dNSHostName,description,location;subtree" 
   'execution de la requete 
    Set oRecordSet = oCommand.Execute 
        If Err <> 0 Then
            MsgBox("Impossible de faire une requête AD, le programme ne peut s'exécuter !" & Chr(13) & "Erreur : " & Err.Number & Err.Description)
            WScript.Quit
        End If
       	While Not oRecordset.Eof ' recherche du nom du serveur (qui ne soit pas le serveur de sauvegarde)
           nbsrv = nbsrv + 1
		sImpn(nbsrv, 1) = oRecordSet.Fields("dNSHostName").Value
           	sImpn(nbsrv, 2) = oRecordSet.Fields("location").Value
 
		obj = oRecordSet.Fields("description").Value
          	sImpn(nbsrv, 3) = obj(0)
           If Err <> 0 Then 
                sImpn(nbsrv, 2) = InputBox("L'application manque d'information sur le serveur " & sImpn(nbsrv, 1) & " Entrer son site svp :", , "Site Principal")
                sImpn(nbsrv, 3) = InputBox("L'application manque d'information sur le serveur " & sImpn(nbsrv, 1) & " Entrer son alias svp :", , "simpy20")
            End if
            oRecordSet.movenext
 		Wend
        SrvSauve = ""
        For i = 1 To nbsrv
            If LCase(sImpn(i, 2)) = "site de sauvegarde" Then
                SrvSauve = sImpn(i, 1)
            End If
 
            Next
        If SrvSauve = "" Then
            MsgBox("Impossible de trouver le serveur de référence pour les pilotes ! " & Chr(13) & "Utilisation du serveur " & sImpn(1, 1))
            SrvSauve = sImpn(1, 1)
        End If
        'msgbox("Fin du script, " & nbsrv & " remontés, le serveur de sauvegarde est " & srvsauve)
 
 
'+++++++++++++++++++++++++++
'-DEBUT du script synhro   -
'+++++++++++++++++++++++++++
 
 
 
 Dim printsrv1(1000) 
 Dim printsrv2(1000) 	
 
'Boucle de traitement pour l'ensemble des imprimantes des serveurs d'impression AD
 
 
 Dim objWMIService, objItem, colItems, strComputer, intPrinters
 
 
For i= 1 To nbsrv    
 
'Verification des serveurs du site principal    
 
	If 	lcase(sImpn(i, 2))="site principal" Then                      
		  'MsgBox "test :" & sImpn(i, 1)      
 
		'Liste des imprimante sur le serveur principal 
				'msglog("enumeration des imprimantes du serveur :" & sImpn(i, 1))
 
						'gestion du serveur 1			
 
	If lcase(sImpn(i, 1))="srv1" Then
											'MsgBox "srv1"	
							strComputer ="srv1"
							intPrinters = 1
 
							'Pure WMI Section
										Set objWMIService = GetObject ("winmgmts:\\" & strComputer & "\root\CIMV2")
										Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Printer")	 	
 
 
										Call Wait() ' Goto Sub Routine at the end
 
										' On Error Resume Next
										For Each objItem In colItems
										'WScript.Echo objItem.name 
 
									' On recuperer que les imprimantes réseau	
										If objItem.PortName <>"LPT1:" Then						
										'impn(nbprint,1) = oPrinter.PrinterName		
 
						 				printsrv1(i) = objItem.name
 
 
						 				WScript.Echo "srv1 :" & printsrv1(i)
						 				'objDictionary2.Add objItem.ShareName,objItem.ShareName
 
						 				'Wscript.Echo objDictionary2.Count 
										'Array.sort(printsrv1)
										'wscript.echo" printer Name srv2 :" & printsrv2(j)
										End If
										intPrinters = intPrinters + 1
 
 
										Next				 	 				
 
 
							End If	
 
							'gestion du serveur 2
 
							If lcase(sImpn(i, 1))="srv2" Then
											'MsgBox "srv2"	
							strComputer ="srv2"
							intPrinters2 = 1
 
							'Pure WMI Section
										Set objWMIService = GetObject ("winmgmts:\\" & strComputer & "\root\CIMV2")
										Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Printer")	 	
 
 
										Call Wait() ' Goto Sub Routine at the end
 
										' On Error Resume Next
										For Each objItem In colItems
										'WScript.Echo objItem.name 
 
									' On recuperer que les imprimantes réseau	
										If objItem.PortName <>"LPT1:" Then						
 
 
						 				printsrv2(i) = objItem.name
 
 
 
										End If
										intPrinters2 = intPrinters2 + 1
 
 
										Next				 	 				
 
 
							End If	
	End If
 
Next
 
			MsgBox "srv1 :" & 	intPrinters
			MsgBox "srv2 :" & 	intPrinters2
 
 
'++++++++++++++++++++++++++++++++++++++
'Comparaison des 2 serveurs principaux+
'++++++++++++++++++++++++++++++++++++++
 
 
For Each key In printsrv1
WScript.Echo key
Next 
 
 
c = 0 
For Each item1 In printsrv1 
found = False 
For Each item2 In printsrv2 
If item1 = item2 Then 
found = True 
Exit For 
End If 
Next 
If found = False Then 
ReDim Preserve array3(c) 
array3(c) = item1 
c = c + 1 
End If 
Next 
 
For Each key In array3 
WScript.Echo key 
Next 
 
 
 
' ------------------ Fin du programme-----------------------------------------------------------------------------------
 
' ------------------- Subs ---------------------------------------------------------------------------------
 
' ------------------------------------------------------------------------------------------------------------------------
 
' msglog()
'Création d'une log lors de l'éxecution du script
' ---------------------------------------------------------------------------
Sub msglog(msg)
	Dim opof, pof
	Set opof = WScript.CreateObject("Scripting.FileSystemObject")
	Set pof = opof.OpenTextFile(g_flog, 8, True)
	pof.Writeline Date() & "-" & Time() & ": [" & g_rnd & "]: " & g_prog & ": " & msg
	pof.close
	set opof = Nothing
	set pof = Nothing
end Sub
 
sub Wait()
If strComputer = "." Then
strComputer = "Local Host"
else strComputer = strComputer
End If
 
WScript.Echo "Wait 2 mins for " & strComputer _
& " to enumerate printers"
 
End Sub
 
Public Function NCompArrays(ByVal array1, array2)
'walks through each item in array1 and checks if it exists in array2
'those which DO NOT match are stored into NCompArrays
Dim intNonMatching' as Integer
Dim Item1, Item2, i
Dim bolMatch' as Boolean
Dim strMatch' as String
intNonMatching = 0
If IsArray(array1) AND IsArray(array2) Then
' Count non matching items to define new array
For each Item1 in array1
 bolMatch = 0
 For each Item2 in array2
  If UCase(Item1) = UCase(Item2) Then
   bolMatch = 1
   Exit For
  End If
 Next
 If bolMatch = 0 Then
  intNonMatching = intNonMatching + 1
 End If
Next
msgbox intNonMatching
If intNonMatching > 0 Then
 ReDim arrNotMatch(intNonMatching - 1)
 For each Item1 in array1
  bolMatch = 0
  For Each Item2 in array2
   If UCase(Item1) = UCase(Item2) Then
    bolMatch = 1
    Exit For
   End If
  Next
  If bolMatch = 0 Then
   For i = 0 to intNonMatching
    If VarType(arrNotMatch(i)) = 0 Then
     arrNotMatch(i) = Item1
 
     MsgBox Item1
     Exit For
    End If
   Next
  End If
 Next
Else
 strMatch = "All items in array1 found in array2"
End If
Else
strMatch = "Input variable is not an array"
End If
If strMatch <> "" Then
NCompArrays = strMatch
Else
NCompArrays = arrNotMatch
End If
End Function

Ton code est illisible à cause de la mise en forme, peux tu corriger cela ?

Citation:

mais je n'arrive pas à avoir la liste des differences.

Qu'est ce que tu veux faire ?

Bonjour

je veux comparer 2 tableaux (contenant des nom d'imprimantes) afin de faire la difference entre 2 serveurs (1 serveur principal et un serveur secondaire).

j'ai résolu mon problème de tableau (problème de compteur mauvais) mais j'ai encore un problème avec la fonction suivante (recuperer sur internet) :

j'utilise cette fonction avec cette ligne de code
NCompArrays tableau1,tableau2

NCompArrays printsrv1,printsrv2

il le retourne qu'une seule imprimante qu'il ne trouve pas sur le serveur 1

merci de ton aide

Cordialement

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
 
Public Function NCompArrays(ByVal array1, array2)
'walks through each item in array1 and checks if it exists in array2
'those which DO NOT match are stored into NCompArrays
Dim intNonMatching' as Integer
Dim Item1, Item2, i
Dim bolMatch' as Boolean
Dim strMatch' as String
intNonMatching = 0
If IsArray(array1) AND IsArray(array2) Then
' Count non matching items to define new array
For each Item1 in array1
 bolMatch = 0
 For each Item2 in array2
  If UCase(Item1) = UCase(Item2) Then
   bolMatch = 1
   Exit For
  End If
 Next
 If bolMatch = 0 Then
  intNonMatching = intNonMatching + 1
 End If
Next
msgbox intNonMatching
If intNonMatching > 0 Then
 ReDim arrNotMatch(intNonMatching - 1)
 For each Item1 in array1
  bolMatch = 0
  For Each Item2 in array2
   If UCase(Item1) = UCase(Item2) Then
    bolMatch = 1
    Exit For
   End If
  Next
  If bolMatch = 0 Then
   For i = 0 to intNonMatching
    If VarType(arrNotMatch(i)) = 0 Then
     arrNotMatch(i) = Item1
 
     MsgBox Item1
     Exit For
    End If
   Next
  End If
 Next
Else
 strMatch = "All items in array1 found in array2"
End If
Else
strMatch = "Input variable is not an array"
End If
If strMatch <> "" Then
NCompArrays = strMatch
Else
NCompArrays = arrNotMatch
End If
End Function

c'est normal la fonction sort des boucles à chaque fois qu'elle trouve une imprimante présente dans les deux tableaux.

Il faudrait que tu enlèves les Exit For et que tu stockes le nom ou l'index du tableau dans une liste ou un tableau.

j'ai supprimé les for exit

mais j'ai toujours le même problème il ne m'affiche qu'une seul imprimante et une erreur à la ligne If VarType(arrNotMatch(i)) = 0 Then
.

synhroprintersv0.5.vbs(355, 5) Erreur d'exécution Microsoft VBScript: Indice en dehors de la plage: 'i'

merci de ton aide

voici le code modifié

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
 
 
Public Function NCompArrays(ByVal array1, array2)
'walks through each item in array1 and checks if it exists in array2
'those which DO NOT match are stored into NCompArrays
Dim intNonMatching' as Integer
Dim Item1, Item2, i
Dim bolMatch' as Boolean
Dim strMatch' as String
intNonMatching = 0
If IsArray(array1) AND IsArray(array2) Then
' Count non matching items to define new array
For each Item1 in array1
 bolMatch = 0
 For each Item2 in array2
  If UCase(Item1) = UCase(Item2) Then
   bolMatch = 1
   End If
 Next
 If bolMatch = 0 Then
  intNonMatching = intNonMatching + 1
 End If
Next
 
msgbox intNonMatching
 
If intNonMatching > 0 Then
 ReDim arrNotMatch(intNonMatching - 1)
 For each Item1 in array1
  bolMatch = 0
  For Each Item2 in array2
   If UCase(Item1) = UCase(Item2) Then
    bolMatch = 1
    End If
  Next
  If bolMatch = 0 Then
   For i = 0 to intNonMatching
    If VarType(arrNotMatch(i)) = 0 Then
     arrNotMatch(i) = Item1
 
     MsgBox Item1
     End If
   Next
  End If
 Next
Else
 strMatch = "All items in array1 found in array2"
End If
Else
strMatch = "Input variable is not an array"
End If
If strMatch <> "" Then
NCompArrays = strMatch
Else
NCompArrays = arrNotMatch
End If
End Function

Citation:

Il faudrait que tu enlèves les Exit For et que tu stockes le nom ou l'index du tableau dans une liste ou un tableau.

En plus il faut s'assurer que la boucle reste fonctionnelle.

C'est out ce que je peux faire pour l'instant, je n'ai pas le temps en ce moment de plonger dans un code inconnu. Si tu n'y arrives pas il faudra attendre l'arrivé d'un autre intervenant, ou que je soit un peu plus libre, c'est à dire pas avant ce week end, et encore je ne suis même pas sur de pouvoir.

Si tu veux cela doit faire 2 mois que les modérateurs et membres actifs de ce forum m'ont proposer de les aider dans leurs mises à jour de FAQ, ou création de tutoriaux, et je n'ai pas eu le temps encore de faire quoique ce soit. Je crois que je vais essayer ce week end de faire la dernière chose qu'ils m'ont demandé.