Bonjour à toutes et tous!

J'ai un petit souci avec un programme en VBS que je développe pour mon travail.

Le programme sert à tester l'existence de signatures de programmes antivirus sur le réseau (sans utiliser la console d'administration).

Mon erreur d'execution provient du ping à la ligne 164...

Voila le code:
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
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
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Program Name	: chkAntivir							'
' Version	: 1.0								'
' Licence	: GNU/GPL							'
' Copyright	: neo2k2					        	'
' Description	: programme de verification des antivirus sur les pc du domaine '
'										'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
'
' modifier les variables %SERVER%, %MAIL%, %DOMAIN% avec vos propres parametres
'
 
Dim Fso
Dim FileRepInet	' Repertoire des fichiers  
Dim ScanTime, ScanEnd
'
ScanTime = "Scan began at: " & Now
'
'
LogTxt = "reportPC.log"   
LogXls = "FinalReport.xls"   
FileRepInet = "\\%SERVER%\AntivirChk\"  
'
Call chkDomain()
Call rwxFile("\\%SERVER%\AntivirChk\reportPC.log", "Beginning scan at: " & Now)
'
Call chkAntivir("\\%SERVER%\AntivirChk\finalListPC.log")
'
Call rwxFile("\\%SERVER%\AntivirChk\reportPC.log", "Scan ended at: " & Now)
'
Call xFile("\\%SERVER%\AntivirChk\finalListPC.log")
'
ScanEnd = "Scan ended at: " & Now
'
Call SendMail(%SERVER%,%MAIL%, %MAIL%,"Antivirus report", ScanTime & " / " & ScanEnd & " - " & FileRepInet & LogXls)
'
MsgBox "Antivirus report", ScanTime & " / " & ScanEnd & " - " & FileRepInet & LogXls, vbInformation
'
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
 
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'																		     '
' Principales procedures et fonctions utilisees par le programme chkDomain() '
'																		     '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
 
Sub chkAntivir(rTXT)
'
' Cette procedure lit le contenu du fichier texte et execute la requete
'
	'declaration des variables
	Dim tFSO
	Dim Ftxt, strComputer
	'instanciation
	Set tFSO = CreateObject("Scripting.FileSystemObject")
	'on instancie le fichier texte 
	Set Ftxt = tFSO.OpenTextFile(rTXT,1,False)
	'on parcourt chaque ligne du fichier texte
	Do While Not Ftxt.AtEndOfStream
	      'le code pour traiter chaque ligne
	      strComputer = Ftxt.Readline
	      Call ChkFile(strComputer)
	Loop
	'
	Ftxt.Close
'
End Sub
 
Sub chkDomain()
'
' Cette procedure repertorie tous les PC du domaine mais exclut les serveurs et machines d'acquisition
'
	' Declaration de la constante de lecture de l'arborescence de l'AD
	Const ADS_SCOPE_SUBTREE = 2
	' Instanciation des objets pour la lecture de l'AD
	Set objConnection = CreateObject("ADODB.Connection")
	Set objCommand =   CreateObject("ADODB.Command")
	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "Active Directory Provider"
	' Instanciation de la connexion a l'AD
	Set objCOmmand.ActiveConnection = objConnection
	' Commande de connexion a l'AD
	objCommand.CommandText = _
	    "Select Name from 'LDAP://DC=%DOMAIN%,DC=com' Where objectClass='computer'"  
	objCommand.Properties("Page Size") = 1000
	objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
	' Instanciation de la requete a executer sur l'AD
	Set objRecordSet = objCommand.Execute
	' On se place sur le premier element trouve
	objRecordSet.MoveFirst
	' On parcourt la liste des objets correspondant a la requete dans l'AD
	Do Until objRecordSet.EOF
		' Appelle la procedure pour ecrire les objets dans un fichier
    	Call wFile("\\%SERVER%\AntivirChk\finalListPC.log", objRecordSet.Fields("Name").Value)
    	' Deplace le pointeur sur l'objet suivant dans l'AD
	    objRecordSet.MoveNext
	Loop
'
End Sub
 
Sub rwxFile(rTXT, info)
'
' Cette fonction ecrit dans un fichier les informations qui lui sont passees en parametres
'
	Dim rFile 'Nom du fichier
	Dim FSys  'Declaration du File Scripting Object
	' Instanciation de l'objet
	Set FSys = CreateObject("Scripting.FileSystemObject")
	' Creation/Ouverture du fichier a ecrire
	Set rFile = FSys.OpenTextFile(rTXT,8,True)
	' Ecrit l'information
	rFile.writeLine info
	' Ferme l'objet texte
	rFile.Close
'
End Sub
 
