Option Explicit

'-------------------------------------------------------------------------
' DumpRecipientpoliciesv1.0.vbs
'
' Beschreibung
' Gibt alle Adressen der Empfängerrichtlinien als CSV-Datei tabellatisch 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
'
' Aktuell Problem: Wenn Policy genua EINEN Eintrag enthält, ist es kein Array und keine Ausgabe
' 
' Version 1.0 (12. Juli 2005)
'-------------------------------------------------------------------------
' Pfad und Dateiname der Log-Datei
Const ForAppending = 8
Const ForWriting = 2
Const ForReading = 1
Const LogFile = "C:\DumpRecipientpolicies.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:\DumpRecipientpolicies.csv"

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

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=Recipient Policies,CN=" & strExchangeOrg & ",CN=Microsoft Exchange,CN=Services," & strConfigurationNC
				  
AppendLog "POLContainer=" & strPOLContainer,4

Set oConnection = CreateObject("ADODB.Connection")
Set oCommand = CreateObject("ADODB.Command")
Set oRecordSet = CreateObject("ADODB.RecordSet")

' Open the Connection
oConnection.Provider = "ADsDSOObject"
oConnection.Open "ADs Provider"

' Build the query to find all RUS-Entries
strQuery = "<LDAP://" & strPOLContainer & ">;(objectCategory=msExchRecipientPolicy);"& _
						"name,distinguishedName,disabledgatewayproxy,gatewayproxy,msExchPolicyOrder;subtree"
AppendLog "LDAP-String"&strQuery,4
oCommand.ActiveConnection = oConnection
oCommand.CommandText = strQuery
Set oRecordSet = oCommand.Execute

count = 0
While (Not oRecordSet.EOF)
	AppendLog "DumpPOL: "& oRecordSet.Fields("name"),4
	count = count +1
	Call DumpPol(oRecordSet.Fields("distinguishedName"),count)
	oRecordSet.MoveNext
Wend

oRecordSet.Close     'Clean up
oConnection.Close
Set oRecordSet = Nothing
Set oCommand = Nothing
Set oConnection = Nothing

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


Sub DumpPol(strRusDN,id)
	Dim objRUS, objtarget, dblHighestUSN, gatewayproxy,disabledgatewayproxy
	Dim dictOut
	
	AppendLog "SUB:Checkrus ===============================",0
	AppendLog " Prüfe RUS:" & strRusDN,4

	Set dictOut = CreateObject("Scripting.Dictionary")
	Set objRUS = GetObject("LDAP://" & strRusDN)
	objRUS.GetInfo   ' Objekt aktuell einlesen

	AppendLog " name         :" & objRUS.Name,0
	If IsArray (objRUS.gatewayproxy) Then
		For Each gatewayproxy In  objRUS.gatewayproxy
			dictOut.RemoveAll
			AppendLog " ProxyAddress :" & gatewayproxy , 0
			dictOut.Add "Name",objRUS.Name
			
			Select Case objRUS.msExchPolicyOrder
				Case 0 			dictOut.Add "Order","Hoechste"
				Case 2147483647 dictOut.Add "Order","Niedrigste"
				Case Else  		dictOut.Add "Order",objRUS.msExchPolicyOrder
			End Select
	
			dictOut.Add "ProxyAddress","+" & gatewayproxy
			Call out2csv(dictOut)
		Next
	ElseIf objRUS.gatewayproxy<>"" Then
		dictOut.RemoveAll
		AppendLog " ProxyAddress :" & objRUS.gatewayproxy , 0
		dictOut.Add "Name",objRUS.Name
		Select Case objRUS.msExchPolicyOrder
			Case 0 			dictOut.Add "Order","Hoechste"
			Case 2147483647 dictOut.Add "Order","Niedrigste"
			Case Else  		dictOut.Add "Order",objRUS.msExchPolicyOrder
		End Select
		dictOut.Add "ProxyAddress","+" & objRUS.gatewayproxy
		Call out2csv(dictOut)
	End If

	If IsArray (objRUS.disabledgatewayproxy) Then
		For Each disabledgatewayproxy In  objRUS.disabledgatewayproxy
			dictOut.RemoveAll
			AppendLog " DisabledProxyAddress :" & disabledgatewayproxy , 0
			dictOut.Add "Name",objRUS.Name
			
			Select Case objRUS.msExchPolicyOrder
				Case 0 			dictOut.Add "Order","Hoechste"
				Case 2147483647 dictOut.Add "Order","Niedrigste"
				Case Else  		dictOut.Add "Order",objRUS.msExchPolicyOrder
			End Select
	
			dictOut.Add "ProxyAddress","-" & disabledgatewayproxy
			Call out2csv(dictOut)
		Next
	ElseIf objRUS.disabledgatewayproxy<>"" Then
		dictOut.RemoveAll
		AppendLog " DisabledProxyAddress :" & objRUS.disabledgatewayproxy , 0
		dictOut.Add "Name",objRUS.Name
		
		Select Case objRUS.msExchPolicyOrder
			Case 0 			dictOut.Add "Order","Hoechste"
			Case 2147483647 dictOut.Add "Order","Niedrigste"
			Case Else  		dictOut.Add "Order",objRUS.msExchPolicyOrder
		End Select
		dictOut.Add "ProxyAddress","-" & objRUS.disabledgatewayproxy
		Call out2csv(dictOut)
	
	End If
		
End Sub

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