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
| 'Selection sur LogFile="Application" ou "System", Type="erreur" et TimeGenerated <= à 15h
'
On Error Resume Next
'Création fichier resultat
Dim resultat : resultat = "C:\TEMP\support\resultatSurvW" & Replace(Date, "/","-") & ".txt"
Dim Fso : Set Fso = CreateObject("Scripting.fileSystemObject")
Dim Rapport : Set Rapport = Fso.openTextFile(resultat, 2, True)
Dim strComputer, objWMIServices, objWMIObjectSet, objWMIObject
strComputer = "."
Set objWMIServices = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set objWMIObjectSet = objWMIServices.ExecQuery _
("Select * from Win32_NTLogEvent Where (LogFile='Application' Or LogFile='system' Or LogFile='Infomil') And Type='Error'")
For Each objWMIObject In objWMIObjectSet
Dim MyComputer : MyComputer = objWMIObject.ComputerName
decritEvenement = objWMIObject.Message
Dim messEv
If DateDiff("d", clair(objWMIObject.TimeGenerated), Now) <= 30 Then
messEv = objWMIObject.ComputerName & ";" & objWMIObject.LogFile & ";" & UCase(Left(objWMIObject.Type,1)) & mid(objWMIObject.Type,2) & ";" & clair(objWMIObject.TimeGenerated) & ";" & objWMIObject.SourceName & ";" & Cesure(objWMIObject.Message, 56)
Rapport.writeLine "" & messEv
End If
Next
Rapport.Close
Set Rapport = Nothing
Set fso = Nothing : Set Rapport = Nothing
Set objWMIObjectSet = Nothing : Set objWMIServices = Nothing
Dim WshShell : Set WshShell = CreateObject("WScript.Shell")
WshShell.Run resultat
Set WshShell = Nothing
WScript.Quit
Function clair(temps)
'tranformation de la date "aaaammjjhhmnss" en jj/mm/aaaa hh:mn
Dim debut, an, mois, jour, hhmn
debut = left(temps,8)
an = left(debut,4)
mois = mid(debut,5,2)
jour = right(debut,2)
hhmn = ";" & Mid(temps,9,2) & ":" & Mid(temps,11,2)
clair = CStr(jour) & "/" & CStr(mois) & "/" & CStr(an) & CStr(hhmn)
'MsgBox temps &vbCrLf& clair
End function
Function Cesure(texte,taillecesure)
'Cette function Cesure est à améliorer
Dim posespace
Dim textimp
While (Len(texte) > taillecesure)
'Vérifier si la césure ne se fait pas juste avant l'espace (apres un mot entier) :
If Mid(texte, taillecesure + 1, 1) = "" Then
'si c'est le cas , ne pas chercher d'espace
posespace = taillecesure
Else
'sinon, chercher un espace avant le mot en cours
posespace = InStrRev(Left(texte, taillecesure), "") - 1
End If
'ajouter le texte tronqué à la sortie de la fonction
textimp = textimp & Left(texte, posespace) & vbCrLf
'tronquer le texte et recommencer la boucle
texte = Mid(Trim(texte), posespace + 2)
Wend
'ajouter le restant du texte
textimp = textimp & texte
'retourner le resultat de la fonction
Cesure = replace(textimp & "",chr(10)," ")
Cesure = replace(textimp & "",chr(13)," ")
End Function |