Sub wFile(sTxt, wTxt)
'
' Cette procdure nettoie le fichier texte de donnees indesirees
'
	'declaration file system object
	Dim tFSO
	Dim Ftxt, tempTxt
	'instanciation
	Set tFSO = CreateObject("Scripting.FileSystemObject")
	'on instance le fichier texte 
	Set Ftxt = tFSO.OpenTextFile(sTxt,8,True)
	'on parcours chaque ligne du fichier texte
	tempTxt = Left(wTxt,4)
	If tempTxt = "LAPT" Or tempTxt = "POST" Then
		Ftxt.Writeline wTxt
	End If
	'
	Ftxt.Close
'
End Sub
 
Sub ChkFile(strComputer)
'
' Recherche sur la machine de fichiers de signature
'
	Dim cFile, tFile
	Dim Alert, Alert1, Alert2, Alert3, AlertPing
	'
	Alert = strComputer & ": "
	Alert1 = "Computer Associates"
	Alert2 = "Trend Micro"
	Alert3 = "no antivirus installed"
	AlertPing = strComputer & " did not respond to ping"
	'
	cFile = "\\" & strComputer & "\c$\Program Files\CA\SharedComponents\ScanEngine\vet.dat"
	tFile = "\\" & strComputer & "\c$\Program Files\Trend Micro\Client Server Security Agent\usrwl.dat"
	'
	Set fso = CreateObject("scripting.filesystemobject" )
	' Appelle la procedure pour pinger les objets
	Set objShell = CreateObject("WScript.Shell") 
	'Set objExec = objShell.Exec("ping -n 2 -w 1000 " & strComputer) ' methode moche mais qui fonctionne
	Set objRun = objShell.Run "ping -n 2 -w 1000 " & chr(34) & strComputer & chr(34), 0, True ' serait preferable car la fenetre DOS ne s'affiche pas mais ne marche pas
	'strPingResults = LCase(objExec.StdOut.ReadAll) ' a utiliser avec objShell.Exec
	strPingResults = LCase(objRun.StdOut.ReadAll)
	' on va maintenant pinger chaque machine
	If InStr(strPingResults, "reply from") Then 
		'WScript.Echo VbCrLf & strTarget & " responded to ping."
		' si le ping repond, on continue la verification
		If fso.FileExists(cFile) = True Then
			Call ChkDate(cFile)
		    Alert = Alert & Alert1
		End If
		If fso.FileExists(tFile) = True Then
			Call ChkDate(tFile)
			Alert = Alert & Alert2
		End If
		If fso.FileExists(cFile) = False AND fso.FileExists(tFile) = False Then
			'
			Call rwxFile("\\%SERVER%\AntivirChk\reportPC.log", Alert & " " & Alert3)
				Else
			'
			Call rwxFile("\\%SERVER%\AntivirChk\reportPC.log", Alert)
		End If
		'
	Else  ' sinon on ecrit la reponse dans le fichier
		'WScript.Echo VbCrLf & strTarget & " did not respond to ping."
		Call rwxFile("\\%SERVER%\AntivirChk\reportPC.log", AlertPing)
	End If 
'
End Sub
 
Sub xFile(stFile)
'
' Cette fonction permet de comparer la date du fichier avec la date du jour en tolrant une diffrence de 3 jours
'
	'dclaration file system object
	Dim fso
	'instanciation
	Set FSO = CreateObject("Scripting.FileSystemObject")
	'Suppression du fichier
	Set Ftxt = fso.GetFile(stFile)
	Ftxt.delete
End Sub
 
Sub SendMail(mserv, mfrom, mto, msub, mtxt)
	Set objEmail = CreateObject("CDO.Message")
 
	objEmail.From = mfrom
	objEmail.To = mto
	objEmail.Subject = msub 
	objEmail.Textbody = mtxt
	objEmail.Configuration.Fields.Item _
	    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
	objEmail.Configuration.Fields.Item _
	    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
	        mserv 
	objEmail.Configuration.Fields.Item _
	    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
	objEmail.Configuration.Fields.Update
	objEmail.Send
End Sub
 
Function ChkDate(stFichier)
'
' Cette fonction permet de comparer la date du fichier avec la date du jour en tolrant une diffrence de 3 jours
'
	Dim AlertDate, oldAlert, newAlert
	Dim oFSO,oFl
	'
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	If oFSO.FileExists(stFichier) Then
		Set oFl = oFSO.GetFile(stFichier)
	  	AlertDate = Day(oFl.DateLastModified)
	  	If DateDiff("d", Day(Now), AlertDate) >= 3 Then
	  		'MsgBox AlertDate, vbExclamation
	  		Call rwxFile("\\%SERVER%\AntivirChk\reportPC.log", "perime" & AlertDate)
	  	Else
	  		'MsgBox AlertDate, vbInformation
	  		Call rwxFile("\\%SERVER%\AntivirChk\reportPC.log", "a jour" & AlertDate)
	  	End If
	  	'MsgBox AlertDate
	End If
'
End Function
Merci d'avance