Option Explicit
'-------------------------------------------------------------------------
' 9551-Melder.1.1.vbs
'
' Beschreibung: ueberwacht das Eventlog auf Meldungen des IS über ACL Probleme (9551)
' In einer Textdatei, dem eventlog und dem Bildschirm werden alle änderungen protkolliert
'
' Laufzeitfehler werde nicht abgefangen und beenden das Skript.
'
' Das Skript wird mit den Berechtigungen des angemeldeten Benutzers
' ausgeführt. Die entsprechenden Berechtigungen sind sicher zu stellen
'
' (c)2004 Net at Work Netzwerksysteme GmbH
' 
' Version 1.0 (20. April 2005)
'	+ Erste Version
'-------------------------------------------------------------------------
Const conLogFile = "C:\9551-Melder.log"			' Protokolldatei
Const condebuglevel = 2
' Bitte in der passenden Sprache eintragen 
'Const conFolder = "Folderpath:"				' EN Server 
Const conEVENT_SUCCESS = 0	

Dim colMonitoredEvents, colLoggedEvents	'Collection der Eventmeldungen
Dim objWMIService               		'WMI Objekt für Zugriff auf Eventlog 
Dim objLatestEvent, objEvent			'Object für den jeweiligen Event
Dim Eventmessage
Dim chrcommand							'Auszuführender Befehl
Dim file, objfs							' für LogFile
Dim objShell							' für Eventlog
Dim Folderlist							' Speicher für die bereits gemeldeten Ordner

Call debug (1,WScript.ScriptName & " wurde gestartet.")

If WScript.Arguments.count= 0 Then											' Bestimmten der Kommandozeile
	chrcommand = "H"
Else
	chrcommand = Left(WScript.Arguments.item(0),1)
End If

Set objShell = WScript.CreateObject("Wscript.Shell")					' für Eventlog und Registry
Set objfs = CreateObject("Scripting.FileSystemObject")						' Logfile öffnen

If objShell.RegRead("HKLM\CurrentControlSet\Services\MSExchangeIS\ParametersSystem\Ignore zombie Users") = 1 Then
	Call debug(1,"Warning: REGKEY: Ignore Zombie User enabled  see 812963 using the Ignore Zombie Users Registry Key")
End If


If Not objfs.FileExists(LogFile) Then
	Set file = objfs.OpenTextFile(LogFile, 8, True)
	file.Writeline("Date" & vbTab & "Folderpath" )					' Kopfzeile schreiben.
Else
	Set file = objfs.OpenTextFile(LogFile, 8, True)							' nur öffnen
End If

folderlist = ""														' Bislang noch keine Ordner gefunden

Select Case chrcommand
	Case "M"	'MonitorMode Eventlog überwachen
		Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")	' WMI verbinden
		Set colMonitoredEvents = objWMIService.ExecNotificationQuery _ 
			("Select * from __instancecreationevent where TargetInstance isa 'Win32_NTLogEvent' " & _
			                                      "and TargetInstance.LogFile = 'Application' " & _ 
			                                      "and TargetInstance.SourceName = 'MSExchangeIS' " & _ 
			                                      "and TargetInstance.EventCode = '9551' ")
		Call debug (1,"Warte auf Events...")
		Do	'Endlosschleife
			Set objLatestEvent = colMonitoredEvents.NextEvent
			Call debug (1,"Event gefunden")
			Call processEvent(evtdatetime(objLatestEvent.TargetInstance.TimeGenerated), objLatestEvent.TargetInstance.Message)
			Call debug (1,"Event Ende")
		Loop
	Case "S"	'ScanMode. bestehendes Eventlos absuchen
		Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")	
		
		Set colLoggedEvents = objWMIService.ExecQuery _
			("Select * from Win32_NTLogEvent where LogFile = 'Application' " & _ 
			                                 "and SourceName = 'MSExchangeIS' " & _ 
			                                 "and EventCode = '9551' ")
		For Each objEvent In colLoggedEvents
			Call processEvent(evtdatetime(objEvent.TimeGenerated), objEvent.Message)
		Next		
		
	Case Else  ' Hilfe anzeigen
		WScript.echo "Bitte mit T, M oder S aufrufen"
		WScript.echo " M=Monitore Eventlog auf neue Einträge"
		WScript.echo " S=Scanne bestehendes Eventlog"
End Select

file.Close
Call debug (1,WScript.ScriptName & " beendet.")
WScript.quit(0)




Sub processEvent(strtime, strMessage)
' Verarbeite den anliegenden Event

	Dim strUserDN, strmail                        		' 
	Dim strnewproxy, stroldproxy                 		' Alte und neue Mailadressen
	Dim arrnewproxy										' temporäres Array
	
	Call debug (2,"ProcessEvent:--------------------------------"&vbCrLf)'	& strMessage
	
'	strUserDN = Mid(strMessage,InStr(strMessage,"Empfänger-DN: ")+14) 	' bearbeitetes Objekt ermitteln
'	strUserDN = Mid(strUserDN,1,InStr(strUserDN,vbCrLf)-1)				' String am Zeilenende abschneiden
'	stroldproxy = GetProxy (conOldProxy , strMessage)
'	strnewproxy = GetProxy (conNewProxy, strMessage)
'	Call debug (2,"UserDN:" & strUserDN)
'	Call debug (3,"ALT:"& vbCrLf & stroldproxy)
'	Call debug (3,"NEW:"& vbCrLf & strnewproxy)
'	
'	arrnewproxy = Split(strnewproxy,vbCrLf)
'		
'	For Each strmail In arrnewproxy
'		Call debug (2,"Check:" & strmail)
'		If InStr(stroldproxy,strmail)=0 Then				' änderung protokollieren.
'			WScript.echo (strtime & ";"& strUserDN &";Change:" & strmail)
'			file.Writeline(strtime & vbTab & strUserDN & vbTab & strmail)
'			objShell.LogEvent conEVENT_SUCCESS, "Time:"& strtime & vbCrLf &"DN:"& strUserDN & vbCrLf &"Proxy:"& strmail
'		End If
'	Next	
End Sub


Function evtdatetime(evttime)
' Auszug aus http://www.sadikhov.com/forum/Assistance-Requested-On-Vbscript_13254.html
' Konvertiert die Datum/Zeit Informationdes Eventlog in ein lesbares Format.
	Dim tmGen, dtPart,tmPart,strDt
	tmGen =  evttime & ""
    dtPart = Mid(tmGen,1,8)
    tmPart = Mid(tmGen,9,6)
    strDt = Mid(dtPart,5,2) & "/" & Mid(dtPart,7,2) & "/" & Mid(dtPart,1,4) & " " & _
            Mid(tmPart,1,2) & ":" & Mid(tmPart,3,2) & ":" & Mid(tmPart,5,2)

    evtdatetime = FormatDateTime(strDt,0)
End Function


Sub debug (level, debugmessage)
	If level < condebuglevel Then WScript.echo Time & ":DEBUG"&level&":"&debugmessage
End Sub