Option Explicit

'-------------------------------------------------------------------------
' checktrackingv1.0.vbs
'
' Beschreibung
' Gibt für alle Server der Org den Status des Nachrichtentracking und die Exchange Version aus
' 
' 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)2005 Frank Carius
' 
' Version 1.0 (12. Juli 2005)

'-------------------------------------------------------------------------
' Pfad und Dateiname der Log-Datei
Const ForAppending = 8
Const ForWriting = 2
Const ForReading = 1
Const LogFile = "C:\checktracking.log"
' errorlogging  0=no logging, 1=Fatal  2=Error 3=Warning 4=information  5=debug
Const LogLevel = 5      ' Ausgabe in Datei
Const screenlevel  = 0  ' Ausgabe auf Bildschirm 

Const strExchangeOrg = "MSXFAQ"					' Bitte tragen Sie hier den Namen der ORG ein
											' Diese wird absichtlich nicht automatisch gesucht !
Const csvfilename = "c:\checktracking.csv"

Dim objRootDSE                  ' 
Dim strConfigurationNC          ' 
Dim oCommand               ' 
Dim oConnection            ' 
Dim oRecordSet             ' 
Dim strPOLContainer        ' 
Dim strQuery
Dim count
Dim dictOut

WScript.Echo WScript.ScriptName & " wurde gestartet."
AppendLog "Skript "& WScript.ScriptName &" gestartet", 4

Set objRootDSE = GetObject("LDAP://RootDSE")
strConfigurationNC = objRootDSE.Get("configurationNamingContext")

AppendLog "ConfigNC=" & strConfigurationNC, 4

strPOLContainer = "CN=" & strExchangeOrg & ",CN=Microsoft Exchange,CN=Services," & strConfigurationNC
Set oConnection = CreateObject("ADODB.Connection")
Set oCommand = CreateObject("ADODB.Command")
Set oRecordSet = CreateObject("ADODB.RecordSet")
oConnection.Provider = "ADsDSOObject"				' Open the Connection
oConnection.Open "ADs Provider"
' Build the query to find all Servers
strQuery = "<LDAP://" & strPOLContainer & ">;(&(objectClass=msExchExchangeServer)(!objectClass=msExchExchangeServerPolicy));"& _
						"name,distinguishedName,messageTrackingEnabled,msExchTrkLogCleaningInterval,versionNumber;subtree"  ',
AppendLog "LDAP-String:"&strQuery,4
oCommand.ActiveConnection = oConnection
oCommand.CommandText = strQuery
Set oRecordSet = oCommand.Execute

count = 0
Set dictOut = CreateObject("Scripting.dictionary")
While (Not oRecordSet.EOF)
	count = count +1
	AppendLog "Server         : "& oRecordSet.Fields("name"),0
	AppendLog "Tracking       : "& oRecordSet.Fields("messageTrackingEnabled"),0
	AppendLog "Haltezeit      : "& oRecordSet.Fields("msExchTrkLogCleaningInterval"),0
	AppendLog "ExchangeVersion: "& oRecordSet.Fields("versionNumber"),0
	dictOut.removeall
	dictOut.Add "Server"   ,oRecordSet.Fields("name")
	dictOut.Add "Tracking" ,oRecordSet.Fields("messageTrackingEnabled")
	dictOut.Add "Haltezeit",oRecordSet.Fields("msExchTrkLogCleaningInterval")
	dictOut.Add "ExchangeVersion",oRecordSet.Fields("versionNumber")
	Call out2csv(dictOut)
	oRecordSet.MoveNext
Wend

AppendLog "-------------Server Total:"&count ,0

oRecordSet.Close     'Clean up
oConnection.Close
set dictout = nothing
Set oRecordSet = Nothing
Set oCommand = Nothing
Set oConnection = Nothing

AppendLog "Skript beendet", 0
WScript.quit(0)


Sub out2csv(dictausgabe)
	'Dictionary enth&auml;lt Feldnamen und Werte
	Dim file
	Dim fs
	Dim strheaderline, strline, arrheader
	Dim count

	Set fs = CreateObject("Scripting.FileSystemObject")

	If Not fs.FileExists(csvfilename) Then	
		AppendLog "Datei nicht vorhanden -> Header schreiben" ,4
		Set file = fs.OpenTextFile(csvfilename, ForWriting, True)
		arrheader = dictausgabe.keys
		strheaderline = Join(arrheader,";")
		AppendLog "Headerline:" & strheaderline,4
		file.writeline strheaderline
		file.Close
	Else 
		AppendLog "Datei bereits vorhanden -> Header lesen" ,4
		Set file = fs.OpenTextFile(csvfilename, ForReading, True)
		arrheader = Split(file.ReadLine,";")   ' Feldbezeichnungen einlesen
	End If

	Set file = fs.OpenTextFile(csvfilename, ForAppending, True)
	strline = ""
	For count = 0 To uBound(arrheader)
		strline = strline & """" & dictausgabe.item(arrheader(count)) & """;"
	Next
	AppendLog "Strline=" & Left(strline,Len(strline)-1),0
	file.WriteLine(Left(strline,Len(strline)-1))
	file.Close
End Sub

Sub AppendLog(strLog, errlevel)
'Fügt einen Eintrag in die Log-Datei ein
	Dim file
	Dim fs

	If LogLevel>=errlevel Then
		Set fs = CreateObject("Scripting.FileSystemObject")
		Set file = fs.OpenTextFile(LogFile, 8, True)
		file.Write(Now & ",")
		Select Case errlevel
			Case 0	file.Write("Out")
			Case 1	file.Write("Fatal Line" & Err.Source)
			Case 2	file.Write("Error")
			Case 3	file.Write("Warning")
			Case 4	file.Write("Information")
			Case 5	file.Write("Debug")
			Case Else file.Write("Code:"&errlevel)
		End Select
		file.WriteLine(","&strLog)
		file.Close
	End If
	If screenlevel>=errlevel Then
		Select Case errlevel
			Case 0	WScript.echo ("Out:"&strLog)
			Case 1	WScript.echo (Now & "Fatal:" & Err.Source)
			Case 2	WScript.echo (Now & "Error:"&strLog)
			Case 3	WScript.echo (Now & "Warn :"&strLog)
			Case 4	WScript.echo (Now & "Info :"&strLog)
			Case 5	WScript.echo (Now & "Debug:"&strLog)
			Case Else WScript.echo (Now & "Code:"&errlevel)
		End Select
	End If	
End Sub