|
begin process at 2008 07 04 08:53:07
Derniers logiciels
|
Trouver une ressource (Nouvelle version du moteur, plus rapide & pertinent, essayez le !)
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum.
Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !
EVENTVIEWER - NTLOGEVENT - EXTRACTION INFORMATIONS DU JOURNAL D'OBSERVATION DES EVÉNEMENTS WINDOWS
Information sur la source
Description
Ce script testé, sous xp, permet d'extraire les informations du Journal d'événements de Windows, à partir du fichier "Win32_NTLogEvent". Dans cet exemple , les informations recueillies sont formatées dans un .txt
Source
- 'Lecture des enregistrements des journaux d'événements de Windows
- 'Source originale : Cedric NANA, LABORATOIRE SUPINFO DES TECHNOLOGIES MICROSOFT (Equipe Recherche)
- 'Publiée le 11/05/2005 http://www.laboratoire-microsoft.org/scripts/14221/
- 'Descriptif de Win32_NTLogEvent
- 'http://www.secretswindows.com/index.php?rubrique=scripts&ssrubrique=WMI&page=./scripts/wmi/win32ntlogevent.htm
- '
- 'Selection sur LogFile="Application" ou "System", Type="erreur" et TimeGenerated <= à 15h
- '
- On Error Resume Next
- 'Création fichier resultat
- Dim resultat : resultat = "D:\Observateur_événements_" & 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') And Type='erreur'")
- For Each objWMIObject In objWMIObjectSet
- Dim MyComputer : MyComputer = objWMIObject.ComputerName
-
- If DateDiff("d", clair(objWMIObject.TimeGenerated), Now) <= 20 Then
- Rapport.writeLine "----------------------------------------------------"
- Rapport.writeLine "Ordinateur: " & objWMIObject.ComputerName
- Rapport.writeLine "Observateur d'événements: " & objWMIObject.LogFile
- Rapport.writeLine "----------------------------------------------------"
- Rapport.writeLine "Type: " & UCase(Left(objWMIObject.Type,1)) & mid(objWMIObject.Type,2)
- Rapport.writeLine "Date: " & clair(objWMIObject.TimeGenerated)
- Rapport.writeLine "Source: " & objWMIObject.SourceName
- Rapport.writeLine "ID évén.: " & objWMIObject.EventCode
- Rapport.writeLine "Utilisateur: " & objWMIObject.User
- Rapport.writeLine "Numéro d'enregistrement: " & objWMIObject.RecordNumber
-
- If Len(objWMIObject.Message) > 56 Then
- Rapport.writeLine "Description: " &vbCrLf& Cesure(objWMIObject.Message, 56)
- Else
- Rapport.writeLine "Description: " &vbCrLf& objWMIObject.Message
- End If
-
- 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
-
- 'Envoi automatisé du mail
- 'Call EnvoiMail(resultat, MyComputer, Contenu)
- 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 = textimp
- End Function
'Lecture des enregistrements des journaux d'événements de Windows
'Source originale : Cedric NANA, LABORATOIRE SUPINFO DES TECHNOLOGIES MICROSOFT (Equipe Recherche)
'Publiée le 11/05/2005 http://www.laboratoire-microsoft.org/scripts/14221/
'Descriptif de Win32_NTLogEvent
'http://www.secretswindows.com/index.php?rubrique=scripts&ssrubrique=WMI&page=./scripts/wmi/win32ntlogevent.htm
'
'Selection sur LogFile="Application" ou "System", Type="erreur" et TimeGenerated <= à 15h
'
On Error Resume Next
'Création fichier resultat
Dim resultat : resultat = "D:\Observateur_événements_" & 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') And Type='erreur'")
For Each objWMIObject In objWMIObjectSet
Dim MyComputer : MyComputer = objWMIObject.ComputerName
If DateDiff("d", clair(objWMIObject.TimeGenerated), Now) <= 20 Then
Rapport.writeLine "----------------------------------------------------"
Rapport.writeLine "Ordinateur: " & objWMIObject.ComputerName
Rapport.writeLine "Observateur d'événements: " & objWMIObject.LogFile
Rapport.writeLine "----------------------------------------------------"
Rapport.writeLine "Type: " & UCase(Left(objWMIObject.Type,1)) & mid(objWMIObject.Type,2)
Rapport.writeLine "Date: " & clair(objWMIObject.TimeGenerated)
Rapport.writeLine "Source: " & objWMIObject.SourceName
Rapport.writeLine "ID évén.: " & objWMIObject.EventCode
Rapport.writeLine "Utilisateur: " & objWMIObject.User
Rapport.writeLine "Numéro d'enregistrement: " & objWMIObject.RecordNumber
If Len(objWMIObject.Message) > 56 Then
Rapport.writeLine "Description: " &vbCrLf& Cesure(objWMIObject.Message, 56)
Else
Rapport.writeLine "Description: " &vbCrLf& objWMIObject.Message
End If
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
'Envoi automatisé du mail
'Call EnvoiMail(resultat, MyComputer, Contenu)
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 = textimp
End Function
Conclusion
En cours d'écriture: - - résultat dans un fichier html pour pièce jointe de mail; - résultat dans un fichier xls pour pièce jointe de mail; - afficher le résultat .txt dans le corps du mail; - afficher le résultat .htm dans le corps du mail;
La Query ne demande qu'à être développée.
jean-marc
Historique
- 28 novembre 2006 12:42:02 :
- Correction de la Quéry (bug sur certains xp)
Ajout d'une function Césure pour la description des messages (à améliorer)
Ce script, en vbs, ne necéssite aucune install de composant.
Sources de la même categorie
Commentaires
Discussions en rapport avec ce code source
|
CalendriCode
| | | L | M | M | J | V | S | D |
| | 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 | | | |
|
Téléchargements
Logiciels à télécharger sur le même thème :
|
|