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 |
Partager