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 |
